

'-------------------------------------
function charwidth(a as sys) as string
'=====================================
  if cpuw=4 then
    function="mov dl,"+str(a)+cr
  else
    function="mov r10,"+str(a)+cr
  end if
end function


'-------------
sub regnames()
'=============

  if cpuw=4 then
    '
    qeax="eax" : peax="[eax]" : pusheax="push eax"+cr : popeax="pop eax"+cr
    qecx="ecx" : pecx="[ecx]"
    qedx="edx"
    qebx="ebx"
    qesp="esp" : pesp="[esp]"
    qebp="ebp"
    qesi="esi" : pesi="[esi]"
    qedi="edi" : pedi="[edi]"
    ledi="lea edi,"
    medi="mov edi,"
    spw1="esp,4"
    spw2="esp,8"
    'CPU
    regn(3)=qesi : regn(4)=qedi
    'FLOATS MUST BE PASSED BYREF
    '
    'REGISTER PARAM MACROS FOR CPU CALLING
    '-------------------------------------
    '
    rgp(0)="mov eax,"
    rgp(1)="mov ecx,"
    rgp(2)="mov edx,"
    rgp(3)="mov esi,"
    rgp(4)="mov edi,"
    rgp(8)="movss xmm0,"
    rgp(9)="movss xmm1,"
    rgp(10)="movss xmm2,"
    rgp(11)="movss xmm3,"
    '
    savestack="push ebp"+cr+"mov ebp,esp"+cr
    restorestack="mov esp,ebp"+cr+"pop ebp"+cr
    preserveregs="push ebx"+cr+"push esi"+cr+"push edi"+cr+"push eax"+cr+"call _mem"+cr
    restoreregs="add esp,4"+cr+"pop edi"+cr+"pop esi"+cr+"pop ebx"+cr

   cpuquad="sub esp,8"+cr+"fistp qword [esp]"+cr+_
   "mov eax,[esp]"+cr+"mov edx,[esp+4]"+cr+"add esp,8"+cr
   '
   fpuquad="sub esp,8"+cr+"mov [esp],eax"+cr+_
   "mov [esp+4],edx"+cr+"fild qword [esp]"+cr+"add esp,8"+cr
  else 'cpuw=8 'MS
    '
    qeax="rax" : peax="[rax]" : pusheax="push rax"+cr : popeax="pop rax"+cr
    qecx="rcx" : pecx="[rcx]"
    qedx="rdx"
    qebx="rbx"
    qesp="rsp" : pesp="[rsp]"
    qebp="rbp"
    qesi="rsi" : pesi="[rsi]"
    qedi="rdi" : pedi="[rdi]"
    ledi="lea rdi,"
    medi="mov rdi,"
    spw1="rsp,8"
    spw2="rsp,16"
    'CPU
    regn(3)="r8" : regn(4)="r9"
    'FLOATS
    regn(8)="xmm0" : regn(9)="xmm1" : regn(10)="xmm2" : regn(11)="xmm3"
    '
    'REGISTER PARAM MACROS FOR MS64
    '------------------------------
    '
    rgp(0)="mov rax,"
    rgp(1)="mov rcx,"
    rgp(2)="mov rdx,"
    rgp(3)="mov r8,"
    rgp(4)="mov r9,"
    rgp(8)="movss xmm0,"
    rgp(9)="movss xmm1,"
    rgp(10)="movss xmm2,"
    rgp(11)="movss xmm3,"
    '
    savestack="push rbp"+cr+"mov rbp,rsp"+cr
    restorestack="mov rsp,rbp"+cr+"pop rbp"+cr
    preserveregs="push rbx"+cr+"push rsi"+cr+"push rdi"+cr+"push rax"+cr+"lea rip rbx,bssdata"+cr
    restoreregs="add rsp,8"+cr+"pop rdi"+cr+"pop rsi"+cr+"pop rbx"+cr
    '
  end if
  '
  regn(0)=qeax : regn(1)=qecx : regn(2)=qedx
  '
  'O2 LIBRARY / GLOBAL / STATIC REGISTER
  '
  regss=qebx : regsl=qebp : regs=regss : cpua=qeax
  '
  'FIXED ASM MACROS
  '
  reloadaddr = medi+pesp+cr
  boolcnd    = "or "+cpua+cm+cpua+cr
  boolify    = "mov "+qeax+",-1"+cr+"jnz fwd _c"+cr+_
               "inc "+qeax+cr+"._c"+cr
  '
end sub


'-----------------------------------
function accreg(ty as sys) as string
'===================================
ty and=15
select case ty
  case 1 : function="al"
  case 2 : function="ax"
  case 4 : function="eax"
  case 8 : function="rax"
end select
end function


'---------------------------
sub cpus(byref wr as string)
'===========================
  dim as sys a
  a=wval(wr)
  if a then
    pem=a
    if a=64 then cpuw=8 else cpuw=4
    regnames() 'SET 32/64 BIT REG NAMES
  end if
end sub

'--------------------------------------
function leaedi(wr as string) as string
'======================================
  if wr<>pedi then return ledi+wr+cr
end function


'-----------------------------------------
function addrlabel(wr as string) as string
'=========================================
  'ADDRESS OF LABEL
  '
  if cpuw=4 then
    function="call fwd here : .here : pop edi : sub edi,here : add edi,"+wr+cr
  else
    function="lea rip rdi,"+wr+cr
  end if
  '
end function


'--------------------------------------
function rtlo(byval p as sys) as string
'======================================
  function="call "+memreg(qebx,p)+cr
end function


'-------------------------------------
function requiresimd(ty as sys) as sys
'=====================================
  if cpuw=8 then
    if isfloat(ty)and(typp<>&h40)and(atf<>0) then
      function=-1
    end if
  end if
end function


'---------------------------------------------------
function loadsimd(wr as string, ty as sys) as string
'===================================================
  dim as string w1="movss xmm0,"+wr+cr
  if (ty and 31)=8 then mid(w1,5)="d" 'double
  function=wpfx+w1
end function


'--------------------------------------
function fputosimd(ty as sys) as string
'======================================
if (ty and 31)=8 then
  function=enc("sp -16")+"fstp qword [rsp]"+cr+"movsd xmm0,[rsp]"+cr+enc("sp 16")
else
  function=enc("sp -16")+"fstp dword [rsp]"+cr+"movss xmm0,[rsp]"+cr+enc("sp 16")
end if
end function


'--------------------------------------
function simdtofpu(ty as sys) as string
'======================================
if (ty and 31)=8 then
  function=enc("sp -16")+"movsd [rsp],xmm0"+cr+"fld qword [rsp]"+cr+enc("sp 16")
else
  function=enc("sp -16")+"movss [rsp],xmm0"+cr+"fld dword [rsp]"+cr+enc("sp 16")
end if
end function


'--------------------------------------------------------------
function memregspill(byval d as sys, byval pn as sys) as string
'==============================================================
  '
  'FOR 64 BIT MODE ONLY
  'SPILL REG PARAMS INTO STACK MEMORY
  '
  dim as sys i,a,e,f',g
  dim as string w1,w2,w3
  e=pn
  if e>4 then e=4
  'w1+=cr
  'for i=1 to e
  '  if isfloat(typl(i)) then
  '    g=i : i=e
  '    w1+=enc("sp -16") 'RESERVE TRANSFER SPACE
  '  end if
  'next
  for i=1 to e
    a=typl(i) : f=i
    '
    if isfloat(a) then
      w3="movss "+memreg(qebp,d)+cm+regn(f+7)+cr
     if (a and 31)=8 then mid(w3,5)="d" 'double
     w1+=w3
    else
      w1+="mov "+memreg(qebp,d)+cm+regn(f)+cr
    end if
    '
    'SPILL FLOAT INTO SIMD REG
    '
    'if isfloat(a) then
    '  w3="movss [rsp],"+regn(f+7)+cr
    '  if (a and 31)=8 then mid(w3,5)="d" 'double
    '  w1+=w3+"mov "+regn(f)+cm+"[rsp]"+cr
    'end if
    '
    'SPILL REG INTO SHADOW SLOT
    '
    'w1+="mov "+memreg(qebp,d)+cm+regn(f)+cr
    '
    d+=8
  next
  'if g then
  '  w1+=enc("sp 16") 'RELEASE TRANSFER SPACE
  'end if
  function=w1
