


  '=======================
  '
  '     #####    ##### 
  '    #     #  #     #
  '    #     #        #
  '    #     #   ##### 
  '    #     #  #
  '    #     #  # 
  '     #####   #####O2
  '
  '=======================
  '    OXYGEN RUNTIME
  '=======================

  ' 16:05 27/09/2008 split from o2prep (o2sema)
  ' 13:13 15/10/2014
  ' 07:00 31/08/2017


  global as sys vew,ui1,ui2,ui3,ui4,dwl,dwu
  global as any ptr psysfuns     ' runtime ebx table base ptr


  'DEBUGGING STRING MESSAGE

  '---------------------------------
  sub qq(byref s as string,v as sys)
  '=================================
    if vew=0 then messagebox 0,s,str(v),0
  end sub

  '================
  'RUN TIME GLOBALS
  '================

  type numformat
    dp  as sys  ' DECIMAL PLACES
    trz as sys  ' STRIP TRAILING ZEROS
    sn  as sys  ' SCIENTIFIC NOTATION BY DEFAULT
    sdp as sys  ' INHIBIT ZERO BEFORE DECIMAL POINT
    sns as sys  ' LEADING SPACE FOR NON NEGATIVE NUMBERS
    lps as sys  ' LEAD PADDING SPACES
  end type

  const as string cr=chr(13)+chr(10)

  'ert     error number
  'ers     error description
  'wdg     runtime messages string
  'num     number to ascii format specifier


  global as sys ert
  global as numformat num
  global as string ers,wdg


  '-------------------------------------------------------------
  sub init1(byval p as any ptr, byval le as sys, byval c as sys)
  '=============================================================
  asm
  mov edx,[p]
  mov ecx,[le]
  mov al,[c]
  mov ah,al
  shl eax,16
  mov al,[c]
  mov ah,al
  inib:
    sub ecx,4
    jl xbl
    mov [edx],eax
    add edx,4
    jmp inib
  xbl:
  add ecx,4
  inib1:
    dec ecx
    jl xbl1
    mov [edx],al
    inc edx
    jmp inib1
  xbl1:           
  end asm
  end sub



  '------------------------------------------------
  function float_to_ascii(byval dpl as sys) as bstr
  '================================================
  '
  dim as byte s(23), t(63), bcd(15) 'BUFFERS
  dim as sys  esize,tempdw,dp,sn,snv,b,nzero,oldcw,truncw,i
  dim as zstring ptr ps,pt,pa
  dim as sys num_trz,num_dp,num_sn,num_sdp,num_sns,num_lps
  '
  num_dp  = num.dp
  num_trz = num.trz
  num_sn  = num.sn
  num_sdp = num.sdp
  num_sns = num.sns
  num_lps = num.lps
  '
  if dpl>=0 then num_dp=dpl
  '
  'OPTIONAL PADDING
  '================
  '
  if num_lps then
    for i=0 to 31
      t(i)=32
    next
  end if
  '
  pt=@t(0)+32
  pa=@bcd(0)
  '
  '--
  asm
  '==
  '
  mov eax,[pa]
  fstpt [eax] 'pop store ext number from fpu
  '
  mov eax,0
  mov [snv],eax
  mov [sn],eax
  mov [nzero],eax
  'mov [b],ebx
  '
  '
  'CHECK FOR ZERO INFINITY AND NAN
  '-------------------------------
  '
  mov ecx,[pa]

  mov eax,[ecx+8]

  '(
    and eax,&h7fff
    '
    'TEST FOR ZERO
    '
    '(
      cmp eax,0
      jnz xfa2  'exit EXCLUDE NON ZERO
      cmp dword ptr [num_trz],0
      jz xfa2 'exit ZERO STRIPPER FLAG
      'or eax,[ecx]
      or eax,[ecx+4]
      jnz xfa2 'exit
      '(
        test byte ptr [ecx+9],&h80
        jz xfa1 'exit

        '------
        end asm
        *pt="-0"
        asm
        '------

        jmp fadonez 'NEGATIVE ZERO
      ')
  xfa1:

      '------
      end asm
      *pt="0"
      asm
      '------

      jmp fadonez 'POSITIVE ZERO
    ')

  xfa2:

    cmp eax,&h7fff
    jnz xfa5n 'exit
    mov dword ptr [nzero],1
    '
    mov eax,[ecx+4]
    and eax,0x7fffffff 'exclude bit 63
    or  eax,[ecx]
    '
    'CHECK FOR NAN OR INFINITY
    '
    '(
      cmp eax,0
      jz xfa4 'exit
      '
      'sNAN OR qNAN
      '
      '(
        test byte ptr [ecx+7],&h40
        jnz xfa3 'exit
        '----------
        end asm
        *pt="#sNAN"
        asm
        '----------
        jmp fadonez 'SIGNALLING NAN
      ')

  xfa3:
      '----------
      end asm
      *pt="#qNAN"
      asm
      '----------
     jmp fadonez 'QUIET NAN
    ')

  xfa4:

    'NEGATIVE / POSITIVE INFINITY
    '
    '(
      test byte ptr [ecx+9],&h80
      jz xfa5 'exit

      '---------
      end asm
      *pt="#-INF"
      asm
      '---------
      jmp fadonez 'NEGATIVE INFINITY
    ')

  xfa5:

    '----------
    end asm
    *pt="#INF"
    asm
    '----------
    
    jmp fadonez 'POSITIVE INFINITY
  ')

  xfa5n:

  mov eax,[pa]
  fldt [eax]

  '---------------------------
  ' get the size of the number
  '---------------------------
  '(

    '
    'CHECK FOR ZERO
    '
    mov dword ptr [esize],0
    fldz
    fcomip st(0),st(1)
    jz xfa6 'exit
    '
    mov dword ptr [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,&hc00            'code it for truncating
    mov   [truncw],ax
    fldcw [truncw]            'insure rounding code of FPU to truncating
  
    fist dword ptr [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   dword ptr [esize],0 'decrement esize if log is negative
    fstp  st(0)               'get rid of the logarithm
  ')

  xfa6:

  '
  'DECIMAL PLACES LIMIT
  '---------------------
  '
  mov eax,[num_dp]
  '(
   cmp eax,16
   jle xfa7 'exit
   mov eax,16 'LIMIT DECIMAL PLACES
  ')

  xfa7:

  mov [dp],eax


  'IS SCIENTIFIC NOTATION ALWAYS REQUIRED

  cmp byte ptr [num_sn],0
  jnz ENotation

  '
  'VERY LARGE NUMBERS
  '
  '(
    mov ecx,[esize]
    'add ecx,dp
    cmp ecx,17
    jl xfa8 'exit
    jmp ENotation
  ')

  xfa8:

  '
  'SMALL NUMBERS
  '
  '(
    cmp dword ptr [esize],0
    jge xfa9 'exit
    mov ecx,[dp]
    mov edx,[esize]
    neg edx
    cmp edx,4
    jg ENotation 'LIMIT FOR SIMPLE FORMAT
    mov eax,ecx
    mov [dp],ecx
    jmp PowerAdjust
  ')

  xfa9:

  '
  'NUMBERS NOT REQUIRING SCIENTIFIC NOTATION
  '
  '(
    mov eax,[dp]
    mov ecx,eax   'DECIMAL PLACES
    add ecx,[esize] 'INTEGER DIGITS 
    sub ecx,16
    jle xfa10 'exit
    '
    'TOO MANY DIGITS? (ecx contains excess digits)
    '
    '
    sub eax,ecx 'REDUCE MULTIPLIER PLACES IF NECESSARY
    sub [dp],ecx  'REDUCE DECIMAL PLACES ALSO
  ')

  xfa10:

  jmp PowerAdjust

  ENotation:
  '---------

    mov ecx,[esize]
    mov [snv],ecx
    mov eax,[dp]
    sub eax,ecx
    mov dword ptr [sn],1 'SCIENTIFIC NOTATION FLAG

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

  mov [tempdw],eax 'ADJUSTED MULTIPLIER


  'Multiply the number by the power of 10
  '---------------------------------------
  '(
    mov eax,[tempdw]
    cmp eax,0
    jz xfa11 'exit
    '
    fild dword ptr [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
  ')

  xfa11:

  fbstp [bcd] 'SAVE AS PACKED BINARY CODED DECIMAL


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


  '
  'EXPAND DIGITS
  '

  lea edx,[bcd]
  lea ecx,[s]
  '
  push ebx
  mov bl,10

  rfa12:

  '(
    dec bl
    jl xfa12 'exit
    '
    mov ah,[edx]
    inc edx
    '
    mov al,ah
    and al,15
    add al,48
    mov [ecx],al
    inc ecx
    '
    mov al,ah
    shr al,4
    and al,15
    add al,48
    mov [ecx],al
    inc ecx
    jmp rfa12 'repeat
    ')

  xfa12:

  mov byte ptr [ecx],0

  '
  'COPY FORMATTED
  '--------------
  '
  mov edx,[pt]
  '
  'NEGATIVE SIGN NEEDED?
  '
  '(
    cmp al,48
    jz xfa12a 'exit
    mov byte ptr [edx],45
    inc edx
    jmp xfa13
  ')
  '
  xfa12a:
  '
  cmp dword ptr [num_sns],0
  jz xfa13
  mov byte ptr [edx],32
  inc edx

  xfa13:

  lea ebx,[s]
  add ebx,18
  mov cl,19
  mov ah,0
  mov ch,[dp]
  dec ch

  rfa18:

  '(
    dec cl
    jl xfa18 'exit
    '
    'INSERT DECIMAL POINT
    '
    '(
      cmp cl,ch
      jnz xfa15 'exit
      '
      'PLACE LEADING ZERO
      '
      '(
       cmp dword ptr [num_sdp],0
       jnz xfa14 'exit SDP FLAG TO INHIBIT
       cmp ah,0
       jnz xfa14 'exit
       mov byte ptr [edx],48
       inc edx
      ')

  xfa14:

      mov byte ptr [edx],46
      inc edx
      mov ah,1 'STOP STRIPPING ZEROS
    ')

  xfa15:

    mov al,[ebx]
    dec ebx
    '(
      '(
        cmp ah,0
        jnz faok
      ')

  xfa16:

      cmp al,48
      jz xfa17 'exit STRIP LEADING ZEROS
      mov ah,1 'INHIBIT FUTURE STRIPPING
      faok:
      mov [edx],al
      inc edx
    ')

  xfa17:

    jmp rfa18 'repeat
  ')

  xfa18:

  pop ebx

  '
  fadone:
  '
  'REMOVE ENDING ZEROS
  '
  '(
    cmp dword ptr [num_trz],0
    jz xfa21 'exit
    cmp dword ptr [dp],0
    jz xfa21 'exit
    mov ecx,[pt] 'BASE ADDRESS OF NUMBER STRING

  rfa20:

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

  xfa19:

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

  xfa20:
    
    xit1:
    '
    inc edx
  ')

  xfa21:

  'ENSURE AT LEAST ONE DIGIT
  '
  mov ecx,[pt]
  mov al,[ecx]
  '(
    cmp al,45
    jnz xfa22 'exit
    inc ecx
  ')

  xfa22:

  '(
    cmp ecx,edx
    jnz xfa23 'exit
    mov byte ptr [edx],48
    inc edx
  ')

  xfa23:

  '
  'CHECK FOR SCIENTIC NOTATION
  '
  '(
    cmp dword ptr [sn],0
    jz xfa27 'exit
    cmp dword ptr [nzero],0
    jz xfa27 'exit
    mov eax,[snv]
    cmp eax,0
    jz xfa27 'exit E VALUE ZERO SO OMIT
    mov byte ptr [edx],69
    inc edx 'E'
    mov cl,43
    '(
      cmp eax,0
      jge xfa24 'exit
      neg eax
      mov cl,45
    ')

  xfa24:

    mov [edx],cl
    inc edx 'SIGN
    mov cl,100
    div cl
    push eax
    and eax,&hff
    mov cl,10
    div cl

    '(
      cmp ax,0
      jz xfa26 'exit
      or eax,&h3030 'TO ASCII THOUSANDS AND HUNDREDS
      '( 
        cmp al,48
        jz xfa25 'exit
        mov [edx],al
        inc edx
      ')

  xfa25:

      mov [edx],ah
      inc edx
    ')

  xfa26:

    pop eax
    shr eax,8
    div cl
    or eax,&h3030 'TO ASCII TENS AND UNITS
    mov [edx],aX
    add edx,2
  ')

  xfa27:

  '
  mov byte ptr [edx],0 'APPEND NULL TERMINATOR
  '
  fadonez:

  '
  'ASSIGN RESULT TO BSTRING
  '
  mov edx,[pt]
  '
  'loop to get lengths
  '-------------------
  '
  xor ecx,ecx 'length counters
  rnends:
    mov al,[edx]
    inc edx
    cmp al,46
    jnz nintlen
      mov ch,cl 'count before decimal point
    nintlen:
    inc cl
    cmp al,32 'allow leading space to be included
  jge rnends
  '
  mov edx,[pt]
  '
  'create lead padding if specified
  '--------------------------------
  '
  cmp dword ptr [num_lps],0
  jz npaddls
    xor eax,eax
    mov al,ch   'length of integer part
    cmp eax,[num_lps]
    jg npaddls 'no lead padding if integer is too long
    add edx,eax
    sub edx,[num_lps] 'adjust pointer to include padding
    '
    and ecx,&h7f
    add ecx,[num_lps]
    sub ecx,eax 'adjust length to include padding
  npaddls:
  '
  and ecx,&h7f
  dec ecx 'length
  '
  push ecx 'max bytes
  push edx
  'call SysallocStringByteLen
  mov eax,[psysfuns]
  call [eax+160]
  mov [function],eax
  mov dl,1
  '

  end asm
  '
  end function





  '------------
  sub hexaval()
  '============
  asm
  '
  'ECX POINTS TO LEFT BOUNDARY OF TEXT NUMBER
  '
  xor edx,edx
  xor esi,esi
  '
  rhexconv:
    inc ecx
    mov al,[ecx]
    cmp al,48 '0
    jb nhexconv 'boundary reached
    '
    'CONVERT TO UPPERCASE
    '
    cmp al,96
    jbe nnlc2
    cmp al,122
    ja nnlc2
    sub al,32
    nnlc2:
    '
    cmp al,&h46 'F
    ja nhexconv
    cmp al,&h39 '9
    jbe nadjal
      cmp al,65
      jb nhexconv 'boundary character
      sub al,7
    nadjal:
    sub al,48 'ascii to hex number
    shld esi,edx,4 'shift nybble
    shl edx,4
    add dl,al
    '
    'itr overflow
    '
  jmp rhexconv
  '
  nhexconv: 'done conversion 'result in edx
  '
  mov eax,edx 'return lower dword
  mov edx,esi 'possible upper dword
  '
  end asm
  end sub



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


  '----------------------------------------------------------
  function guidval(byref g as guid, byval s as bstr) as sys
  '==========================================================
  '
  '{dddddddd-wwww-wwww-bbbb-bbbbbbbbbbbb}
  '
  asm
    mov edi,[g]
    mov ecx,[s]
    mov al,[ecx]
    cmp al,123
    jz gguid
      dec ecx
    gguid:
    call hexaval
    mov [edi],eax
    call hexaval
    mov [edi+4],ax
    call hexaval
    mov [edi+6],ax
    call hexaval
    mov [edi+8],ah
    mov [edi+9],al
    call hexaval
    mov [edi+10],dh
    mov [edi+11],dl
    mov edx,eax
    shr edx,16
    mov [edi+12],dh
    mov [edi+13],dl
    mov [edi+14],ah
    mov [edi+15],al
    inc ecx 'move to txtguid boundary
    nguid:
  end asm
  return cast(sys,varptr(g))
  end function


  '---------
  sub ghex()
  '=========
  asm
    mov dh,al
    and dh,15
    add dh,48
    cmp dh,57
    jle nghexadj1
    add dh,7
    nghexadj1:
    shr eax,4
    mov dl,al
    and dl,15
    add dl,48
    cmp dl,57
    jle nghexadj2
    add dl,7
    nghexadj2:
    shr eax,4
  end asm
  end sub


  '----------------------------------------
  function guidtxt(byref g as guid) as bstr
  '========================================
  asm
    push 38
    push 0
    'call SysAllocStringByteLen
    mov eax,[psysfuns]
    call [eax+160]
    mov edi,eax
    mov [function],eax
    mov ecx,[g]
    mov byte ptr [edi],123
    mov byte ptr [edi+37],125
    inc edi
    ''-------
    'dddddddd
    '--------
    mov eax,[ecx]
    call ghex
    mov [edi+6],dx
    call ghex
    mov [edi+4],dx
    call ghex
    mov [edi+2],dx
    call ghex
    mov [edi],dx
    mov byte ptr [edi+8],45
    add edi,9
    '----
    'wwww
    '----
    mov ax,[ecx+4]
    call ghex
    mov [edi+2],dx
    call ghex
    mov [edi],dx
    mov byte ptr [edi+4],45
    add edi,5
    '----
    'wwww
    '----
    mov ax,[ecx+6]
    call ghex
    mov [edi+2],dx
    call ghex
    mov [edi],dx
    mov byte ptr [edi+4],45
    add edi,5
    '----
    'bbbb
    '----
    mov ax,[ecx+8]
    call ghex
    mov [edi],dx
    call ghex
    mov [edi+2],dx
    mov byte ptr [edi+4],45
    add edi,5
    '------------
    'bbbbbbbbbbbb
    '------------
    add ecx,10
    mov esi,6
    rghexb:
      mov al,[ecx]
      call ghex
      mov [edi],dx
      inc ecx
      add edi,2
      dec esi
    ja rghexb
    '--------
  end asm
  end function





  '-------------------------------------
  sub ascii_to_float(byval s as any ptr) 
  '=====================================
  '
  dim as sys stt,dpf,dpl,enf,eno,digi,sgf,sgg,ten=10
  '
  asm
  '
  mov ecx,[s]
  '
  '
  'SKIP LEADING WHITE SPACE
  '
  raf1:
  '
  mov al,[ecx]
  cmp al,0
  jz numnok 'end of string (error)
  cmp al,32
  jg xaf1 'exit 'start of word
  inc ecx
  jmp raf1 'repeat
  '
  xaf1:
  '
  mov [stt],ecx 'START OF NUMBER
  '
  cmp al,&h26 '&
  jz n0xn
  cmp al,0x3a '>9
  jae numnok
  '
  'Lookahead for endings h o
  '=========================
  '
  push ecx
  '
  raf1a:
  '
  inc ecx
  mov ah,[ecx]
  cmp ah,45 '-' and above
  jae raf1a
  '
  'check ending
  '
  dec ecx
  mov ah,[ecx]
  cmp ah,&h3a
  jb xaf1a 'skip numbers
  '
  'upparcase conversion
  '
  cmp ah,&h60
  jbe nuprcasn
  sub ah,32
  nuprcasn:
  '
  cmp ah,&h48 'h
  jnz nafh
  mov byte ptr [ecx],32
  pop ecx
  dec ecx
  jmp gohexadecimal
  nafh:
  '
  cmp ah,&h4f 'o
  jnz nafo
  mov byte ptr [ecx],32
  pop ecx
  dec ecx
  jmp octad
  nafo:
  '
  'cmp ah,&h42 'b itr: incompatible with hexadecimal
  'jnz nafb
  'mov byte ptr [ecx],32
  'pop ecx
  'dec ecx
  'jmp binad
  'nafb:
  '
  xaf1a:
  '-----
  '
  pop ecx
  '
  'Check for 0x 0o 0b
  '==================
  '
  cmp al,&h30
  jnz n0xn
  '
  mov ah,[ecx+1]
  cmp ah,&h60
  jbe nuprcas
  sub ah,&h20
  nuprcas:
  cmp ah,&h3a
  jb n0xn
  mov al,&h26
  jmp numhok  
  '
  '
  'filter word types
  '=================
  '
  n0xn:
  '----
  '
  cmp al,&h23 'include #  special numbers
  jz spnums
  cmp al,&h26 'include &  hex number
  jz numhok
  cmp al,&h2d 'include -  neg number
  jz normf
  cmp al,&h2e 'include .  decimal point
  jz normf
  cmp al,&h30 'exclude below 0
  jb numnok
  cmp al,&h3a 'include below :
  jb normf
  '
  '--------------------------
  numnok: 'cannot be a number
  '==========================
  '
  fldz
  jmp NumErr
  
  '---------------------------------
  numhok: 'HEX OCTAL OR BINARY MAYBE
  '=================================
  '
  '
  cmp al,38 '&
  jnz spnums
  '
  inc ecx
  mov al,[ecx]
  cmp al,32
  jg IsThereNum
  fldz
  jmp ParseHExit
  '
  IsThereNum:
  '
  'CONVERT TO UPPERCASE
  '
  cmp al,96
  jbe nnlc1
  cmp al,122
  ja nnlc1
  sub al,32
  nnlc1:
  '
  cmp al,&h48 'H
  jz gohexadecimal
  cmp al,&h58 'X 
  jnz tryoctal
  '
  '
  'HEXADECIMAL
  '-----------
  '
  gohexadecimal:
  '
  call hexaval
  jmp cputofpu
  '
  '
  tryoctal: 'OCTAL
  '--------------
  '
  cmp al,&h4f 'o
  jnz trybinary
  '
  octad:
  xor edx,edx 'zero the accum
  xor esi,esi 'zero the upper accum
  roctconv:
    inc ecx
    mov al,[ecx]
    cmp al,48 '0
    jb noctconv
    cmp al,55 '7
    ja noctconv
    sub al,48 'ascii to hex number
    shl edx
    rcl esi
    shl edx
    rcl esi
    shl edx
    rcl esi
    add dl,al
    '
    'itr overflow
    '    
  jmp roctconv
  noctconv: 'done conversion
  mov eax,edx
  mov edx,esi
  jmp cputofpu
  '
  '
  '
  '
  trybinary: 'BINARY BITS
  '----------------------
  '
  cmp al,&h42 'b
  jz binad
  fldz
  jmp ParseHExit
  
  '
  binad:
  xor edx,edx 'zero the accum
  xor esi,esi 'zero the upper accum
  '
  rbinconv:
  '
  inc ecx
  mov al,[ecx]
  cmp al,48 '0
  jb nbinconv
  cmp al,49 '1
  ja nbinconv
  sub al,48 'ascii to hex number
  shl edx 'shift bit
  rcl esi 'shift bit
  add dl,al
  jmp rbinconv
  '
  nbinconv: 'done conversion
  mov eax,edx
  mov edx,esi
  jmp cputofpu
  '
  '
  'TREAT AS UNSIGNED INTEGER
  '
  '
  cputofpu:
  '
  mov [dwu],edx
  mov [dwl],eax
  push edx
  push eax
  fild qword ptr [esp]
  add esp,8
  '
  ParseHExit:
  '
  end asm
  exit sub
  asm
  '
  '
  '---------------
  'SPECIAL NUMBERS
  '---------------
  '
  spnums:
  '
  cmp al,35 '#
  jnz normf 'NORMAL NUMBERS
  '
  inc ecx
  mov eax,[ecx]
  add ecx,4
  or eax,&h20202020 'QUICK LOWERCASE
  '
  cmp eax,&h666e692d '#-INF
  jnz xsnum1 'exit
  '
  fld1
  fchs
  fldz
  jmp xitsn
  '
  xsnum1:
  '
  'cmp eax,&h6e616e71 '#QNAN
  'jnz xsnum2 'exit
  'fldz
  'fldz
  'jmp xitsn
  '
  'xsnum2:
  '
  'cmp eax,&h6e616e73 '#SNAN
  'jnz xsnum3 'exit
  'fldz
  'fldz
  'jmp xitsn
  '
  'xsnum3:
  '
  and eax,&hffffff 'IGNORE 4TH CHAR
  '  
  cmp eax,&h666e69 '#INF
  jnz xsnum4 'exit
  fld1
  fldz
  jmp xitsn
  '
  xsnum4: 'default #qnan
  '
  fldz
  fldz
  
  xitsn:
  '
  fdivp st(1)
  end asm
  exit sub
  '
  asm
  '
  '-------------------------------------
  normf: 'OTHERWISE CONVENTIONAL NUMBERS
  '-------------------------------------
  '
  fldz
  dec ecx     'PRE DECR
  '
  '---------
  ParseLoop:
  '---------
  '
  raf2:
  '
  inc ecx
  mov al,[ecx]
  cmp al,47
  jz ParseExit
  cmp al,44
  jle ParseExit
  '
  'TEST FOR E
  '
  raf3:
  '
  cmp al,&h65
  jz xaf3 'exit
  cmp al,&h45
  jz xaf3 'exit
  jmp nexne
  '
  xaf3:
  '
  'E ENCOUNTERED
  '
  raf4:
  '
  mov eax,ecx
  inc eax
  mov dword ptr [enf],eax
  fldz
  mov al,[sgf]
  mov [sgg],al
  mov dword ptr [sgf],0
  jmp ParseLoop
  '
  xaf4:
  '
  '-------------------
  nexne: 'BYPASS E SETUP
  '-------------------
  '
  'NEGATIVE SIGN
  '
  raf5:
  '
  cmp al,45
  jnz xaf5 'exit
  cmp byte ptr [sgf],0
  jnz NumErr 'NEG SIGN ALREADY ENCOUNTERED
  mov byte ptr [sgf],1 'SET SIGN FLAG
  jmp ParseLoop
  '
  xaf5:
  '
  raf6:
  '
  cmp al,43
  jnz xaf6 'exit
  cmp ecx,[stt]
  jz ParseLoop 'PLUS SIGN AT START OF NUMBER
  cmp byte ptr [sgf],0
  jnz ParseExit 'PLUS SIGN MARKING BOUNDARY OF NUMBER
  cmp [enf],ecx
  jz ParseLoop 'PLUS SIGN IMMEDIATELY FOLLOWING E
  jmp ParseExit
  '
  xaf6:
  '
  'CHECK FOR DECIMAL POINT
  '
  raf7:
  '
  cmp al,46
  jnz xaf7 'exit
  cmp dword ptr [enf],0
  jnz NumErr 'DECIMAL POINT AFTER E
  cmp byte ptr [dpf],0
  jnz NumErr 'DECIMAL POINT ALREADY PRESENT
  mov byte ptr [dpf],1
  jmp ParseLoop
  '
  xaf7:
  '
  'VALIDATE DIGIT
  '
  sub al,48
  jb ParseExit 'ASCII BELOW '0'
  cmp al,9
  ja ParseExit 'exit  'ASCII ABOVE '9'
  '
  'ACCUM * 10 + DIGIT
  '
  fimul dword ptr [ten]
  mov [digi],al
  fiadd dword ptr [digi]
  '
  raf8:
  '
  cmp byte ptr [dpf],0
  jz xaf8 'exit  'NO DECIMAL POINT
  cmp byte ptr [enf],0
  jnz xaf8 'exit 'EXCLUDING E NUMBER
  inc dword ptr [dpl]
  '
  xaf8:
  '
  jmp ParseLoop
  '
  xaf2:
  '
  '---------
  ParseExit:
  '---------
  '
  'CHECK FOR NEG SIGN
  '
  raf9:
  '
  cmp byte ptr [sgf],0
  jz xaf9 'exit
  fchs
  '
  xaf9:
  '
  'DECIMAL PLACES BUT NO E NUMBER
  '
  raf10:
  '
  cmp dword ptr [enf],0
  jnz xaf10 'exit
  mov dword ptr [enf],1 'SET TO SCALE
  fldz
  '
  xaf10:
  '
  '
  'SCALE VALUE PRESENT?
  '
  raf11:
  '
  cmp dword ptr [enf],0
  jz xaf11 'exit
  '
  fisub dword ptr [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
  '
  'CHECK FOR NEG SIGN
  '
  raf12:
  '
  cmp byte ptr [sgg],0
  jz xaf12 'exit
  fchs
  '
  xaf12:
  '
  xaf11:
  '
  numokay: 'NUMBER COMPLETED
  '-------------------------
  '
  'result remains on fpu stack.
  '
  sub esp,8
  fld st(0)
  fistp qword ptr [esp]
  mov edx,[esp+4]
  mov eax,[esp]
  mov [dwu],edx
  mov [dwl],eax
  add esp,8
  '
  end asm
  exit sub
  '
  asm
  '
  NumErr: 'NUMBER ERRORS
  '---------------------
  '
  'itr runtime error?
  '
  end asm
  '
  'print "Number error"
  '
  end sub


  '---------------------------------------
  sub copy0(byval a as sys,byval b as sys)
  '=======================================
  asm
  mov edi,[a]
  mov esi,[b]
  '
  copy0r:
  '
  mov al,[esi]
  mov [edi],al
  inc esi
  inc edi
  cmp al,0
  jnz copy0r
  end asm
  end sub




  '----------------------------------------
  sub copy00(byval a as sys,byval b as sys)
  '========================================
'
  asm
  mov edi,[a]
  mov esi,[b]
  '
  copy00r:
  '
  mov ax,[esi]
  mov [edi],ax
  inc esi
  inc esi
  inc edi
  inc edi
  cmp ax,0
  jnz copy00r
  '
  end asm
  end sub


  '------------------------------------------------------
  sub copyn(byval a as sys,byval b as sys,byval q as sys)
  '======================================================
  asm
  mov edi,[a]
  mov esi,[b]
  mov ecx,[q]
  '
  copyqr4:
  sub ecx,4
  jl  copyqx4
  mov eax,[esi]
  mov [edi],eax
  add esi,4
  add edi,4
  jmp copyqr4
  copyqx4:
  '
  add ecx,4
  '
  copyqr:
  dec ecx
  jl  copyqx
  mov al,[esi]
  mov [edi],al
  inc esi
  inc edi
  jmp copyqr
  copyqx:
  '
  end asm
  end sub






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


  '-------------------------------------------
  function hexsl(byval min_len as sys) as BSTR
  '===========================================
  '
  'extended for quad values
  'build hex string form right to left
  'starting with least significant
  '
  asm
  '
  sub esp,64 'workspace
  mov esi,esp
  fistp qword ptr [esi] 'save as quad integer
  mov edx,[esi]
  add esi,32  'offset for working backwards
  mov edi,esi 'hold end position
  inc edi
  'mov byte ptr [edi],32 'endstop space
  push edi
  mov edx,[esi-32] 'lower dword
  mov edi,[esi-28] 'upper dword
  '
  call hextoc
  mov edx,edi 'load upper dword
  call hextoc
  '
  pop edi
  jmp rtrimzer
  '
  hextoc: 'convert nybbles to hex chars
  '------------------------------------
  '
  mov ecx,8 'down count
  '
  rhextoc: 'cycle thru hex nybbles
  '
  mov al,dl
  shr edx,4
  and al,15
  add al,48
  cmp al,58
  jb nadjhexal
  add al,7
  nadjhexal:
  mov [esi],al
  dec esi 'move to left
  dec ecx 'downcount
  '
  jg rhextoc
  ret
  '
  rtrimzer:  'trim leading zeros (left to right)
  '---------------------------------------------
  '
  inc esi
  mov al,[esi]
  cmp al,48 'is it a leading zero?
  jz rtrimzer
  '
  cmp esi,edi
  jl nsinglez 'leave at least one '0' digit
  dec esi
  nsinglez:
  '
  'copy into a new bstring
  '-----------------------
  '
  sub edi,esi 'calc length
  cmp dword ptr [min_len],0
  jz nplzero
    mov eax,[min_len]
    sub eax,edi
    cmp eax,0
      jle nplzero
      sub esi,eax
    add edi,eax
  nplzero:
  push edi 'length
  push esi 'pointer
  'call SysAllocStringByteLen
  mov eax,[psysfuns]
  call [eax+160] 'AllocString 'create BSTR
  mov [function],eax 'return it
  add esp,64 'release workspace
  '
  end asm 
end function


'----------------------
function hexs() as BSTR
'======================
  function=hexsl(0)
end function


'---------------------------------------------------------------------------
function instrsh(byval i as sys, byval s0 as bstr, byval w0 as bstr ) as sys
'===========================================================================
  asm
  push ebx
  push esi
  mov ebx,[i]
  dec ebx
  cmp ebx,0
  jl xinstr       'invalid offset
  mov edi,[s0]    'main string
  cmp edi,0
  jz xinstr       'empty string
  mov edx,[w0]    'keyword
  cmp edx,0
  jz xinstr       'empty keyword
  mov ecx,[edx-4] 'length of keyword
  '
  mov esi,edi
  add esi,[edi-4] 'main string boundary
  sub esi,ecx     'minus length of keyword
  mov eax,esi     'search limit
  sub eax,ebx     'offset
  cmp eax,edi     '
  jl xinstr       'no room for keyword
  '
  add edi,ebx     'set offset
  mov ah,[edx]
  '
  trinstr:
  '-------
    cmp edi,esi 'boundary check
    jg xinstr
    mov al,[edi]
    inc edi
    cmp al,ah
    jnz trinstr 'check 1st letter against next
    '
    push edi
    push edx
    push ecx
    inc edx   'second letter
    rinstr:
    '------
      dec ecx     'downcount (second letter onward)
      jle ninstr  'match complete
      mov al,[edi]
      cmp al,[edx]
      jnz nminstr
      inc edx
      inc edi
    jmp rinstr
    '
    nminstr: 'no match
  pop ecx
  pop edx
  pop edi
  jmp trinstr 'carry on searching
  '
  ninstr: 'done
  '------------
  pop ecx
  pop edx
  pop edi
  sub edi,[s0]
  mov [function],edi
  '
  xinstr: 'exit
  '------------
  pop esi
  pop ebx
  end asm
  end function



  '-----------------------------------------
  function getfiles(byval w as bstr) as bstr
  '=========================================
  '
  dim as sys b,h,p,pf,ph,le,leh
  '
  asm
    '
    'CHECK VALID NAME
    '
    cmp dword ptr [w],0
    jz 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 &h80000000    'GENERIC_READ (0x80000000) GENERIC_WRITE (0x40000000)
    push [w] 'name
    call Createfile
    mov [h],eax
    '
    '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
    call SetFilePointer '
    mov [pf],eax        'File Pointer position low
    '
    'GET FILE SIZE
    '
    lea eax,[leh]       'PLONG lpFileSizeHigh
    push eax            '
    push [h]            'DWORD HANDLE
    call GetFileSize    '
    mov [le],eax        '
    '
    'CREATE STRING BUFFER
    '
    push [le]           'FILE LENGTH
    push 0              'OPTIONAL COPY POINTER
    'call SysAllocStringByteLen 'CREATE BSTR
    mov eax,[psysfuns]
    call [eax+160]
    mov [p],eax
    mov [function],eax
    '
    '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
    '
    'CLOSE HANDLE
    '
    push [h]
    call CloseHandle
    '
    ngetfile:
    '
  end asm

  end function


  '-------------------------------------------------------------------------
  function putfilen(byval w as bstr, byval s as sys, byval le as sys) as sys
  '=========================================================================
  '
  dim as sys b,h,p,pf,ph,leh
  '
  asm
    '
    'CHECK VALID NAME
    '
    xor eax,eax
    cmp dword ptr [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)
    push 0             'LP SECURITY  ATTRIBUTES OPT
    push 0             'SHARE MODE read(1) write(2)
    push &h40000000    'GENERIC_READ (0x80000000) GENERIC_WRITE (0x40000000)
    push [w] 'name
    call Createfile
    mov [h],eax
    '
    '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
    call SetFilePointer '
    mov [pf],eax        'File Pointer position low
    '
    'WRITEFILE
    '
    push 0              'LPOVERLAPPED lpOverlapped
    lea eax,[b]         'lpNumberOfBytesWritten
    push eax            '
    push [le]           'DWORD nNumberOfBytesToWrite
    push [s]            'LPVOID lpBuffer
    push [h]            'DWORD HANDLE
    call WriteFile
    mov [function],eax
    '
    'CLOSE HANDLE
    '
    push [h]
    call CloseHandle

    '
    nputfile:
    '
  end asm

  end function


  '---------------------------------------------------------
  function putfiles(byval w as bstr,byval s as bstr) as sys
  '=========================================================
  asm
    '
    'GET LENGTH of BSTR TO WRITE
    '
    mov eax,[s]
    '
    '
    push dword ptr [eax-4]
    push [s]
    push [w]
    call putfilen
    mov dword ptr [function],eax
    '
  end asm
  end function

  '-------------------------------------------
  sub getfile(wd as string, byref s as string)
  '===========================================
  dim as any ptr ps,pw        
  ps=varptr(s)
  pw=strptr(wd)
  asm
    push [pw]
    call getfiles
    push [ps]
    push eax
    call bstr_to_fstr
  end asm
  '
  '
  'CHECK FOR EMPTY OR NON-EXISTENT FILE
  '
  if s="" then
    ers="Problem with file: "+wd : ert=40
  end if
  end sub


  '--------------------------------------------------
  function putfile(sw as string ,ss as string) as sys
  '==================================================
  dim as any ptr w,s
  dim as sys le
  w=strptr(sw)
  s=strptr(ss)
  le=len(ss)
  asm
    push [le]
    push [s]
    push [w]
    call putfilen
    mov dword ptr [function],eax
  end asm
  end function


  '----------------------------------------------
  Function errors() as BSTR
  '==============================================
  '
  function=AllocString(strptr(ers), len(ers) )
  ers="" 'clear error buffer
  end function


  function getmem(byval a as sys) as BSTR
  '======================================
  asm
  mov eax,[a] 'requested size
  push eax
  push 0
  'call SysAllocStringByteLen
  mov eax,[psysfuns]
  call [eax+160]
  mov [function],eax
  '
  'initialise
  '----------
  '
  mov edx,eax     'pointer
  mov ecx,[eax-4] 'length
  '
  'STEP 4 BYTES
  '
  step4by:
    sub ecx,4
    jl nstep4by
    mov dword ptr [edx],0
    add edx,4
    jmp step4by
  nstep4by:
  add ecx,4
  '
  'STEP SINGLE BYTES REMAINDER
  '
  step1by:
    dec ecx
    jl nstep1by
    mov byte ptr [edx],0
    inc edx
    jmp step1by
  nstep1by:
  end asm
  end function


  sub FreeMem(byval a as BSTR)
  '===========================
  asm
    mov eax,[a]
    'cmp eax,0
    'jz nfreestr
      push eax
      'call SysFreeString
      mov eax,[psysfuns]
      call [eax+168]
    'nfreestr:
  end asm
  end sub



  '##############################'
  '##                            #
  '##                            #
  '##############################'
  ' ############################
  ' # ||                     | #
  ' # ||       MAP           | #
  ' # ||    FUNCTIONS        | #
  ' # ||                     | #
  ' # ||                     | #
  ' # ||                     | #
  ' # ||                     | #
  ' # ||                     | #
  '##############################'
  '##                            #
  '##############################'
  '
  #define getmemsa      8  ' 008h  GetMemory
  #define freememsa    16  ' 010h  FreeMemory
  #define allocsa     160  ' 0A0h  AllocString
  #define freesa      168  ' 0A8h  FreeString
  #define atofa       192  ' 0C0h  ascii to float
  #define ftoaa       200  ' 0C8h  float to ascii

  #define mboxa       2048 ' display string in message box
  #define addlista    2064 ' add to list
  #define delista     2072 ' delete
  #define delchaina   2080 ' delete chain of lists
  #define strinstla   2088 ' check string instance local
  #define strinstga   2096 ' check string instance global
  #define deltmpa     2104 ' free temp strings
  #define delloca     2112 ' free local strings 
  #define compnnula   2128 ' compare null-terminated strings
  #define sysdelbufsa 2144 ' del system buffs
  #define catbufprpa  2152 ' clear string lists
  #define badcatla    2160 ' add byref bstr to cat list [640]
  #define sadcatla    2168 ' add byval bstr to list (bstr params passed byval)
  #define zadcatla    2176 ' add z string to cat list   [640]
  #define joinsa      2184 ' join strings: copy into one
  #define compsa      2192 ' compare bstring
  #define compza      2200 ' compare zstrings
  #define assgloa     2208 ' assign to global bstr list [ebx+664]
  #define assloca     2216 ' assign to local bstr list [ebp-4]
  #define asstmpa     2224 ' assign to temp bstr list [ebp-8]
  #define asstrla     2240 ' assign bstring [local list]
  #define asstrga     2248 ' assign bstring [global list]
  #define trbstra     2256 ' transfer bstr
  #define compisa     2280 ' compare with bstr byref with byval
  #define comprisa    2288 ' compare with bstr byref with byval
  #define deref0a     2296 ' dereference if possible or return 0
  #define compna      2304 ' compare n bytes
  #define ltrimsa     2312 ' ltrim string
  #define rtrimsa     2320 ' rtrim string
  #define lcasesa     2328 ' lcase string
  #define ucasesa     2336 ' ucase string
  #define leftsa      2344 ' left string
  #define midbufza    2352 ' mid patch string: mid(z,i)=t
  #define midsa       2360 ' mid string
  #define ascsa       2368 ' asc string
  #define lensa       2376 ' 918 len string
  #define chrsa       2384 ' 920 chr
  #define midza       2392 ' 928 mid for asciiz string literals
  #define leftza      2400 ' left for asciiz
  #define lenza       2408 ' len for zstring and zstring2
  #define mids2a      2416 ' 2 param mid
  #define midz2a      2424 ' 2 param mid for asciiz
  #define ascs1a      2432 ' 1 param asc
  #define bindlsa     2440 ' bind imported libs and procs
  #define freelsa     2448 ' free dlls
  #define midbufa     2456 ' mid(s,i)=t
  #define stringaa    2464 ' string byte
  #define stringza    2472 ' string ztring
  #define stringsa    2480 ' string string
  #define spacesa     2488 ' space incl zstring
  #define printsa     2496 ' print string
  #define instrs2a    2504 ' 2 parm instr(s,u)
  #define getfile2a   2512 ' getfile "t.txt",f
  #define unicsa      2528 ' unicode (wide string)
  #define unics1a     2536 ' 1 param unicode (wide string)
  #define wchrsa      2544 ' wide chr
  #define numforma    2552 ' numeric format (numberformat)
  #define numformda   2560 ' numeric format default (numberformat)



  '==============
  sub mapruntimes
  '==============

  ' compact functions
  ' "here" header returns their entry points - 2
  '=================='=====
  asm                '      [ebx+..]
  adrf (mboxs)     ' 2048  800h  display string in message box
  adrf (noof)      ' 2056  808h
  adrf (addlist)   ' 2064  810h  add to list
  adrf (delist)    ' 2072  818h  delete
  adrf (delchain)  ' 2080  820h  delete chain of lists
  adrf (strinstl)  ' 2088  828h  check string instance local
  adrf (strinstg)  ' 2096  830h  check string instance global
  adrf (deltmp)    ' 2104  838h  free temp strings
  adrf (delloc)    ' 2112  840h  local strings 
  adrf (noof)      ' 2120  848h
  adrf (compnnul)  ' 2128  850h  compare null terminated string
  adrf (noof)      ' 2136  858h
  adrf (sysdelbufs)' 2144  860h  del system buffs
  adrf (catbufprp) ' 2152  868h  clear concat string lists
  adrf (badcatl)   ' 2160  870h  add byref bstr to cat list [640]
  adrf (sadcatl)   ' 2168  878h  add byval bstr to list (bstr params passed byva
  adrf (zadcatl)   ' 2176  880h  add z string to cat list   [640]
  adrf (joins)     ' 2184  888h  join strings: copy into one
  adrf (comps)     ' 2192  890h  compare bstring
  adrf (compz)     ' 2200  898h  compare zstrings
  adrf (assglo)    ' 2208  8A0h  assign to global bstr list [ebx+664]
  adrf (assloc)    ' 2216  8A8h  assign to local bstr list [ebp-4]
  adrf (asstmp)    ' 2224  8B0h  assign to temp bstr list [ebp-8]
  adrf (noof)      ' 2232  8B8h
  adrf (asstrl)    ' 2240  8C0h  assign string [local list ]
  adrf (asstrg)    ' 2248  8C8h  assign string [global list]
  adrf (trbstr)    ' 2256  8D0h  transfer bstr
  adrf (noof)      ' 2264  8D8h
  adrf (noof)      ' 2272  8E0h
  adrf (compis)    ' 2280  8E8h  compare with bstr byref with byval
  adrf (compris)   ' 2288  8F0h  compare with bstr byref with byval
  adrf (deref0)    ' 2296  8F8h  dereference if possible or return 0
  adrf (compn)     ' 2304  900h  compare n bytes
  adrf (ltrims)    ' 2312  908h  ltrim string
  adrf (rtrims)    ' 2320  910h  rtrim string
  adrf (lcases)    ' 2328  918h  lcase string
  adrf (ucases)    ' 2336  920h  ucase string
  adrf (lefts)     ' 2344  928h  left string
  adrf (midbufz)   ' 2352  930h  midbuf for zstring
  adrf (mids)      ' 2360  938h  mid string
  adrf (ascs)      ' 2368  940h  asc string
  adrf (lens)      ' 2376  948h  len string
  adrf (chrs)      ' 2384  950h  chr string
  adrf (midz)      ' 2392  958h  mid for asciiz for null terminated strings
  adrf (leftz)     ' 2400  960h  left for null terminated strings (zstring)
  adrf (lenz)      ' 2408  968h  length of zstring and zstring2 
  adrf (mids2)     ' 2416  970h  2 param mid
  adrf (midz2)     ' 2424  978h  2 param mid for asciiz
  adrf (ascs1)     ' 2432  980h  1 param asc
  adrf (bindls)    ' 2440  988h  bind imported libs and procs
  adrf (freels)    ' 2448  990h  free libs
  adrf (midbuf)    ' 2456  998h  mid(s,i)=t
  adrf (stringa)   ' 2464  9A0h  string byte
  adrf (stringz)   ' 2472  9A8h  string string bytes asciiz
  adrf (strings)   ' 2480  9B0h  string zstring
  adrf (spaces)    ' 2488  9B8h  space zstring
  adrf (prints)    ' 2496  9C0h  print string
  adrf (instrs2)   ' 2504  9C8h  2 parm instr(s,u)
  adrf (getfile2)  ' 2512  9D0h  getfile "t.txt",f
  adrf (strs)      ' 2520  9D8h  convert float to string
  adrf (unics)     ' 2528  9E0h  unicode (wide string)
  adrf (unics1)    ' 2536  9E8h  1 param unicode (wide string)
  adrf (wchrs)     ' 2544  9F0h  wide chr
  adrf (numform)   ' 2552  9F8h  numeric format (numberformat)
  adrf (numformd)  ' 2560 0A00h  numeric format default (numberformat)
  '
  '=======
  jmp xmrt
  '=======



  '------------------
  'LOCATE ENTRY POINT
  '==================
  '
  addrunfun:
  add eax,2
  mov [ecx],eax
  add ecx,8
  ret




  'PASSING LAZY STRINGS BYREF ? VOID



                   '
  '=================='
  noof: ' unused slots
  '------------------'
  here             '
  ret
  '------------------'


  '=================='
  mboxs: '2048       '
  '------------------'
  here             '
  mov eax,[esp+4]  '
  pusha            '
  push &h0048324f  ' title: O2H
  mov ecx,esp      '
  push 0           '
  push ecx         ' title string
  push eax         ' message string
  push 0           '
  call messagebox  '
  pop eax          ' unstack title string
  popa             '
  ret 4            '
                   '
  '=================='
  'STRINGS           '
  '=================='


  'ADD TO CHAINABLE LIST
  '=====================

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



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

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



  'DELETE CHAINED LISTS OF STRINGS BACKWARDS
  '=========================================
                   '
  '------------------'
  delchain: '2080    '
  '=================='
  here
  delchaini:
  '       '
  cmp dword ptr [edi],0 'no list available
  jz ndelchain     '
  '
  push eax
  push edx         '
  '
  push edi         'address of list chain
  mov edi,[edi]    'first list in the chain
  call delisti     'delete current list bstrs
  pop edx          '
  mov [edx],edi    'make current base list
  mov edi,edx      'restore list chain base
  '
  pop edx
  pop eax
  ndelchain:
  ret


  '--------------
  strinstl: '2088
  '==============
  here
  cmp dword ptr [ecx],0
  jz nstrinstl
  ret
  nstrinstl:
  push ecx
  push 0
  call getmem
  pop ecx
  lea edi,[ebp-4]
  call addlisti
  mov [ecx],edi  ' assign pointer to variable
  ret

  '--------------
  strinstg: '2096
  '==============
  here
  cmp dword ptr [ecx],0
  jz nstrinstg
  ret
  nstrinstg:
  push ecx
  push 0
  call getmem
  pop ecx
  'mov eax,0
  lea edi,[ebx+664]
  call addlisti
  mov [ecx],edi  ' assign pointer to variable
  ret



  '------------
  deltmp: '2104
  '============
  here
  deltmpi:
  lea edi,[ebp-8]
  call delchaini 'delete temp strings
  ret



  '------------
  delloc: '2112
  '============
  here
  lea edi,[ebp-4]
  call delbuf   'delete local strings and buffer
  ret


  '--------------
  compnnul: '2128
  '==============
  here
  mov ecx,[esp+8]  ' length
  mov edi,[esp+4]  ' address
  cmp edi,0        ' test null pointer
  jz cmpbnok       '
  '
  cmpbdo:          ' compare each char
    dec ecx   
    jge cmpb2
      '
      'end string zero flag
      '
      xor eax,eax
      ret 8
    cmpb2:
    cmp byte ptr [edi],0
    jnz cmpbnok    '
    inc edi        '
  jmp cmpbdo       '
  cmpbnok:
  ret 8



  '=================='
  '=================='
                   '

  '##################'
  ' TYPLIST: LEN PTR '
  '##################'
  '
  '
  '
  '
  '
  '   =============
  '   |  |  |  |  |
  '   ============
  '   #  #  #  #  #
  '   #  #  #  #  #
  ' 
  '  ###############
  '  #             #
  '  #             #
  '  #             #
  '  #             #
  '  #             #
  '  #             #
  '  #             #
  '  #             #
  '  ###############


  'NEWBUFS IN O2FINI.BAS


  'DELETE LIST BUFFERS

  '----------------
  sysdelbufs: '2144
  '================
   here
   push eax
   'lea edi,[ebp-8]   'temp list
   'call delbuf
   'lea edi,[ebp-4]  'local list
   'call delbuf
   lea edi,[ebx+664] 'global list
   call delbuf
   push [ebx+680]    'lib handle buffer
   call freemem
   pop eax
   ret

   delbuf:
  '=======
  '
  cmp dword ptr [edi],0
  jz ndempty
  call delchaini 'delete strings in list
  push [edi]
  call freemem     'free this final list
  mov dword ptr [edi],0
  ndempty:
  ret






  'PREPARE JOIN-BUFFER

  '=================='
  catbufprp: '2152        '
  '=================='
  here
  push edi
  push eax
  'mov edi,[ebx+640]
  mov edi,[ebp-12]
  cmp edi,0
  jnz ncatbufmem
    push 1024
    call getmem
    mov [ebp-12],eax
    mov edi,eax
    mov dword ptr [edi],16 
    mov dword ptr [edi+16],-1
  ncatbufmem:
  '
  add dword ptr [edi],16 'stride
  add edi,[edi]
  mov dword ptr [edi-16],-1 'PLACE STOP MARKER AT OFFSET 16 OR MORE
  pop eax
  pop edi
  ret



  'ADD BSTR TO LIST  ' byref ptr in eax, list in edi

  '------------------
  badcatl: '2160     ' ptr in eax, list in edi
  '=================='
  here
  cmp eax,0         'pointer exist?
  jnz badcatl1      '
  ret
  '
  badcatl1:        '
  '--------
  '
  mov eax,[eax]    'deref
  cmp eax,0        'check pointer
  jnz badcatl2     '
  ret
  '
  badcatl2:
  '--------
  '
  mov ecx,[eax-4]   'get length
  cmp ecx,0
  jg badcatl3
  ret
  '
  badcatl3:
  '--------
  '
  push esi
  push edi
  'mov edi,[ebx+640] 'catlist
  mov edi,[ebp-12]  'cat list 
  mov esi,[edi]     'next place
  add dword ptr [edi],16 'stride increment
  add edi,esi       'location
  '
  mov [edi],ecx     'store byte length
  mov [edi+4],eax   'store pointer
  mov [edi+8],edx   'store type
  pop edi
  pop esi
  ret               '


  '
  'ADD BSTR TO LIST  ' byval bstr in eax, list in edi
  '
  '-------------------
  sadcatl: '2168     ' bstr byval in eax
  '=================='
  here
  cmp eax,0
  jnz badcatl2
  ret

  'ADD ZSTR TO LIST  '

  '------------------'
  zadcatl: '2176     ' ptr in eax
  '=================='
  here              '
  cmp eax,0 'check for null pointer
  jnz nzad
  ret
  nzad:
  call lenzi
  cmp ecx,0
  jg badcatl3
  ret


  '----------
  lenz: '2408  length of zstring & zstring2
  '==========
  here
  mov eax, [esp+4]
  call lenzi
  mov eax,ecx
  cmp dl,2
  jnz nwidelen
  shr eax,1
  nwidelen:
  ret 4


  '-----
  lenzi:
  '=====
  '
  cmp dl,2
  jz lenz2
  '
  push eax        ' save string base pointer
  push edx        '
  xor ecx,ecx     ' clear counter
  rlenz1:         '
    mov dl,[eax]  ' get character
    inc ecx       ' add to count
    inc eax       ' add to pointer
    cmp dl,0      ' is it a null char
  jnz rlenz1      ' repeat if not
  pop edx         '
  pop eax         ' restore string base pointer
  dec ecx         ' count excluding null terminator char
  ret
  '
  '-----
  lenz2:
  '-----
  '
  push eax        ' save string base pointer
  push edx        '
  xor ecx,ecx     ' clear counter         ' 
  rlenz2:         '
    mov dx,[eax]  ' get character
    add ecx,2     ' add to count
    add eax,2     ' add to pointer
    cmp dx,0      ' is it a null char
    jnz rlenz2    ' repeat if not
  pop edx
  pop eax         ' restore string base pointer
  sub ecx,2       ' count excluding null terminator char
  ret


  'JOIN STRINGS TOGETHER
  '
  '
  '-----------'
  joins: '2184 '( eax destptr if exists, edi list of strings to) eax new string ptr
  '===========
  here              '
  '                 '
  joinsi:           '
  '                 '
  push esi          'save reg
  push edi          'save reg
  '
  'mov edi,[ebx+640] 'the join string list
  mov edi,[ebp-12]  'the join string list
  mov esi,[edi]     'count step
  '
  add edi,esi       'boundary of data
  mov dword ptr [edi],-1 'set end stop
  sub esi,16        'base zero
  '------------------ '
  push edx          'save wide char flag
  xor ecx,ecx       'byte counter
  '
  '-------
  docount:          'iterate through strings in reverse
  '-------
    '
    sub edi,16      'last data downward
    sub esi,16      'down counter
    jl xdocount     'exit
    mov edx,[edi]   '
    cmp edx,-1      'CHECK FOR STOP MARKER
    jz xdocount     '
    '
    'ADJUSTMENT FOR WIDE CHARACTERS
    '
    cmp byte ptr [edi+8],2 'wide string?
    jnz ndivco
    shr edx,1 'convert to wide character count
    ndivco:
    add ecx,edx     'add length of string
    '
  jmp docount       'repeat
  '
  xdocount:         'finished counting bytes
  '
  mov esi,ecx       'byte total req
  pop ecx ' wide string flag
  cmp cl,2
  jnz nscalcha
  shl esi,1 'SCALE FOR WIDE STRING DEST
  nscalcha:
  '
  '
  'CHECK EMPTY (NO CHARS COUNTED)
  '
  cmp esi,0
  jnz nejoinsi
    cmp eax,0
    jz nejoinsi 'to create a null Bstring
    mov word ptr [eax],0 ' PLACE NULL TERMINATION: (2 NULL BYTES)
    jmp ajoinsi 'finish early    
  nejoinsi:
  '
  'accepts 0 byte requests
  '
  cmp eax,0         'request new Bstring or use existing Zstring
  '
  'itr check overflow before
  '
  jnz nnews
    push ecx        'save wide string flag
    push esi        'req n bytes
    call getmem     'create new string
    pop ecx         'restore wide string flag
    cmp eax,0       'test for success
    jz ajoinsi      'failure so exit with null bstr
    cmp dword ptr [eax-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 [eax+esi],0 'insert double null into target boundary
  '
  '-----
  dnews: 'entry point for copy joining
  '-----
  '
  '
  push eax          'target base
  push edi          'save stop point
  '
  cmp cl,2          'check for wide dest
  mov ecx,esi       'byte count
  jz rcopa2
  '
  '------------------------------------------
  rcopa1: 'append each string to ascii string
  '==========================================
  '
  add edi,16       'step forward for next string
  mov ecx,[edi]    'LENGTH OR STOP MARKER
  cmp ecx,-1       'end stop
  jz xcopa         'copied all the bytes so exit
  '
  cmp ecx,0
  jle rcopa1
  '
  mov esi,[edi+4] 'pointer    
  cmp byte ptr [edi+8],2 'wide strings
  jz rcops12
  '
  '------------------------------
  rcops11: 'asc to asc string copy
  '------------------------------
  '               'copy over
  mov dl,[esi]  'source byte
  mov [eax],dl  'dest
  inc eax       'inc dest
  inc esi       'inc src
  dec ecx       'downcount souce bytes to copy
  jg rcops11    'continue copying
  jmp rcopa1
  '
  '
  '-----------------------------------
  rcops12: ' wide to ascii string copy
  '-----------------------------------
  ' 
  mov dx,[esi]  'source byte
  mov [eax],dl  'dest
  inc eax       'inc dest
  add esi,2     'inc src
  sub ecx,2     'downcount source bytes to copy
  jg rcops12    'continue copying
  jmp rcopa1
  '
  '
  '-----------------------------------------
  rcopa2: 'append each string to wide string
  '=========================================
  '
  add edi,16       'step forward for next string
  mov ecx,[edi]    'LENGTH OR STOP MARKER
  cmp ecx,-1       'end stop
  jz xcopa         'copied all the bytes so exit
  cmp ecx,0
  jle rcopa2
  '
  mov esi,[edi+4] 'pointer    
  cmp byte ptr [edi+8],2 'wide strings
  jz rcops22
  '
  '--------------------------------
  rcops21: 'asc to wide string copy
  '--------------------------------
  '
  xor edx,edx   'clear transfer reg
  mov dl,[esi]  'source byte
  mov [eax],dx  'dest wide string
  add eax,2     'inc dest
  inc esi       'inc src
  dec ecx       'downcount source bytes to copy
  jg rcops21    'continue copying
  jmp rcopa2
  '
  '
  '----------------------------------
  rcops22: ' wide to wide string copy
  '----------------------------------
  ' 
  mov dx,[esi]  'source byte
  mov [eax],dx  'dest
  add eax,2     'inc dest
  add esi,2     'inc src
  sub ecx,2     'downcount source bytes to copy
  jg rcops22    'continue copying
  jmp rcopa2
  '
  '
  '(null string or Bstring denied)
  '
  '
  xcopa: 'terminate join procedure
  '-----
  '
  pop edi           'restore stop point
  pop eax           'restore target base
  '
  ajoinsi: 'cleardown for zero byte strings (or Bstring denied)
  '-------
  '
  'mov edx,[ebx+640]
  mov edx,[ebp-12]
  sub edi,edx
  mov [edx],edi    'boundary for prior concatenation segment
  '
  '
  xjoinsi:
  '-------
  '
  pop edi          'restore edi
  pop esi          'restore esi
  ret     
  '



  'COMPARE DYNAMIC STRINGS
  '
  '-----------
  comps: '2192 '  (compare [esp+8]-[esp+4] )
  '===========
  here               '
  '
  compsi:            ' select least length
  '
  mov edx,[esp+8]  '
  mov ecx,[esp+4]  '
  cmp edx,0        ' test null ptr
  jz cmpnok1       '
  mov edx,[edx-4]  '
  cmpnok1:         '
  cmp ecx,0        ' test null ptr
  jz cmpnok2       '
  mov ecx,[ecx-4]  '
  cmpnok2:         '
  cmp edx,0        ' test zero length
  jz cmpnok        '
  cmp ecx,0        ' test zero length
  jz cmpnok        '
  cmp edx,ecx      '
  cmovl ecx,edx    ' select least length
  mov edx,[esp+8]  '
  mov edi,[esp+4]  '
  cmpdo:           ' compare each char
    mov al,[edx]   ' from L string 
    cmp al,[edi]   ' from R string
    jnz cmpxr1     '
    inc edx        '
    inc edi        '
    dec ecx        '
  jge cmpdo        '
                   ' tie break: which string is longer
  mov edx,[esp+8]  '
  mov edx,[edx-4]  ' get  Llength
  mov ecx,[esp+4]  '
  mov ecx,[ecx-4]  ' get R length
  cmpnok:         '
  cmp edx,ecx      ' null ptrs, null lengths or tie breaks
  cmpxr1:          ' flags hold result
  ret 8            '
                   '



  'COMPARE Z STRINGS

  '-------------
  compz: '2200 '  (compare [esp+8]-[esp+4] ) zstrings
  '=============
  here             '
  mov edx,[esp+8]  '
  mov ecx,[esp+4]  '
  cmp edx,0        ' test null pointers
  jz cmpznok       '
  cmp ecx,0
  jz cmpznok       '
  mov edi,ecx      '
  cmpzdo:          ' compare each char
    mov al,[edx]   ' from L string
    mov cl,[edi]   '
    cmp al,cl      ' from R string
    jnz cmpzxr     '
    cmp al,0       '
    jz cmpzxr      '
    inc edx        '
    inc edi        '
  jmp cmpzdo       '
  cmpzxr:          ' flags hold result
  ret 8            '
  cmpznok:
  cmp edx,ecx
  ret 8
                   '
  'ADD BSTR TO GLOBAL LIST

  '------------
  assglo: '2208
  '============
  here
  lea edi,[ebx+664]
  call addlisti
  ret

  'ADD BSTR TO LOCAL LIST

  '------------
  assloc: '2216
  '============
  here
  lea edi,[ebp-4]
  call addlisti
  ret
  'ADD BSTR TO TEMP LIST

  '------------
  asstmp: '2224 
  '============
  here
  asstmpi:
  lea edi,[ebp-8]
  call addlisti
  ret


  'ASSIGN LOCAL BSTRING

  '------------
  asstrl: '2240 ' dyn addr in ecx, bstr in eax
  '============
  here
  mov edi,[ecx]    '
  cmp edi,0        ' pointer exists?
  jnz naddl        '
    lea edi,[ebp-4]'
    call addlisti  ' add to chainable list
    mov [ecx],edi  ' assign pointer to variable
    ret
  naddl:           '
  cmp dword ptr [edi],0 ' bstring already exists?
  jz nwipe         '
    push eax       '
    push [edi]     '
    call freemem   ' release original bstr
    pop eax        '
  nwipe:           '
  mov [edi],eax    ' assign bstr to pointer
  ret                '



  'ASSIGN GLOBAL/STATIC BSTR

  '------------
  asstrg: '2248 ' dyn addr in ecx, bstr in eax
  '============
  here               '
  mov edi,[ecx]    '
  cmp edi,0        ' pointer exists?
  jnz naddlg       '
    lea edi,[ebx+664]
    call addlisti  ' add to chainable list
    mov [ecx],edi  ' assign pointer to variable
     ret
  naddlg:          '
  cmp dword ptr [edi],0' bstring already exists?
  jz nwipeg        '
    push eax
    push [edi]     '
    call freemem   ' release original bstr
    pop eax        '
  nwipeg:          '
  mov [edi],eax    ' assign bstr to pointer
  ret                '




  'TRANSFER BSTRING (return value in function)

  '------------
  trbstr: '2256 ' transfer dyn string for returning BSTR
  '============
  here             '
  cmp edi,0        '
  jnz nxis1        '
    xor eax,eax    '
    ret            '
  nxis1:           '
  cmp dword ptr [edi],0 ' string already exists?
  jnz nxis2        '
    xor eax,eax    '
    ret            '
  nxis2:           '
  mov eax,[edi]    '
  mov dword ptr [edi],0 ' null record on del list
  ret                '




  'BSTRING BYREF COMPARE

  '------------
  compis: '2280 'bstr byref compare operand with accum
  '============
  here             '
  mov eax,[esp+8]  ' operand
  cmp eax,0        '
  jz ncompis       '
  mov eax,[eax]    '
  '
  ncompis:         '
  '  
  mov [esp+8],eax  '
  jmp compsi       '


  '-------------
  compris: '2288 'bstr byref compare with accum with operand
  '=============
  here             '
  mov eax,[esp+8]  ' operand
  cmp eax,0        '
  jz ncompris      '
  mov eax,[eax]    '
  ncompris:        '
  mov ecx,[esp+4]  '
  mov [esp+8],ecx  ' swap so that accum is compared with operand
  mov [esp+4],eax  ' 
  jmp compsi       '




  'DEREF IF POSSIBLE OR RETURN 0

  '------------
  deref0: '2296
  '============
  here
  cmp eax,0
  jnz derefok
  ret
  derefok:
  mov eax,[eax]
  ret



  '-----------
  compn: '2304     '  COMPARE [esp+12] WITH [esp+4] NSTRING
  '===========
  here
  mov edx,[esp+12]  ' lstring
  mov edi,[esp+4]   ' rstring
  cmp edx,0         ' test null pointer
  jz cmpnnok        '
  cmp edi,0         ' test null pointer
  jz cmpnnok        '
  mov ecx,[esp+16]  ' length lstring
  cmp ecx,[esp+8]   ' compare length of rstring
  cmovg ecx,[esp+8] 'least length
  '
  cmpndo:           ' compare each char
    dec ecx   
    jge cmpn2
      '
      'tie break on length
      '
      mov ecx,[esp+16] 'l length
      cmp ecx,[esp+8]  'r length
      ret 16
    cmpn2:
    mov al,[edx]   ' from L string
    cmp al,[edi]   ' from R string
    jnz cmpnxr     '
    inc edx        '
    inc edi        '
  jmp cmpndo       '
  cmpnxr:          ' flags hold result
  ret 16
  '
  'tie break on null ptr
  '
  cmpnnok:
  cmp edx,edi
  ret 16
                   '

 

  '
  '                                      ####
  '         ###                        ###   ####
  '       ##   ##                    ##          ####STRINGS
  '     ##       ##                 ##
  '   ##          ##               ##
  '  ##            ##            ##
  '  ##             ##         ##
  '                   ##     ##
  '                     #####
  '
  '
  '=================
  'string management
  '=================
'


  '------------
  ltrims: '2312
  '============
  here
  push esi
  mov edi,0
  mov esi,[esp+8] 'pointer
  cmp esi,0
  jz xltrim1
  mov edi,[esi-4] 'length
  xltrim1:
  cmp edi,0
  jle xltrim2

  and edx,2
  jnz ltrimr2
  '
  ltrimr:
  dec edi
  jl ltrimx
  mov al,[esi]
  inc esi
  cmp al,32
  jle ltrimr
  jmp ltrimx

  ltrimr2:
  sub edi,2
  jl ltrimx2
  mov ax,[esi]
  add esi,2
  cmp ax,0x20
  jle ltrimr2
  ltrimx2:
  inc edi
  dec esi

  ltrimx:
  inc edi
  dec esi

  xltrim2:
  push edi
  push 0
  'call SysAllocStringByteLen
  call [ebx+160] 'AllocString
  push eax
  '
  push edi ' remaining length
  push esi ' start of str
  push eax ' new string dest
  call copyn
  '
  pop eax
  pop esi
  ret 4



  '------------
  rtrims: '2320
  '============
  here
  push esi
  mov edi,0
  mov esi,[esp+8]  ' pointer
  cmp esi,0        'check null ptr
  jz xrtrim1
  mov edi,[esi-4]  ' length
  xrtrim1:
  cmp edi,0
  jle xrtrim2
  add esi,edi   ' end of string
  and edx,2
  jnz rtrimr2

  rtrimr:
  dec edi
  jl rtrimx
  dec esi
  mov al,[esi]
  cmp al,32
  jle rtrimr
  jmp rtrimx
  '
  rtrimr2:
  sub edi,2
  jl rtrimx2
  sub esi,2
  mov ax,[esi]
  cmp ax,0x20
  jle rtrimr2
  rtrimx2:
  inc edi
  '
  rtrimx:
  mov esi,[esp+8]
  inc edi

  xrtrim2:
  push edi
  push 0
  'call SysAllocStringByteLen
  call [ebx+160] ' AllocString
  push eax
  '
  push edi ' remaining length
  push esi ' start of str
  push eax ' new string dest
  call copyn
  '
  pop eax
  pop esi
  ret 4



  '------------
  lcases: '2328
  '============
  here
  push esi
  mov esi,[esp+8]
  mov edi,0
  cmp esi,0 'null string test
  jz lwrx1
  mov edi,[esi-4]
  lwrx1:
  push edx
  push edi
  push 0
  'call SysAllocStringByteLen
  call [ebx+160]
  pop edx
  mov ecx,edi
  mov edi,eax
  push eax
  and edx,0xff 'supporting wide code

  lwrr:
  sub ecx,edx
  jl lwrx
  mov al,[esi]
  cmp al,65
  jl lwrn
  cmp al,90
  jg lwrn
  add al,32
  lwrn:
  mov [edi],al
  add esi,edx
  add edi,edx
  jmp lwrr

  lwrx:
  pop eax
  pop esi
  ret 4



  '------------
  ucases: '2336
  '============
  here
  push esi
  mov esi,[esp+8]
  mov edi,0
  cmp esi,0 'null string test
  jz uprx1
  mov edi,[esi-4]
  uprx1:
  push edx
  push edi
  push 0
  'call SysAllocStringByteLen
  call [ebx+160]
  pop edx
  mov ecx,edi
  mov edi,eax
  push eax
  and edx,0xff 'supporting wide code

  uprr:
  sub ecx,edx
  jl uprx
  mov al,[esi]
  cmp al,97
  jl uprn
  cmp al,122
  jg uprn
  sub al,32
  uprn:
  mov [edi],al
  add esi,edx
  add edi,edx
  jmp uprr

  uprx:
  pop eax
  pop esi
  ret 4



  '-----------
  lefts: '2344
  '===========
  here
  pop eax  'return address
  pop ecx  'string
  push 1   'insert offset
  push ecx 'string
  push eax 'return address
  jmp midsi




  '----------
  mids: '2360
  '==========
  here
  '
  midsi: 'entry point for bstrings
  '
  mov ecx,0          ' default source length is 0
  mov edi,[esp+4]    ' ptr
  cmp edi,0
  jz midok1
  mov ecx,[edi-4]    'get source length
  '
  midok1: 'the length of source
  '
  '------------------------------                   '
  astrin: 'entry point for asciiz
  '------------------------------

  'support for wide strings
  '
  push ecx      'length
  and  edx,&hff ' char width
  mov ecx,edx
  dec cl
  jz nadjwid
  mov eax,[esp+12]
  dec eax
  shl eax,cl
  inc eax
  mov [esp+12],eax
  shl dword ptr [esp+16],cl
  nadjwid:
  pop ecx
  '
  push esi           ' preserve esi
  '
  mov edx,[esp+12]   ' get offset
  '
  '-------------     '
  'NEG OFFSETS       '
  '-------------     '
  '
  cmp edx,0          '
  jnz midnoinc
  inc edx            'change offset 0 to 1
  midnoinc:

  jg midok2         'skip if offset not negative
  '
  inc edx
  add edx,ecx       'add length to negative offset to obtain offset
  jg midok2         '
  mov edx,1         'must be at least 1
  '
  midok2: 'assess whether any bytes are available    
  '         '
  cmp edi,0          'null or empty source string
  jz midnul          '
  cmp ecx,edx        'compare bytes available with offset
  jge midok3         'not past end end of source string
  '
  midnul: 'no bytes are available so a null string is to be returned
  '
  push 0             '
  push 0             '
  'call SysAllocStringByteLen
  call [ebx+160]    'AllocString
  jmp midx           'null string allocation done
  '
  midok3: 'at least one byte is available to return
  '
  mov eax,ecx        'length of source
  dec edx            'zero base adjust the offset
  sub eax,edx        'deduct from source to get bytes available
  cmp eax,[esp+16]   'bytes requested
  jle midok4
  mov eax,[esp+16] 'bytes requested iss less than bytes avail
  '
  midok4:
  '
  push eax           'bytelength for copyn
  add edi,edx        'src base+offset
  push edi           'source for copyn
  push eax           'bytelength for SysAlloc
  push 0             'null string for SysAlloc
  'call SysAllocStringByteLen
  call [ebx+160] 'AllocString
  push eax           'new string dest for copyn
  mov esi,eax        'retain new string in non-volatile reg
  call copyn         '
  mov eax,esi        ' new bstring to return
  '
  midx:                '
  '
  pop esi            'restore esi
  ret 12             '



  '----------
  ascs: '2368
  '==========
  here               '
  ascsi:
  mov ecx,[esp+4]  'pointer
  mov edx,[esp+8]  'req pos
  xor eax,eax
  cmp ecx,0
  jz ascx
  mov edi,[ecx-4]  'length
  cmp edi,0
  jle ascx

  ascsi1:            '
  cmp edx,0        '
  jnz asco1        '
  inc edx          'set to 1

  asco1:             '
  jge ascso2       'neg spec
  add edx,edi      '
  inc edx          'base adjust

  ascso2:            '
  cmp edx,1        'lower limit check
  jl ascx          'leave as null
  cmp edi,edx      'upper limit check
  jl ascx          'leave as null
  dec edx          'base adjust
  add ecx,edx      '
  mov al,[ecx]     '

  ascx:
  ret 8            '



  '----------
  lens: '2376
  '==========
  here
  mov eax,[esp+4]
  cmp eax,0
  jz nlens
  mov eax,[eax-4]
  mov cl,dl
  dec cl
  jz nlens
  shr eax,cl
  nlens:
  ret 4



  '----------
  chrs: '2384
  '==========
  here
  push 1           '
  push 0           '
  'call SysAllocStringByteLen
  call [ebx+160] 'AllocString
  mov dl,[esp+4]   '
  mov [eax],dl     '
  ret 4            '



  'mid for asciiz

  '----------
  midz: '2392
  '==========
  here
  midzi:
  mov edi,[esp+4] 'pass base in edi
  mov ecx,edi
  cmp dl,2
  jz rmidz2
  rmidz1:
    mov al,[ecx]
    inc ecx
    cmp al,0
  jnz rmidz1
  dec ecx          'exclude null term in count
  sub ecx,edi      'pass length in ecx
  jmp astrin

  rmidz2:
    mov ax,[ecx]
    add ecx,2
    cmp ax,0
  jnz rmidz2
  sub ecx,2        'exclude null term in count
  sub ecx,edi      'pass length in ecx
  jmp astrin



  '-----------
  leftz: '2400
  '===========
  here
  pop eax  'return address
  pop ecx  'string base
  push 1   'insert offset
  push ecx 'string basr
  push eax 'return address
  jmp midzi



  '2 PARAM MID

  '-----------
  mids2: '2416
  '===========
  here
  pop eax  'return address
  pop ecx  'string base
  pop edi  'string offset
  '
  cmp ecx,0
  jnz nnulm2el
    '
    push 0 'length req
    jmp nnulm2ei
    '
  nnulm2el:
    '
    push [ecx-4] 'length req
    '
  nnulm2ei:
  '
  push edi 'string offset
  push ecx 'string base
  push eax 'return address
  jmp midsi


  '-----------
  midz2: '2424
  '===========
  here               '
  pop eax          'return address
  pop ecx          'address base
  pop edi          'offset
  push &h7fffffff  'req max length
  push edi         'offset
  push ecx         'ptr
  push eax         'return address
  jmp midzi        '


'SINGLE PARAM ASCII

  '-----------
  ascs1: '2432
  '===========
  here
  pop ecx            'return address
  pop eax            'string base
  push 1             'offset
  push eax           'string pointer
  push ecx           'return address
  jmp ascsi          '2 term asc






  'O2H RUNTIME BIND TO IMPORTED DLLS

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

  '------------
  bindls: '2440
  '============
  here
  '
  'SAVE BASE
  '---------
  '
  push ebx 'GLOBAL BASE [ESP+4]
  '
  'STORE BINDING DATA
  '------------------
  '
  mov edi,eax
  mov [ebx+672],edi 'BINDING DATA
  '
  'PREPARE LIST FOR LIBRARY HANDLES (MAX 512)
  '--------------------------------------
  '
  'this list is used for unloading libraries with FREELIBRARY
  '
  mov eax,[ebx+680]
  add eax,[eax]         '1ST DWORD HOLDS OFFSET FOR NEXT DATA
  add eax,4
  mov dword ptr [eax],1 'SET MARKER
  add eax,4
  push eax  'HOLD LIBRARY LIST BASE ON STACK [ESP]
  '
  '
  'GET COMMAND
  '-----------
  '
  mov al,[edi]
  '
  '--------------------
  rbindlsa: 'LOOP POINT
  '====================
  '
  'CHECK FOR TERMINATORS
  '---------------------
  '
  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 bindlslok
  mov eax,100 'REPORT INVALID COMMAND
  jmp xbindls
  bindlslok:
  '
  call bindlsw
  push ecx
  push ecx
  call LoadLibrary
  'call [ebx+24] 'library
  pop ecx
  '
  'CHECK VALID LIBRARY HANDLE
  '--------------------------
  '
  cmp eax,0
  jnz nbindlsl
  mov eax,101 'REPORT INVALID LIBRARY NAME
  jmp xbindls
  nbindlsl:
  '
  'HOLD/SAVE LIBRARY HANDLE
  '------------------------
  '
  mov esi,eax 'LIBRARY HANDLE
  pop eax
  mov [eax],esi
  add eax,4 'NEXT LIBRARY HANDLE STORAGE ADDRESS
  push eax
  mov al,[edi]
  '
  'CHECK FOR GETPROCADDRESS
  '------------------------
  '
  cmp al,2
  jnz rbindlsa 'NEXT PROC ADDRESS OR NEXT LIBRARY
  '
  '
  'NEXT PROC ENTRY
  '---------------
  '
  '-----------------------------------
  rbindlsp: 'LOOP POINT FOR PROCEDURES
  '===================================
  '
  'HOLD TABLE OFFSET
  '-----------------
  '
  inc edi
  mov edx,[edi] 'VARIABLE ADDRESS (will be an offset from esi)
  push edx
  add edi,3
  '
  'GET PROC NAME
  '-------------
  '
  call bindlsw
  push ecx   ' PROCNAME PTR
  push ecx   ' PROCNAME PTR
  push esi   ' LIBRARY
  call getprocaddress
  'call [ebx+40] 'getprocaddress
  pop ecx    ' RESTORE PROCNAME PTR
  pop edx    ' RESTORE TABLE OFFSET
  '
  'CHECK VALID PROC ADRESS
  '-----------------------
  '
  cmp eax,0
  jnz bindlspok
  mov eax,102 ' REPORT PROCADDRESS ERROR
  jmp xbindls
  '
  '---------
  bindlspok:
  '=========
  '
  'STORE PROCADDRESS IN TABLE
  '--------------------------
  '
  add edx,[esp+4] ' ADD STATIC VARIABLE BASE [ESI]
  mov [edx],eax   ' STORE ADDRESS
  mov al,[edi]
  '
  'ANOTHER PROC?
  '-------------
  '
  cmp al,2
  jz rbindlsp 'ANOTHER PROCADRESS ENTRY
  '
  'NEXT LIB OR EXIT
  '----------------
  '
  jmp rbindlsa 'OTHERWISE NEXT LIB OR FINISH
  '
  'EXIT POINT
  '----------
  '
  '-------
  xbindls:
  '=======
  '
  'MUST RETAIN EAX/AL CONTENTS
  '
  pop esi 'NEXT LIB HANDLE STORAGE ADDRESS
  mov edx,[ebx+680]
  sub esi,edx
  sub esi,4
  mov [edx],esi 'STORE NUMBER OF LIBRARY ADDRESSES *4
  pop ebx 'RESTORE BASE
  ret     'RETURN
  '
  '
  'READ FOLLOWING NAME
  '-------------------
  '
  '-------------------------------------
  bindlsw: 'ADVANCE BEYOND WORD BOUNDARY
  '=====================================
  '
  inc edi
  mov ecx,edi
  '
  '---------------------
  rbindlsw: ' LOOP POINT
  '---------------------
  '
  mov al,[edi]
  inc edi
  cmp al,0
  jnz rbindlsw
  ret





  'FREE DLLS USING LIST

  '------------
  freels: '2448
  '============
  here
  '
  'LOCATE END POSITION
  '
  mov edi,[ebx+680]
  mov eax,[edi]
  cmp eax,0      'CHECK IF EMPTY
  jz xxfreels
  add edi,eax
  add edi,4
  '
  '
  '--------------------------
  'REPEAT TILL MARKER OR NULL
  '--------------------------
  '
  'FREE LIBS WORKING BACKWARDS TILL BOUNDARY MARKER
  '
  rfreels:
    sub edi,4
    'cmp dword ptr [edi],0
    'jz xfreels
    cmp dword ptr [edi],1 'EXIT AT MARKER
    jz xfreels
    push [edi]
    call FreeLibrary
    'call [ebx+32] 'FreeLibrary
  jmp rfreels
  '
  xfreels:
  '
  mov eax,[ebx+680]
  sub edi,eax
  sub edi,4
  mov [eax],edi
  xxfreels:
  ret



  'COMMAND FORMAT:
  '
  'MID()=
  '
  'assume matching character widths
  '  
  '-------------
  midbufz: '2352
  '=============
  here
  dec dword ptr [esp+8] 'offset base 0
  cmp dl,2
  jz midbufzw
  '
  mov ecx,[esp+4]
  cmp ecx,0
  jz xmidbuf
  rmidbuflenz:
  mov al,[ecx]
  inc ecx
  cmp al,0
  jnz rmidbuflenz
  dec ecx
  mov edx,ecx
  mov ecx,[esp+4]
  sub edx,ecx
  jmp midbuflres

  midbufzw:
  '========
  shl dword ptr [esp+8] 'wide character offset
  mov ecx,[esp+4]
  cmp ecx,0
  jz xmidbuf
  rmidbuflenz2:
  mov ax,[ecx]
  add ecx,1
  cmp ax,0
  jnz rmidbuflenz2
  sub ecx,2
  mov edx,ecx
  mov ecx,[esp+4]
  sub edx,ecx
  jmp midbuflres
 

  '------------
  midbuf: '2456
  '============
  here
  dec dword ptr [esp+8] 'offset base 0
  cmp dl,2
  jnz nmidbufwid
  shl dword ptr [esp+8] 'wide character offset
  '
  nmidbufwid:
  '
  mov ecx,[esp+4]   'byref buffer ptr
  'cmp ecx,0
  'jz xmidbuf        'null buffer
  'mov ecx,[ecx]     'deref
  cmp ecx,0
  jz xmidbuf
  mov edx,[ecx-4]   'length of buffer
  '
  midbuflres:
  '==========
  '
  sub edx,[esp+8]   'offset
  mov edi,[esp+12]  'source
  cmp edi,0
  jz  xmidbuf       'nul source
  mov eax,[edi-4]
  cmp edx,eax       'check length of source
  jle nmidbuf1      '
    mov edx,eax     'least qty to transfer
  nmidbuf1:
  cmp edx,0         'check if any to transfer
  jle xmidbuf
  add ecx,[esp+8]   ' add offset to target
  rmidbuf:
    mov al,[edi]
    inc edi
    mov [ecx],al
    inc ecx
    dec edx         'check n
    jg rmidbuf
  xmidbuf:
  '
  mov eax,[esp+4]
  mov ecx,[esp+12]
  ret 12



  'STRING(N,CHAR)


  '-------------
  stringa: '2464
  '=============
  here
  stringi:
  mov eax,[esp+4]  'length
  cmp dl,2
  jz stringwid
  push eax         'length
  push 0           'no copy
  'call SysAllocStringByteLen
  call [ebx+160]  'AllocString
  mov ecx,[esp+4]  'length
  mov edx,[esp+8]  'byte fill
  push eax         'addr
    push edx       'byte fill
    push ecx       'length
    push eax       'ptr
    call init1     'fill
  pop eax ' BSTR addr
  ret 8
  '
  stringwid:
  '
  shl eax,1        'double for wide chars
  push eax         'length
  push 0           'no copy
  'call SysAllocStringByteLen
  call [ebx+160] ' AllocString
  mov ecx,[esp+4]  'length chars
  cmp ecx,0
  jle xstringwid
  mov edx,[esp+8]  'byte fill
  push eax 'save address
  '
  rstringwid:
  '
  mov [eax],dx
  add eax,2
  dec ecx
  jg rstringwid  
  pop eax 'restore address
  xstringwid:
  ret 8

  '-------
  stringj:
  '=======
  '
  mov eax,[esp+8]
  cmp eax,0
  jz nstringz
    mov eax,[eax] 'deref for 1st char
    mov [esp+8],eax
  nstringz:
  jmp stringi


  '-------------
  stringz: '2472
  '=============
  here
  jmp stringj
  '

  '-------------
  strings: '2480
  '=============
  here
  jmp stringj

  '------------
  spaces: '2488
  '============
  here
  pop eax  'return address
  pop ecx  'length
  push 32  '+8 fill
  push ecx '+4 length
  push eax 'return address
  jmp stringi

  '------------
  prints: '2496
  '============
  here
  cmp dl,2
  jz printsw 'WIDE STRINGS
  mov eax,[esp+4]
  push eax
  call [ebx+2048]
  ret 4
  '
  printsw:
  '
  mov eax,[esp+4]
  push &h00000048
  push &h0032004f      ' wide char title: O2
  mov ecx,esp      '
  push 0           '
  push ecx         ' title string
  push eax         ' message string
  push 0           '
  call MessageBoxW '
  add esp,8        ' unstack title string
  ret 4



  '-------------
  instrs2: '2504
  '=============
  here
  pop eax
  push 1
  push eax
  jmp [ebx+320]


  'GETFILE "T.TXT",F

  '--------------
  getfile2: '2512
  '==============
  here
  mov edi,[esp+8]
  push [edi]
  call freemem 'dump existing string
  mov eax,[esp+4]
  push eax
  call getfiles
  mov [edi],eax
  ret 8  



  '----------
  strs: '2520
  '==========
  here
  '
  'VALUE IN FPU
  '
  push -1
  call float_to_ascii
  ret




  '-----------
  unics: '2528
  '===========
  here     
  '          '
  unicsi:
  '
  mov ecx,[esp+4]  'pointer
  mov edx,[esp+8]  'req char pos
  shl edx,1        'convert to bytes
  xor eax,eax
  cmp ecx,0
  jz unicx
  mov edi,[ecx-4]  'byte length
  cmp edi,0
  jle unicx
  cmp edx,0        '
  jnz unicso1      '
  mov edx,2        'set to 1
  '
  unicso1:             '
  '
  jge unicso2       'neg spec
  add edx,2        'base adjust
  add edx,edi      '
  '
  unicso2:           '
  '
  sub edx,2
  jl unicx         'below so leave as null
  cmp edi,edx      'upper limit check
  jle unicx        'above so leave as null
  add ecx,edx      '
  mov ax,[ecx]     '
  '
  unicx:
  '
  ret 8            '



  '------------
  unics1: '2536
  '============
  here
  pop edx
  pop eax
  push 1
  push eax
  push edx
  jmp unicsi


  '-----------
  wchrs: '2544
  '===========
  here
  push 2
  push 0
  'call SysAllocStringByteLen
  call [ebx+160] 'AllocString
  mov dx,[esp+4]   '
  mov [eax],dx     '
  ret 4


  '-------------
  numform: '2552
  '============= 
  here
  lea ecx,[num]
  mov eax,[esp+4]
  mov [ecx],eax
  mov eax,[esp+8]
  mov [ecx+4],eax
  mov eax,[esp+12]
  mov [ecx+8],eax
  mov eax,[esp+16]
  mov [ecx+12],eax
  mov eax,[esp+20]
  mov [ecx+16],eax
  mov eax,[esp+24]
  mov [ecx+20],eax
  ret 24


  '--------------
  numformd: '2560
  '==============
  here
  lea ecx,[num]
  mov eax,16
  mov [ecx],eax
  mov eax,1
  mov [ecx+4],eax
  mov eax,0
  mov [ecx+8],eax
  mov [ecx+12],eax
  mov [ecx+16],eax
  mov [ecx+20],eax
  ret



  '----
  xmrt:
  '====
  '
  end asm
  end sub