end function


'=======================
' IDENTIFY x86 REGISTERS
'=======================


'DETECT XMMX OR MMX REGISTER

'----------------------------------------------------------
function xmmxid( byval w as string, byref ds as sys) as sys
'==========================================================
  '
  'XMM MM MMX
  '
  dim as sys a=asc(w),b=1,e=len(w)
  ds=0 : rexi=0 : function=-1
  if (a<97)or(e>5)or(e<3) then exit function
  if a=&h78 then ds=1 : b+=1
  if (asc(w,b)<>&h6d)or(asc(w,b+1)<>&h6d) then exit function
  a=asc(w,e)-48
  if (a>=0)and(a<10) then
    if asc(w,e-1)=49 then a+=10
    if (a>=0)and(a<16) then
      if a>=8 then rexi=1
      function=a
    end if

  end if
  '
end function

'--------------------------------------------------------
function regid(byref wr as string, byref l as sys) as sys
'========================================================
  dim as sys a,b,e,v=-1
  dim as string s
  l=0 : a=lookupm(wr) : rexi=0
  if a then
    if maco(a,0)=-10 then
      s=macso(a,1)
      b=valchahex(s,3)
      e=valchahex(s,1)
      if b=9 then
        if cpuw=8 then
          rexi=1
        else 'DOWGRADE TO 32BITS
          if e=8 then e=4
          mid(wr,1)="e"
        end if
        b=1
      end if
      if b=1 then l=e : v=valchahex(s,2)
      if l=15 then l=16
    end if
  end if
  function=v
end function


'DETECT CONTROL,DEBUG AND SEGMENT REGISTERS
'
'---------------------------------------------------------
function sregid(byref w as string, byref ds as sys) as sys
'=========================================================
  '
  dim as sys a,b,rg
  dim as string s
  ds=0 : rg=-1 : rexi=0 : a=lookupm(w)
  if a=0 then goto xsreg
  if maco(a,0)<>-10 then goto xsreg
  s=macso(a,1)
  b=valchahex(s,3) : if b>4 then rg=valchahex(s,2) : ds=b+124
  xsreg:
  function=rg
  '
end function


'-------------------------------------------------
function VTEntry(w as sys, wn as string) as string
'=================================================
  if cpuw=4 then
    function="o2 e8 00 00 00 00 58 05 gl "+wn+" 83 c0 06 "+cr+_
    "mov [ecx+"+str(w)+"],eax"+cr 'table build (fwd ref )
  else
    function="lea rip rax,"+wn+cr+"mov [rcx+"+str(w)+"],rax"+cr
  end if
end function


'-----------------------------------------------------------------
function addtablesection(k as sys, a as sys, ao as sys ) as string
'=================================================================
  dim as string w1
  w1=macso(k,1)
  if cpuw=4 then
    function="'ADD TABLE SECTION:"+cr+_
    "lea edx,"+memreg(regss,ao)+cr+"lea edi,"+w1+cr+"mov ecx,"+str(maco(a,4))+cr+_
    "("+cr+"mov eax,[edi]"+cr+"mov [edx],eax"+cr+"add edi,4"+cr+"add edx,4"+cr+_
    "dec ecx"+cr+"ja repeat"+cr+")"+cr
  else
    function="'ADD TABLE SECTION:"+cr+_
    "lea rdx,"+memreg(regss,ao)+cr+"lea rdi,"+w1+cr+"mov rcx,"+str(maco(a,4))+cr+_
    "("+cr+"mov rax,[rdi]"+cr+"mov [rdx],rax"+cr+"add rdi,8"+cr+"add rdx,8"+cr+_
    "dec rcx"+cr+"ja repeat"+cr+")"+cr
  end if
end function


'----------------------------------------------
sub decidecop(byref qp as sys, byval tp as sys)
'==============================================
  if tp>=&h20 then
    select case qp
    case &h1c : qp=&h12
    case &h1d : qp=&h13
    case &h1e : qp=&h16
    case &h1f : qp=&h17
   end select
  end if
end sub

''--------------------------
'sub oppcop(byref qp as sys)
''==========================
'  select case qp
'    case &h14 : qp=&h15
'    case &h15 : qp=&h14
'    case &h1c : qp=&h1d
'    case &h1d : qp=&h1c
'    case &h1e : qp=&h1f
'    case &h1f : qp=&h1e
'    case &h12 : qp=&h13
'    case &h13 : qp=&h12
'    case &h16 : qp=&h17
'    case &h17 : qp=&h16
'  end select
'end sub



'-------------------------------------------------------
function linkadd(wsig as string, rg as string) as string
'=======================================================
  '
  'PROVIDE ADDRESS FOR HOST VARIABLE
  '
  '
  if cpuw=4 then
    function="call fwd _here_ : ._here_ : pop "+rg+" : sub "+rg+",_here_ : add "+rg+","+wsig+cr
    'function=sq+"o2 e8 hl0 58 05 gl "+wsig+" 83 c0 06 "+cr
  else
    function="lea rip "+rg+","+wsig+cr
  end if
  '
end function



'-------------------------------------------------------------
function stodat(byref wr as string, byval le as sys) as string
'=============================================================
  dim as sys a,b
  dim as string w1,w2
  if cpuw=8 then w2=" 48" 'pointer returned in 64 bit rax instead of 32 bit eax
  '
  if dep then
    '
    'STRING STORED AS INLINE DATA
    '
    function="o2 "+sp+"e8 hl0 58 e9 gf _e_"+cr+_
    "/+4 hl"+hexci(le)+cr+wr+cr+"._e_"+cr+w2+" 83 c0 0a"+ep
  else
    '
    'STRING STORED IN THE DATA SECTION AND REFERENCED
    '
    if nstod=0 then
      datc+=1
      ape(dats,dati,"/+4 gd "+hexci(datc)+hexl(le)+" "+wr+cr) 'add to data
    end if
    function="o2"+w2+" 8D 83 gc "+hexci(datc)+cr 
    'eventually mov eax/rax,[ebx/rbx-????]
  end if
end function



'---------------------------------------------
function stodata(byref wr as string) as string
'=============================================
  dim as sys q,le
  if nsto then exit function
  q=isq(asc(wr))
  le=len(wr)
  if q then
    le-=2
    wr+=" hw0"
  end if
  function=stodat(wr,le)
end function


'-----------------------------
function embeddata() as string
'=============================
  dim as sys a,b,le
  dim as string w1,w2,w3
  if nsto then exit function
  le=len(ebd(ebdi))
  w3="j"+str(ebdi)+" "
  '
  if cpuw=8 then w2=" 48" 'pointer returned in 64 bit rax instead of 32 bit eax
  '
  if dep then
    '
    'STRING STORED AS INLINE DATA
    '
    function="o2 "+sp+"e8 hl0 58 e9 gf _e_"+cr+_
    "hl"+hexci(le)+cr+w3+cr+"._e_"+cr+w2+" 83 c0 0a"+ep
    '
  else
    '
    'STRING STORED IN THE DATA SECTION AND REFERENCED
    '
    datc+=1
    w1=hexci(datc)
    ape(dats,dati," gd "+w1+hexl(le)+" "+w3+cr) 'add to data
    function="o2"+w2+" 8D 83 gc "+w1+cr 
    '
  end if
end function


'
' ######## TRAN  #########
' #      #=======#       #
' ########       #########
'                #       #
'                #########
'                #       #
'                #########
'                #       #
'                #########
'                #       #
'                #########
'                #       #
'                #########
'
'
'
'
'X86 INSTRUCTION CODE
'----------------------------------------------------------------------
function oper(byval qp as sys, byval tp as sys, wk as string) as string
'======================================================================
  '
  dim as sys a,b,c,l,m,v,w,boo
  dim as any ptr p
  dim as string w1,w2,w3,wr,wi,rg,rg2,wp,wv,f,wq
  wv=wk
  select case qp
  case 0  : qp=1
  case -1 : exit function
  end select
  '
  if tp>=htyp then
    'exit function 'IGNORE
    tp=cpuw        'ASSUME VALUE IS IN ACCUM
  end if
  c=asc(wv)
  '
  'if tp=0 then tp=cpuw
  '
  '
  'TYPE EXCLUDING LENGTH BITS
  '--------------------------
  '
  b=tp and &h1e0
  '
  'TYPE LENGTH
  '-----------
  '
  l=tp and 31
  '
  '
  'IMPLICIT OPERAND SIZE
  '---------------------
  '
  '
  if tp=&h6a then l=12 : wr="eword" 'STACK SPACE FOR FPU EXTENDED TYPE
  '
  '
  '
  '=========
  'CPU TYPES
  '=========
  '
  '
  if b<&h40 then
    '
    if c=127 then wv=pesp
    '
    '----------------------
    'QUAD(64mode) LONG SHORT & BYTE
    '----------------------
    '
    if l=0 then l=cpuw
    '
    '
    if l<4 then if (qp>=4)and(qp<=6) then l=4
    '
    if l=1 then
      rg=" al" : rg2="cl"
    elseif l=2 then
      rg=" ax" : rg2="cx"
    elseif l=4 then
      rg="eax" : rg2="ecx"
    elseif l=8 then
      rg="rax" : rg2="rcx"
    end if
    '
    if c=129 then wv=rg2
    '
    'NUMBERS
    '-------
    '
    if isn(c) then
      '
      'itr short & byte
      '
      if qp=4 then 
        wi="push "+wv : goto xop
      end if
      '
      if qp=42 then
        wi="imul "+rg+cm : goto xopv
      end if
      '
      if (qp=47)or(qp=92) then
        '
        'SIGN EXTEND INTO EDX FIRST
        '
        wi="cwd"+cr+"mov "+rg2+cm+wv+cr+"idiv "+rg2 : goto xop
      end if
      '
      'ITR unsigned ops
    end if
    '
    if wv="" then
      wv=rg
    end if
    '
    select case qp
    case 01 : wi="mov "      : goto xopv        ' load
    case 02 : wi="mov "      : goto xopr        ' store
    case 3 to 15
      select case qp
      case 03 : wi="cmp "      : goto xopv        ' compare
      case 04 : wi="push "+wv  : goto xop 'push
      case 05 : wi="add "+spw1 : goto xop 'dump
      case 06 : wi="pop "+wv   : goto xop 'pop
      case 07 : wi="neg "+rg   : goto xop 'negate accum
      case 08 : wi="add "      : goto xopr        ' +=
      case 09 : wi="sub "      : goto xopr        ' -=
      case 10 : wi="xchg " :   : goto xopv  ' stack accum swap
      case 11 : wi="not "+wv   : goto xop         ' not
      case 12 : wi="inc "+wv   : goto xop         ' inc var
      case 13 : wi="dec "+wv   : goto xop         ' dec var
      case 14 : wi="mov "      : goto xopr        ' multi store
      end select
    case 16 to 31   : goto compv
    case 128 to 143 : goto compv
    case 32 : wr=identypes(l)
      if isn(asc(wv)) then wi="mov eax"+cm+wv+cr : wv="eax" else wi=""
      wi+="cmp "+wr+wv+",0" : goto xop   ' cmp 0
    case 33 : wi="and "      : goto xopv        ' and
    case 34 : wi="or  "      : goto xopv        ' or
    case 35 : wi="xor "      : goto xopv        ' xor
    case 43 : wi="add "      : goto xopv        ' add
    case 45 : wi="sub "      : goto xopv        ' subtract
    case 42 to 47            : goto xopd        ' multiply or divide
    case 65 : wi="and "      : goto xopr        ' and=
    case 66 : wi="or  "      : goto xopr        ' or=
    case 67 : wi="xor "      : goto xopr        ' xor=
    case 71 : wi="and "      : goto boolev      ' logical and
    case 72 : wi="or  "      : goto boolev      ' logical or
    case 73 : wi="xor "      : goto boolev      ' logical xor
    case 74 to 77
      select case qp
      case 74 : wp="shl " ' shift left
      case 75 : wp="shr " ' shift right
      case 76 : wp="rol " ' rotate left
      case 77 : wp="ror " ' rotate right
      end select
      if isn(c) then
        wi=wp :goto xopv
      else
        wi="mov cl,"+wv+cr+wp+rg+",cl"
        goto xop
      end if
    case 80 : wi="test "     : goto xopv        ' bitwise 'and' compare
    case 92 : qp=47 : goto xopd                 ' explicit integer divide
    
    end select
    '
'    case 14 to 15
'    if b<&h20 then f="i" : if qp=15 then f="cwd"+cr+f
'    if qp=14 then wi=f+"mul "+wv+cr+"xchg "  ' *=
'    if qp=15 then wi="xchg "+rg+cm+wv+cr+f+"div "+wv+cr+"xchg " ' /=
'    goto xopv
    '
    '
    ' itr ^ 94
    goto xop
    '
    '----
    xopd: ' multiply or divide
    '====

    if b<&h20 then f="i"
    if qp=47 then f="cwd"+cr+f
    wr=identypes(l)
    if qp=42 then wi=f+"mul "+wr+wv : goto xop
    if qp=47 then wi=f+"div "+wr+wv : goto xop

    '----
    xopv:
    '====
    '
    wi+=rg+cm+wv : goto xop
   
    '----
    xopr:
    '====
    '
    if instr(wv,cm) then
      wi+=wv       'COMPOUND
    else
      wi+=wv+cm+rg 'NORMAL
    end if
    goto xop
    '
    '-----
    compv:
    '=====
    '
    if instr(wv,cm) then
      'composite wv
      wi="cmp "+wv : goto boole         'comparators
    else
      wi="cmp "+wv+cm+qeax : goto boole 'comparators
    end if
    goto boole
    '
    '
  end if 'CPU INTEGERS
  '
  '
  '
  '=========
  'FPU TYPES
  '=========
  '
  m=0
  rg=qeax : rg2=qecx
  if b=&h40 then f="fi" : m=1 'INTEGER
  if b=&h60 then f="f"  : m=2 'FLOAT
  wr=identypes(l)
  '
  if m then
    '
    if l<cpuw then
      l=cpuw
    elseif l=10 then
      l=cpuw+8
    end if
    '
    'toto logical
    'downgrade acc : load saveint and/or/xor eax,[esp]
    '
    if isn(c) then
      '
      'NUMBERS FOR FPU
      '
      if dv=0 then
        wp="fldz"
        if c=45 then wp+=cr+"fchs" 'negative zero
        goto fln
      end if
      if dv=1 then wp="fld1" : goto fln
      if dv=2 then wp="fld1"+cr+"fadd st0,st0" : goto fln
      if dv=4 then wp="fld1"+cr+"fadd st0,st0"+cr+"fadd st0,st0" : goto fln
      '
      a=dtf
      '
      if a=0 then
        'ite test for sci notation
      end if
      '
      if a=0 then
        if (abs(dv)<=&h7fffffff) then
          wp="push "+str(dv)+cr+"fild dword "+pesp+cr+"add "+spw1
          goto fln
        end if
      end if
      '
      'SPLIT INTO 2 PARTS
      '
      'double precision floating point
      '
      if a then 
        asm
        lea eax,[dv]
        mov ecx,[eax]
        mov [v],ecx
        mov ecx,[eax+4]
        mov [w],ecx
        end asm
        w1="fld"
      else
        w=dwu : v=dwl
        w1="fild"
      end if
      '
      if cpuw=4 then
        wp="push "+str(w)+cr+"push "+str(v)+cr+w1+" qword "+pesp+cr+"add "+spw2 'quad
      else
        wp="sub "+spw2+cr+"mov dword [rsp+4],"+str(w)+cr+_
        "mov dword [rsp],"+str(v)+cr+_
        w1+" qword [rsp]"+cr+"add "+spw2 'quad
      end if
      '
      '---
      fln:
      '---
      '
      c=128 'SET FLAG FOR NUMBERS
      '
      xfln:
      '
    end if
    '
    if c>=127 then f="f" 'TREAT AS FLOAT
    '
    'itr convert fpu for logical ops
    '
    if len(wv) then
      if c<>128 then wp=f+"ld "+wr+wv 'NON-NUMBERS
      wq=f+"stp "+wr+wv
    else
      wp=""
      wq=""
    end if
    '
    a=0
    '
    select case qp
    '-------------
    '
    case 1
      '
      'LOAD
      '
      if c=129 then exit function 'NO FURTHER ACTION
      wi=wp
      goto xop
    case 02 : wi=wq : goto xop 'STORE
    case 03 : wi=wp+cr+"fxch : fcomi st1 : fxch"+cr+"fstp st0"+cr : goto xop
    case 04
      if len(wp) then
        if l=cpuw then
          if c<>128 then wi="push "+wv : goto xop 'not numbers
        end if
        wp+=cr
      end if
      wi="sub "+qesp+cm+str(l)+cr+wp+f+"stp "+wr+pesp
      goto xop
    case 05 : wi="add "+qesp+cm+str(l) : goto xop
    case 06 : wi=f+"ld "+wr+pesp+cr+"add "+qesp+cm+str(l) : goto xop
    case 07 : wi="fchs" : goto xop 'negate accum
    case 10 : wi=f+"ld "+wr+pesp+cr+"fxch"+cr+f+"stp "+wr+" "+pesp : goto xop ' xchg with stack
    '
'    case 11
'      if wv=pesp then a=11 : wi=wp+cr else a=0 : wi=""
'      'BOOLEAN IMPLEMENTATION
'      wi+="fldz"+cr+"fcomip"+cr+"fstp st0"+cr+"fldz"+cr+_
'      "jnz fwd _cc"+cr+"fstp st0"+cr+"fld1"+cr+"fchs"+cr+"._cc"+cr
'      'BITWISE IMPLEMENTAION
'      'wi+="fld1 : faddp st1,st0 : fchs"
'      if a then wi+=cr+wq
'      goto xop        'NOT (via 2s complement)
'    '
    case 12 : wi=wp+cr+"fld1"+cr+"faddp st1"+cr+wq : goto xop 'inc
    case 13 : wi=wp+cr+"fld1"+cr+"fsubp st1"+cr+wq : goto xop 'dec
    case 14 : wi=wq : mid(wi,instr(wi,"p"))=" " : goto xop 'STORE & LEAVE ON STACK
    '
    '
    '
'    'BOOLEAN
'    '
'    case 33 : a=33 : w1="and"
'    case 34 : a=34 : w1="or"
'    case 35 : a=35 : w1="xor"
    '
    end select
    '---------
    '
'    if a then
'      '
'      w3=wp+cr ' number literals
'      '
'      'BOOLEAN IMPLEMENTATION
'      wi="fldz"+cr+"fcomip"+cr+"fstp st0"+cr+"mov "+qeax+cm+"0"+cr+_
'      "jz fwd _cc"+cr+"dec "+qeax+cr+"._cc"+cr+_
'      wp+cr+_
'      "fldz"+cr+"fcomip st1"+cr+"fstp st0"+cr+"mov "+qecx+cm+"0"+cr+_
'      "jz fwd _cc"+cr+"dec "+qecx+cr+"._cc"+cr+_
'      w1+" "+qeax+cm+qecx+cr+_
'      "sub "+qesp+cm+"8"+cr+"mov "+pesp+cm+qeax+cr+_
'      "fild dword "+pesp+cr+"add "+qesp+cm+"8"+cr
'      INTEGER BITWISE 
'      wi="'LITERAL NUM"+cr+_
'      "sub "+qesp+cm+"16"+cr+_
'      "fistp qword ["+qesp+"+8]"+cr+_             'STACK FPU ACCUM
'      wp+cr+"fistp qword "+pesp+cr+_              'LOAD AND STACK VARIABLE
'      "mov "+rg+cm+pesp+cr+_
'      w1+" ["+qesp+"+8]"+cm+rg+cr+_               'DO CPU OPERATION LOWER
'      "mov "+rg+cm+"["+qesp+"+4]"+cr+_
'      w1+" ["+qesp+"+12]"+cm+rg+cr+_              'DO CPU OPERATION UPPER
'      "fild qword ["+qesp+"+8]"+cr+_
'      "mov "+qeax+cm+"["+qesp+"+8]"+cr+_
'      "add "+qesp+",16"                           'RESTORE FPU ACCUM
'      if a=2 then wi+=cr+wq                       'CAN SAVE RESULT TO VARIABLE
'      goto xop
'    end if
    '
    'ARITHMETIC
    '
    if tp=&h48 then
      '
      'QUAD OPERANDS
      '
      if c=128 then
        wi=wp+cr 'number
      else
        wi="fild qword "+wv+cr
      end if
      select case qp
      case 42 : wi+="fmulp st1" : goto xop
      case 43 : wi+="faddp st1" : goto xop
      case 45 : wi+="fsubp st1" : goto xop
      case 47 : wi+="fdivp st1" : goto xop
      case 92
        '
        'INTEGER DIVISION
        '
        wi+="sub "+spw1+" : fstcw "+pesp+" : fstcw ["+qesp+"+2] : or "+pesp+",0xc00 : fldcw "+pesp+cr+_
        "fdivp st1,st0 : frndint : fldcw ["+qesp+"+2] : add "+spw1
        goto xop
      end select
    end if
    '
    '
    'ALL OTHER OPERANDS
    '
    select case qp
    case 42 : wi=f+"mul"
    case 43 : wi=f+"add"
    case 45 : wi=f+"sub"
    case 47 : wi="fdiv" : if (c<127)or(c>129) then c=128 'always use float div
    case 92
      '
      'INTEGER DIVISION '\'
      if c=129 then wi="" else wi=wp+cr 'PRE-LOADED ON STACK OR NOT
      wi+="fdivp st1,st0"+cr
      '
      'TRUNCATE FRACTION
      '
      wi="sub "+spw1+cr+_
      "fstcw "+pesp+cr+_
      "fstcw ["+qesp+"+2]"+cr+_
      "or "+pesp+",0xc00"+cr+_
      "fldcw "+pesp+cr+_
      wi+"frndint"+cr+_
      "fldcw ["+qesp+"+2]"+cr+_
      "add "+spw1
      goto xop
    '
    '
    case 32
      wi="fldz"+cr+wp+cr+"fcomip st1"+cr+"fstp st0" : goto xop 'FOR TRUE/FALSE COMPARE
    '
    'case 74..77 'shl..ror 'not for floats
    case 94
      wi=wp+cr+powers : goto xop '^ POWER
    end select
    '
    if ((qp>=&h10)and(qp<&h20))or((qp>=&h80)and(qp<&h90)) then
      'wp=f+"ld "+wr+pesp
      wi="fxch"+cr+"fcomip st1"+cr+"fstp st0"
      'wq="add "+qesp+cm+str(l)+cr
      wq=""
      goto boole
    end if
    '
    'USUAL COMPLETION OF OPERATION
    '-----------------------------
    '
    if len(wi) then
      if (tp=&h6a)and(c<>127) then c=128 'PRELOAD EXTENDED VARIABLE
      if (c>=127)and(c<=129) then
        if c=128 then wi=wp+cr+wi 'NUMBERS
        wi+="p st1,st0"
        goto xop
      end if
      wi+=" "+wr+wv
      goto xop
    end if
    '
    '
  end if
  '
  '
  '========
  ' STRINGS
  '========
  '
  if (tp>&ha0)and(tp<&h100) then
    '
    rg=qeax : rg2=qecx
    '
    'LOADING AND APPENDING
    '=====================
    '
    if qp=33 then qp=43 'INTERPRET & AS CONCAT
    '
    if (qp<2)or(qp=33)or(qp=43)or(qp=45) then
      '
      'jn=nst+1
      a=tp and 31 : b=tp-a
      w1=charwidth(a)
      '
      select case b
      case &ha0 : a=zadcatla 'zstr
      case &hc0 : a=sadcatla 'bstr byval
      case &he0 : a=badcatla 'bstr byref
      end select
      '
      w1+=rtlo(a)
      '
      if (b<&hc0)and(wv<>rg) then
        w2="lea " 
      else
        w2="mov "
      end if
      '
      if qp<02 then
        if wv="" then wi=rtlo(catbufprpa)+w1 : goto xop  'get
        wi=w2+rg+cm+wv+cr+rtlo(catbufprpa)+w1 : goto xop 'get
      else
        if wv="" then wi=w1 : goto xop ' add
        wi=w2+rg+cm+wv+cr+w1 : goto xop
      end if
      '
    end if
    '
    'ASSIGNING
    '=========
    '
    if (qp=2)or(qp=14) then
      '
      w1=""
      'jn=0
      '
      'INDIRECT BSTR BYREF
      '-------------------
      '
      '
      if tp>&he0 then
        '
        wi=w1+"lea "+rg2+cm+wv+cr
        goto xop
        '
      end if
      '
      'BSTR BYVAL
      '----------
      '
      if tp>&hc0 then
        '
        'destroy old bstr before assign
        '
        if cpuw=4 then
          wi="push "
        else
          wi="mov rcx,"
        end if
        wi=w1+pusheax+wi+wv+cr+rtlo(freememsa)+popeax+"mov "+wv+cm+rg
        if cpuw=8 then
          wi=enc("sp -8")+wi+cr+"|sp 8"
        end if
        goto xop 'FREEMEM
      end if
      '
      '
      'DIRECT ZSTRING ETC
      '--------------------------
      '
      '
      a=tp and 31
      wi="lea "+rg+cm+wv+cr+charwidth(a)+rtlo(joinsa)
      goto xop
      '
    end if 'qp=2
    '
    '
    'JOINING
    '=======
    '
    'used for joining unassigned strings (params)
    '
    if qp=96 then
      'jn=0
      a=tp and 31
      wi=charwidth(a)+"xor "+rg+cm+rg+cr+rtlo(joinsa)
      goto xop
    end if
    '
    '
    'COMPARING
    '=========
    '
    a=0
    if qp=3 then
      a=1
    elseif (qp>=&h10)and(qp<=&h20) then
      a=1 'compare left with right
    elseif (qp>=&h80)and(qp<&h90) then
      a=1 'compare left with right
    end if
    if a then
      if cpuw=4 then
        if qp<>&h20  then
          w1="push "+wv+cr+pusheax
        else
          w1="push "+wv+cr+"push 0"+cr
        end if
      else 'cpuw=8
        if qp<>&h20  then
          w1="mov rdx,"+wv+cr+"mov rcx,rax"+cr
        else
          w1="mov rdx,"+wv+cr+"mov rcx,0"+cr
        end if
      end if
      '
      a=tp and &h7fffffe0
      '
      if a=&ha0  then
        w2=rtlo(compza)  'ZSTR
      else
        w2=rtlo(compsa)  'BSTR
      end if
      '
      '
      'DYNAMIC STRING
      '
      if tp=&he1 then
        if qp=&h20 then w2=rtlo(compisa)
        'if qp=03   then w2=rtlo(comprisa)
      end if
      if qp=&h20 then wi=pusheax+w1+w2+"pop "+qeax
      wi=w1+w2
      if qp=&h20 then goto xop else goto boole
    end if
    '
    'OTHER
    '=====
    '
    if qp=04 then
      wi="push "+rg   ' push used only for left side compare
    elseif qp=05 then
      wi="add "+spw1  ' dump not used
    elseif qp=06 then
      wi="pop "+rg    ' pop not used
    end if
    goto xop
    '
  end if 'STRINGS
  '
  goto xop
  '
  '======
  boolev: 'BOOLEAN OPERATIONS && || ^^ 
  '======
  '
  w1="or "+rg+cm+rg+cr+boolify
  wi=w1+"mov "+qedx+cm+qeax+cr+_
  "mov "+rg+cm+wv+cr+w1+_
  wi+qeax+cm+qedx
  goto xop
  '
  '==============
  boole: '
  '==============
  '
  encrlf(wi)
  '
  if qp>=128 then
    qp-=112
    decidecop(qp,tp)
    return wi+mid(cops,qp*4-64,4)
  else
    decidecop(qp,tp)
    return wi+"mov "+qeax+",-1"+cr+_
    mid(cops,qp*4-64,4)+"fwd _c"+cr+_
    "inc "+qeax+cr+_
    "._c"+cr '+wq+cr
  end if
  exit function
  
  '
  '------------------------------
  xop: 'RESOLVED OPERATOR OPERAND
  '==============================
  '
  if wi="" then
    if (parx=0)or(op>1) then
      'allow load or push 
      if (qp<>4)and(qp<>6) then
        ert=16
        ers="unidentified operation ("+identops(qp)+") for this type ("+typename(tp)+")"
      end if
    end if
  else
    encrlf(wi)
  end if
  '
  function=wi
  '
end function


' 
'                       #      #########
'  ########    CONVERT   ##    #       #
'  #      #  ################  #       #
'  ########              ##    #       #
'                       #      #########
' 


'--------------------------------------------------------------------------------
function cpufpu(byval pp as sys, byref typb as sys, byref wr as string) as string
'================================================================================
  '
  dim as sys b,tb
  dim as string w1
    '
    tb=typb
    b=0
    '
    'SMALL TYPES
    '-----------
    '
    if typb=&h01 then b=1 'SIGNED BYTE 
    if typb=&h21 then b=1 'UNSIGNED BYTE TO SHORT
    if typb=&h02 then b=2 'SHORT TO SHORT
    if typb=&h22 then
      b=4  'UNSIGNED WORD TO LONG
      if pp<0 then w1="and "+qeax+",0xffff"+cr
    end if
    '
    if b then
      b+=&h40
      if pp>=0 then
        w1+="xor "+qeax+cm+qeax+cr+oper(1,typb,wr)
      else
        pp=1
      end if
      if b=&h41 then
        'w1+="and "+qeax+",0xff"+cr : b=&h42
        b=&h42
      end if
      w1+=pusheax+oper(pp,b,pesp)+"add "+spw1+cr
      typb=b : goto xcv
    end if
    '
    if pp<0 then pp=1
    '
    'UNSIGNED DWORD
    '--------------
    '
    if typb=&h24 then
      typb=&h48
      w1+="push 0"+cr+_
      "push "+wr+cr+oper(pp,typb,pesp)+"add "+spw2+cr
      goto xcv
    end if
    '
    'SIMPLE CONVERSION
    '-----------------
    '
    if typb<=8 then
      '
      'REGISTERS
      '
      typb+=&h40
      if asc(wr)<>91 then
        w1+="push "+wr+cr+oper(pp,typb,pesp)+"add "+spw1+cr
        goto xcv
      end if
      '
    end if
    '
    if typb=&h01 then typb=&h42 : goto ncv ' BYTE TO SHORT
    if typb=&h02 then typb=&h42 : goto ncv ' SHORT TO SHORT
    if typb=&h04 then typb=&h44 : goto ncv ' LONG TO LONG
    'if typb=&h08 then typb=&h48 : goto ncv ' QUAD TO QUAD
    '
    '
    'UNSIGNED QWORD
    '--------------
    '
    if typb=&h28 then
      'itr subroutine
      ers="Unsigned quad not implemented"
      goto xcv
    end if

  '
  'DEFAULT
  '-------
  '
  ncv:
  '
  w1+=oper(pp,typb,wr) ' no operand conversion
  '
  xcv:
  '
  function=w1
  '
end function


'-----------------------------------------------------------
function cvta(byval typa as sys,byval typb as sys) as string
'===========================================================
  '
  ' FOR ACCUMULATOR
  ' CONVERT FROM TYPE A TO TYPE B

  ' bytes are treated as unsigned
  '
  dim as sys a,b,la,lb,ta,tb
  dim as string tc,w1,w2,w3,w4
  '
  '
  'EXCLUDE MATCHING OR UNKNOWN TYPES
  '
  if (typa=typb)or(typa=0)or(typb=0) then goto xcvt
  '
  '
  'HIGHER TYPE CHECK
  '=================
  '
  if (typa>=htyp)or(typb>=htyp) then
    if typb<>typa then
      'ers="type mismatch " : ert=98
      'ASSUME NO CONVERSION REQUIRED
    end if
    goto xcvt
  end if
  '
  '
  'GET LENGTH OF PRIMITIVE
  '
  la=typa and 31
  lb=typb and 31
  ta=typa and &h7fffffc0
  tb=typb and &h7fffffc0
  '
  '
  if typa=0 then typa=cpuw
  if typb=0 then typb=cpuw
  '
  '
  'CONVERSION FROM NUMBER TO BSTRING
  '=================================
  '
   if (tb=&hc0)or(tb=&h80) then
     if typa<&ha0 then
      '
      if vew>0 then w1=";CONVERT VAL TO STRING"
      '
      'UPGRADE NUMBER TYPE FIRST (CVTA RECURSIVE)
      '
      tc=cvta(typa,&h68) 'CONVERT NUMBER TO FLOAT
      if cpuw=4 then
        tc+=rtlo(2520)
      else
        tc+="sub rsp,32"+cr+rtlo(2520)+"add rsp,32"+cr
      end if
      goto xcvt
    end if
  end if
  '
  '
  'CONVERSION FROM BSTRING TO NUMBER
  '=================================
  '
  if (ta=&hc0)or(ta=&h80) then
    if typb<&ha0 then
      '
      if vew>0 then w1=";CONVERT STRING TO VAL"
      '
      if cpuw=4 then
        tc=pusheax+rtlo(192) 'VAL
      else
        tc="sub rsp,32"+cr+"mov rcx,rax"+cr+rtlo(192)+"add rsp,32"+cr
      end if
      '
      typa=&h6a : ta=&h40
      '
      'continue with conversion
      '
      goto fpucpu
      '
    end if
  end if
  '
  '
  'STRING CONVERSIONS
  '==================
  '
  a=0
  if tb=&hc0 then
    if ta=&h80 then a=1
    if (ta=tb)and(la<>lb) then a=1
  elseif tb=&h80 then
    'if ta=&hc0 then a=1
    'if (ta=tb)and(la<>lb) then a=1
    if la<>lb then a=1
  end if
  if a then
    convs or=2
    w1="STRING"
    goto xcvt
  end if
  
  '
  '
  'CPU to CPU RESIZE
  '=================
  '
  ' UNSIGNED AND SIGNED
  '
  'SOURCE SHORTS AND LONGS WILL BE SIGN EXTENDED BUT NOT BYTES
  '
  if ta+tb=0 then
    '
    if lb=1 then
      tc="and "+qeax+",0xff"+cr 'MASK UPPER BITS
    elseif lb=2 then
      if typb=2 then 'CONVERT TO SHORT INT
        if typa=1 then
           tc="movsx ax,al"+cr
        elseif typa=&h21 then
           tc="movzx eax,al"+cr
        end if
      else 'typb=&h22
        if la=1 then tc="movzx eax,al"+cr
      end if
    end if
    '
    if lb=4 then
      '
      if la=1 then
        if (typb=4)and(typa=1) then
          tc="movsx eax,al"+cr
        else
          tc="movzx eax,al"+cr
        end if
      elseif la=2 then
        if (typb=4)and(typa=2) then
          tc="movsx eax,ax"+cr
        else
          tc="movzx eax,ax"+cr
        end if
      elseif la=4 then
      elseif la=8 then
        goto xcvt 'no conversion required
      end if
 
    end if
    '
    if lb=8 then
      if cpuw=4 then
        if la=1 then
          if (typa=1)and(typb=8) then
            tc="movsx eax,al"+cr+"cwd"+cr
          else
            tc="movzx eax,al"+cr+"cwd"+cr
          end if
        elseif la=2 then
          if (typa=2)and(typb=8) then
            tc="movsx eax,ax"+cr+"cwd"+cr
          else
            tc="movzx eax,ax"+cr+"cwd"+cr
          end if
        elseif la=4 then
          if (typa=4)and(typb=8) then
            tc="cwd"+cr
          else
            tc="xor "+qedx+cm+qedx+cr
          end if
        end if
      else 'cpuw=8
        if la=1 then
          if (typa=1)and(typb=8) then
            tc="movsx rax,al"+cr
          else
            tc="movzx rax,al"+cr
          end if
        elseif la=2 then
          if (typa=2)and(typb=8) then
            tc="movsx rax,ax"+cr
          else
            tc="movzx rax,ax"+cr
          end if
        elseif la=4 then
          if (typa=4)and(typb=8) then
            tc="movsxd rax,eax"+cr
          else
            'tc="mov eax,eax"+cr
          end if
        end if
      end if
    end if
    '
    '
    if vew>0 then
      if typa>typb then w1="CPU DOWNSIZE" else w1="CPU UPSIZE"
    end if
    '
    goto xcvt
  end if
  '
  'if floats differ in type then prevent compatsig shortcut
  '
  if (ta=&h40)and(tb=&h40) then
    convs or=2 : goto xcvt
  end if
  '
  'FPU to CPU
  '==========
  '
  fpucpu:
  '
  if tb=0 then
    if ta=&h40 then
      'if lb=8 then tc+="sub "+spw1+cr+"fistp qword "+pesp+cr+popeax
      'if lb<=4 then tc+="sub "+spw1+cr+"fistp dword "+pesp+cr+popeax
      tc+="sub "+qesp+",8"+cr+"fistp qword "+pesp+cr+"mov "+qeax+cm+pesp+cr+"add "+qesp+",8"+cr
      if lb=2 then tc+="and "+qeax+",0xffff"+cr
      if lb=1 then tc+="and "+qeax+",0xff"+cr
      if vew>0 then w1="FPU TO CPU"
      goto xcvt
    end if
  end if
  '
  'CPU to FPU
  '==========
  '
  if (typa<&h40)and(isfpu(typb)<>0) then
    if vew>0 then w1="CPU TO FPU"
    a=cpuw
    tc=cvta(a,typa)+cpufpu(-1,a,qeax)
  end if
  '
  xcvt:
  '
  if len(tc) then convs or=1
  if vew>0 then if convs then tc="'CONVERT "+W1+cr+tc
  function=tc
  '
end function



'--------------------------------------------------------------
function callcnv(byval pn as sys, byval w2 as string) as string
'==============================================================
  dim as sys a,w
  dim as string w1,w3
  '
  'MS64 CALLING
  '
  if (cco=2)or(cco=3) then
    '
    w3=memreg(qesp,pn*8-8)
    '
    if isfpu(typg)=0 then 'NON-FLOATS
      '
      if instrword(" rax eax ax al ",w2) then
        w1=""
      else
        w1=oper(1,typg,w2)
      end if
      '
      if typg<&h40 then
        if (typg and 15)<>cpuw then w1+=cvta(typg,cpuw)
      end if
      w1+=oper(2,cpuw,w3) 'ALWAYS USE STACK
    elseif typg=&h40 then
      exit function 'FPU INTERNAL STACK TYPE
    else ' typg>&h40 DIRECT FLOATS
      if asc(w2)<>91 then
        w1=""
      else
        w1=oper(1,typg,w2)
      end if
      w1+=oper(2,typg,w3) 'USE STACK
    end if
  elseif cco=16 then
    w1=rgp(pn)+w2+cr 'CPU: PARAMS IN REGISTERS
  elseif cco=17 then
    w1="" 'PARAM REMAINS ON FPU STACK
  else 'NOT MS64
    'itr quads on 32bit cpu
    w1=oper(4,typg,w2) 'push onto stack (also supports double floats byval) 
  end if
  return w1
end function


'  BINDING:
'  ########    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##
'       ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##
'      ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##
'     ##====##====##====##====##====##----##----##----##----##----##----##----##----##----##
'    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##
'   ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##
'  ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ##    ########


'------------------------------
function bindlprocs() as string
'==============================
  '
  dim as sys a,k
  dim as string wa
  dim as string w1
  '
  if impo=0 then return ""
  '
  '---------------------
  'BUILD BIND PROCEDURES
  '---------------------
  '
  a=dlb
  k=j
  wa=cr+stodata("") 'set gc and gd index
  do
    if a>=libe then exit do
    '
    'PROCESS PROC ADDRESSES FOR EACH LIBRARY
    '---------------------------------------
    '
    if libu(a) then
      '
      'ONLY PROCS THAT HAVE BEEN INVOKED ARE TO BE LINKED
      '--------------------------------------------------
      '
      'LOAD LIBRARY MODULE
      '
      ape(dats,dati,cr+"01 `"+libs(a)+"` 00"+cr)
      '
      'LOAD PROC LIST
      '
      ape(dats,dati,left(libl(a),libu(a) ))
      '
      'CLEAR PROC LIST
      '
      libu(a)=0 ' recycle space in buffer
      '
    end if
    '
    'NEXT LIB
    '
    a+=1
    '
  loop
  '
  'CLEAR LIBRARY LIST
  '------------------
  '
  libe=dlb
  dlb=1
  '
  '
  'TERMINATION CODE
  '----------------
  '
  if cpuw=4 then
    w1="03 hl0"
  else
    w1="03 hq0"
  end if
  '
  ape(dats,dati,w1+cr)
  '
  'CALL RUNTIME DLL BINDER
  '
  impo=0
  '
  return wa+rtlo(bindlsa)+"cmp al,100"+cr+"jge fwd _error_"+cr 'ERROR QUIT
  '
end function


'=>


'------------------------------------------------------------
function stackpointadj(s as string, byref i as sys) as string
'============================================================
'sp
dim as sys a,v
dim as string wr
do
  v+=wval(yword(s,i))
  a=i
  do
    skipspace(s,a)
    if ascn=0 then exit do
    if ise(ascn) then
      endline(s,a)  'ignoring comments
    else
      exit do
    end if
  loop
  wr=yword(s,a)
  if wr="|sp" then
    i=a
  else
    exit do
  end if
loop
i+=len(cr)
if v then
  return "add "+qesp+cm+str(v)+cr
end if
end function


'----------------------------------------------------
function opero(s as string, byref i as sys) as string
'====================================================
'op
op=hexval(s,i)
typ=hexval(s,i)
dim as sys c
dim as string wr
if asc(s,i)>32 then
  c=instr(i,s,chr(13))
  wr=mid(s,i,c-i) : i=c 'COMPOUND
end if
dtf=instr(wr,".")
c=asc(wr)
if isn(c) then wordval(wr,1,1)
if typ=15 then typ=cpuw
return oper(op,typ,wr)
end function


'ABSTRACT OP WITH INTEGER TO FLOAT CONVERSION
'------------------------------------------------------
function cpufpuo(s as string, byref i as sys) as string
'======================================================
'fp
dim as sys a=hexval(s,i)
dim as sys b=hexval(s,i)
dim as sys c
dim as string wr
if asc(s,i)>32 then
  wr=iword(s,i)
end if
dtf=instr(wr,".")
c=asc(wr)
if isn(c) then wordval(wr,1,1)
return cpufpu(a,b,wr)
end function


'----------------------------------------
function regparams(s as string,byref i as sys) as string
'========================================
'lr'
'ms 64bit
dim as sys b,c,k,m,p
dim as string w1,w3
c=hexval(s,i)
p=hexval(s,i)
b=c
do
  if asc(s,i)<=13 then exit do
  k=hexval(s,i)   
  if isfloat(k) then
    m=7 'use simd register for direct float
  else
    m=0
  end if
  if k=&h40 then
    w3=""
  else
    if (m>0)or(b>p) then
      w3=rgp(b+m)+memreg(qesp,b*8-8)+cr
    else
      w3="" 'not required
    end if
    if m then
      if (k and 31)=8 then
        mid(w3,5)="d" 'double
      end if
    end if
  end if
  w1+=w3
  b+=1
loop
return w1
end function


'----------------------------------------------------
function cvtao(s as string, byref i as sys) as string
'====================================================
'cv
dim as sys a=hexval(s,i)
dim as sys b=hexval(s,i)
return cvta(a,b)
end function


'-------------------------------------
sub tbuf(byref wr as string, f as sys)
'=====================================
static as string wa1,wa2
static as sys wi1,wl1,le1
static as sys wi2,wl2,le2
select case f
case 0
  le1=len(wr)
  if le1+wi1>wl1 then
    wa1+=space(16000+le1) 'stretch buffer
    wl1+=16000+le1
  end if
  mid(wa1,wi1+1)=wr
  wi1+=le1
case 1
  le2=len(wr)
  if le2+wi2>wl2 then
    wa2+=space(16000+le2) 'stretch buffer
    wl2+=16000+le2
  end if
  mid(wa2,wi2+1)=wr
  wi2+=le2
case -1
  wr=left(wa1,wi1)
  wa1=""
  wl1=0
  wi1=0
case -2
  wr=left(wa2,wi2)
  wa2=""
  wl2=0
  wi2=0
end select
end sub


'------------------------------------
function itran(s as string) as string
'====================================
dim as sys a,b,c,d,m,p,wb,le,st,c1,c2
dim as string wr,w1,w2,w3
b=1
wb=b
do
  if ert then
    w1=findlinek(b,s,"'_",2)
    w2=findlinek(b,s,"'_"+qu,2)
    ers="Error:"+cr+w2+w1+ers
    exit do
  end if
  b=instr(b,s,"|") 'FIND NEXT INSTRUCTION
  if b=0 then exit do
  if asc(s,b+3)>32 then
    b+=1 : continue do
  end if
  a=b-wb
  if a then tbuf(mid(s,wb,a),st)
  c=b+4
  d=instr(c,s,cr)+2
  'wr=mid(s,b+1,2)
  w1=""
  c1=asc(s,b+1)
  c2=asc(s,b+2)
  'asc(s,b+1)*256+asc(s,b+2)
  '
  select case c1
  '
  case &h6F 'o'
    '
    select case c2
    '
    case &h70 'op' operation
    '
    w1=opero(s,c)
    '
    end select
  '
  case &h76 'v'
    '
    select case c2
    '
    case &h61 'va' variable list
    '
    w1=""
    '
    end select
    '
  case &h66 'f'
    '
    select case c2
    '
    case &h70 'fp' float operation
    '
    w1=cpufpuo(s,c)
    '
    end select
    '
  case &h61 'a'
    '
    select case c2
    '
    case &h62 'ab' resolve label address
    '
    hexval(s,c) 'dump pls
    w1=addrlabel(yword(s,c))
    '
    case &h6C 'al' align (hex)
    '
    w1="o2 !"+yword(s,c)+cr
    '
    end select
    '
  case &h70 'p'
    '
    select case c2
    '
    case &h61 'pa' call parameter
    '
    a=hexval(s,c) 'param number
    cco=hexval(s,c)
    typg=hexval(s,c)
    w1=callcnv(a,mid(s,c,d-c-2))
    '
    case &h62 'pb' compacted parameter
    '
    a=hexval(s,c)
    m=len(rgp(a))
    w1=mid(s,c,d-c)
    if w1=cr then w1="rax"+cr
    w1="mov "+ mid(rgp(a),5,m-5)+cm+w1
    '
    end select
    '
  case &h6D 'm'
    '
    select case c2
    '
    case &h6B 'mk' move statics
    '
    st=asc(s,c)-48
    '
    end select
    '
  case &h63 'c'
    '
    select case c2
    '
    case &h68 'ch' set char width
    '
    w1=charwidth(asc(s,c)-48)
    '
    case &h76 'cv' convert accum
    '
    w1=cvtao(s,c)
    '
    end select
    '
  case &h71 'q'
    '
    select case c2
    '
    case &h75 'qu' store string data
    '
    w1=stodata(tword(s,c))
    d=c+2
    '
    end select
    '
  case &h73 's'
    '
    select case c2
    '
    case &h69 'si' initialise space on stack
    '
    a=hexval(s,c)
    w1="mov "+qecx+cm+str(-a)+cr+"._z_"+cr+_
    "mov ["+qebp+"+"+qecx+"],0"+cr+_
    "add "+qecx+cm+str(cpuw)+cr+_
    "jl _z_"+cr
    '
    case &h70 'sp' adjust stack pointer
    '
    w1=stackpointadj(s,c)
    d=c
    '
    end select
    '
  case &h67 'g'
    '
    select case c2
    '
    case &h6F 'go' 0 call / 1 jump / 2 jz / 3 jnz
      c+=2
      select case asc(s,c-2)
      case 48 :
        if asc(s,c)<>91 then
          w3=yword(s,c) 'dump pls
          w3=yword(s,c)+cr 'name
          if w3="fwd" then
            w3+=" "+yword(s,c)
          end if
          w1="call "+w3+cr
          goto ngodone 'ignoring namespace codings etc
        else
          w1="call "
        end if
      case 52 :
        w3=yword(s,c)  'dump pls
        w3=yword(s,c)+cr 'name
        if w3="fwd" then
          w3+=" "+yword(s,c)
        end if
        w1="call "+w3+cr
        goto ngodone 'ignoring namespace codings etc
      end select
      w1+=mid(s,c,d-c)
      ngodone:
      '
    end select
    '
  case &h74 't'
    '
    select case c2
    '
    case &h64 'td' dll proc tables etc
    '
    a=hexval(s,c)
    ape(dats,dati,mid(s,c+1,a)) 'outer quotes excluded
    d=c+a+4 'skip outer quotes + cr
    '
    case &h65 'te' virtual table entry
    '
    w3=yword(s,c)
    a=hexval(s,c)
    w1=VTEntry(a,w3)
    '
    end select
    '
  case &h75 'u'
    '
    select case c2
    '
    case &h65 'ue' virtual table section
    '
    p=hexval(s,c)
    a=hexval(s,c)
    w1=addtablesection(p,a,hexval(s,c))
    '
    end select
    '
  end select
  '
  tbuf(w1,st)
  'if instr(w1,"|") then qq mid(s,c,100)+cr+cr+w1,222
  wb=d
  b=d 'itr not recursive
loop
tbuf(mid(s,wb,len(s)-wb+1),st)
tbuf(w1,-2) 'EXTRACT STATIC VAR INIT
tbuf(wr,-1) 'EXTRACT MAIN
'
b=instr(wr,"._statics_")
'
if b then
  b+=9+len(cr)
  w2=left(wr,b)
else
  w2=""
end if
'
return w2+w1+cr+mid(wr,b+1) ' RTL | DLL VECTORS | STATICS | MAIN
'
end function


'------------------------------------------------------------
sub revskipquote(byref s as string, byref i as sys, q as sys)
'=============================================================
while asc(s,i)<>q
  i-=1
wend
end sub


'---------------------------------------------------------------------------
function instrevnskf(byval i as sys, byref s as string, wr as string) as sys
'===========================================================================
  static as sys a,b,c,d,le
  if i<0 then i=len(s)+1 '-1 indicates start from right
  if i<=1 then exit function
  le=len(wr)
  a=asc(wr,2)
  b=0
  do
    i-=1
    if i<1 then
      i=0 : exit do
    end if
    select case asc(s,i)
    case hasa
      c=asc(s,i+1)
      d=asc(s,i+2)
      if (b=0)and(c=a)and(le>0)and(asc(s,i+le)<33)and(wr=mid(s,i,le)) then
        exit do 'word match
      elseif d=&h70 then
        select case c 'block skip
        case &h78 : b+=1 : i=instrevn(i,s,")") 'skip multiple '|xp bottom boundary
        case &h79 : b-=1 : if b<0 then i=0 : exit do          '|yp top boundary
        end select
      end if
    case 34 : revskipquote(s,i,34)
    case 96 : revskipquote(s,i,96)
    end select
  loop
  '
  return i
  '
end function


'----------------------------------------------
sub markused(byref s as string, byref i as sys)
'==============================================
dim as sys a,b,c,d,e,f,g,j,k,p,lk
dim as string wr,wk
k=i
do
  p+=1
  select case p
  case 1 : wk="|go 0" : lk=6 'general procedure calls 'itr namespace
  case 2 : wk="|go 4" : lk=6 'method calls
  case 3 : wk="|ab"   : lk=4 'label addresses
  case 4 : exit do
  end select
  i=k
  do
    if i<1 then exit do
    i=instrevnskf(i,s,wk) 'LOCATE NEXT CALL ETC
    if i=0 then exit do
    b=i+lk
    i-=1
    a=asc(s,b)
    if a<>91 then
      j=hexval(s,b) 'LOCATION IN PROCLIST (PLS)
      if j=0 then
        wr=yword(s,b) 'hexval has skipped leading char ','
        a=instr(wr,"::")
        if a then wr=mid(wr,a+2) 'REMOVE NAMESPACE PREFIX
        if p=2 then nextspace(s,b) : b+=1'SKIP METHOD VECTOR
        a=hexval(s,b) 'nsi
        c=hexval(s,b) 'nsp
        e=plistend
        do 'SEARCH NAMESPACES
          j=instrevn(e,proclist," "+wr+" ")
          if j=0 then exit do
          f=j+len(wr)+3
          d=hexval(proclist, f)
          if c then
            if c=d then exit do  'nsp match
          else
            if d=0 then exit do  'root namespace
            if a=d then exit do  'nsi match
          end if
          e=j-1 'TRY ANOTHER TO GET NAMESPACE MATCH
        loop 'SEARCH NAMESPACES
        if j=0 then
          continue do 'NOT FOUND IN PROCLIST
        else
          j-=1 'LOCATE START OF RECORD
        end if
      end if
      if asc(proclist,j)<>32 then
        mid(proclist,j)=" " 'REMOVE DELETION / RECURSION FLAG
        j+=2
        wr=yword(proclist,j)
        hexval(proclist,j)   'SKIP NAMESPACE
        g=hexval(proclist,j) 'LOCATION OF PROCEDURE IN THE CODE
        j=instrevn(g,s,")")
        markused(s,j) 'RECURSE WITHIN PROCEDURE
      end if
    end if
  loop
loop
end sub



