
declare sub      addrtrim(byref s as string)
declare function leaedi(wr as string) as string
declare function mword(byref s as string, byref i as sys) as string
declare function pword(byref s as string, byref i as sys) as string
declare sub      varadr(byref wr as string, byref da as sys)
declare sub      makestrptr(byref wr as string)
declare function meftaval( byref s as string, byref i as sys, byref wa as string, byval tp as sys) as double
declare sub      vars(byref s as string)
declare function stodata(byref s as string) as string
declare function arrayres(byref s as string, byref i as sys, byref wr as string) as string
declare function procedures(byref s as string, byref i as sys, byval wr as string) as string
declare function express( byref s as string, byref i as sys, byref typa1 as sys) as string
declare sub      indiri(byref wr as string, byval n as sys)
declare function enc(s as string) as string
declare function henc(s as string) as string
declare function tmpvar() as string
declare function operi(byval qp as sys, byval tp as sys, wk as string) as string
declare sub      dataset(byref s as string, byref i as sys, tp as sys)
declare function NewTmpVar(ty as string) as string
declare function subsas(byref s as string, byref i as sys, byref ur as string, byref v as string, byval igb as sys ) as sys

'-------------------------------------------------------
function isptr(byval s as string, byref i as sys) as sys
'=======================================================
dim as sys d
do
  skiplspace(s,i)
  select case ascn
  case 42
    i+=1 : d+=1 : continue do
  case 91
    if asc(s,i+1)=93 then i+=2 : d+=1 : continue do
  case &h70
    if wordahead(s,i)="ptr" then
      i=nwd : d+=1 : continue do
    end if
  end select
  exit do
loop
function=d
end function


'=====
'PARSE
'=====






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

    '========
    'IDENTIFY
    '========




'----------------------------------------
function isreg(byref wr as string) as sys
'========================================
  '
  dim as sys a
  a=lookupm(wr)
  if a then if maco(a,0)=-10 then function=maco(a,2)+1
  '
end function


'-------------------------------------------
function identype(byref s as string) as sys
'===========================================
  '
  dim as sys a,b,c,n,i=1
  static as string w1,wm
  indt=0 'TYPE INDIRECTION ACCUMULATOR
  ary="" 'TYPE ARRAY ACCUM
  a=asc(right(s,1))
  if a=42 then '*' POINTER
    a=ascn 'SAVE ASCN
    wm=tword(s,i)
    indt=isptr(s,i)
    ascn=a
  else
    wm=s
  end if
  '
  ridentype1:
  '----------
  '
  if wm="" then exit function
  '
  a=lookupm(wm)
  if a=0 then return 0
  '
  ridentype2:
  '----------
  '
  b=maco(a,0)
  '
  ridentype3:
  '----------
  '
  select case b
    case -3
      n=a+htyp : lent=maco(a,1) 'TYPE / STRUCT / CLASS
    case -8
      n=maco(a,5)
      lent=n and 31 ' pointer (BSTR or BSTR byref)
      c=maco(a,3)
      indt+=c 'INDIRECTION
      '
      w1=macso(a,2)
      if len(w1) then
        ary=w1+" "+ary
      end if
      b=maco(a,4) 'GET UNDERLYING TYPE
      if b<htyp then
        n=b
        if n=-5 then
          indt=0 : ary="" : return cpuw 'FUNCTION POINTER TYPE AS SYS
        end if
        lent=maco(a,1)
        return n
      else
        a=b-htyp 'LOCATE TYPE OR TYPEDEF
        goto ridentype2
      end if
    case -15 'PRIMITIVE TYPES
      n=maco(a,5)
      lent=n and 31 ' pointer (BSTR or BSTR byref)
      if lent=0 then 'void / cpu / fpu
        if cpuw=8 then
          lent=cpuw 'position maintainer 64bit params
        end if
        if indt then
          lent=cpuw
          n=cpuw
        else
          if n=0 then n=-1 'void / cpu
        end if
      elseif instrword(" sys any ",wm) then  
        n=cpuw : lent=cpuw
      elseif (n>=&ha0)and(n<&h100) then
        if n>=&hc0 then
          lent=cpuw
        elseif maco(a,3)>0 then
          lent=cpuw 'POINTER
        end if
      end if
      return n
    case -16
      if wm="string" then lent=cpuw : return &he1
      return 0
    case -20 to -18
      if nmac=0 then wm=macso(a,1) : goto ridentype1 'MACRO RESOLVE
      return 0
    case -33
      lent=cpuw : return cpuw 'ENUMERATION
    case else : return 0
  end select
  '
  return n
  '
end function


'------------------------------------
function typename(n as sys) as string
'====================================
  if n<=0 then
    return "void"
  elseif n<htyp then
    return revdic(idtype,n)
  else
    return macso(n-htyp,0)
  end if
end function


'---------------------------------------------------------------
sub ctype(byref s as string, byref i as sys, byref wr as string)
'===============================================================
  '
  'TRANSLATE C PRIMITIVES
  '
  '
  'arrays and pointers and functions resolved in o2prep.bas
  '
  dim as sys a,b,c,m,le,aa,ai,am
  dim as string wn
  m=8
  wn=wr
  ai=i
  am=m
  skiplspace(s,i)
  do
    c=dic(" signed 1, unsigned 2, long 3, wide 4, short 5, char 6, wchar 7, string 8, ",wr)
    'if ai<>i then
    '  if wr=wn then i=ai : exit do  'eg: bool BOOL
    'end if
    select case c
    case 0 : 
      aa=lookupm(wr) : c=0
      if aa then
        c=maco(aa,0)
        if (c=-15)or(c=-8)or(c=-3) then exit do 'INCLUDE TERM
      end if
      i=ai : wr=wn : exit do 'EXCLUDE TERM
    case 1 : b or= 1 : a=1
    case 2 : b or= 1 : a=2
    case 3 : am=m : b += 8  : m+=m
    case 4 : am=m : b += 8  : m+=m
    case 5 : am=m : b += 8  : if m>1 then m\=2
    case 6 : b or= 2
      if a=1 then wr="sbyte"
      if a=2 then wr="ubyte" 
    case 7 : b or= 2
      if a=1 then wr="short"
      if a=2 then wr="word"
    case 8 : exit do 'STRING
    end select
    '
    if isx(ascn) then exit do
    wn=wr : ai=i
    wr=tword(s,i)
    if tyd then
      if isxn then wr=wn : i=ai : exit do 'tyd TYPEDEF FLAG
    end if
  loop
  skiplspace(s,i)
  '
  if cpuw=8 then
    if (wr="quad") then wr="sys" 'otherwise the FPU is used (typ=0x48)
  end if
  '
  if b then
    '
    if instrword(" long short wide ",wr) then m=am 'SUPPRESS FINAL SCALER
    '
    typ=identype(wr)
    if (typ>0)and(typ<&h100) then
      le=lent
      if typ<&h40 then
        if a=1 then
          typ and=&hffffffdf 'SIGNED ADJUSTMENT
        elseif a=2 then
          typ or= &h20 'UNSIGNED ADJUSTMENT
        end if
      end if
      if m<>8 then
        le=(typ and 31)*.125*m
        if typ<&h80 then
          lent=le 'LENGTH ADJUSTMENT 'not strings
        end if
        'long double=extended (10 bytes)
        if le=16 then
          if typ=&h68 then le=10 : lent=le
        end if
      end if
      typ=(typ and &hffffffe0)+le 'REFORMULATE TYPE
      if cpuw=4 then
        if typ=8 then
          typ=&h48 'handled by fpu 
        elseif typ=&h28 then
          typ=&h48
        end if
      end if
      wn=typename(typ) 'REDEFINE TYPE NAME
      if len(wn) then
        wr=wn
      else
        ers="Unable to resolve altered type: "+wr : ert=200
      end if
    end if
  end if
  '
end sub

'--------------------------------------------
function identypes(byval tp as sys) as string
'============================================
  '
  dim as sys l
  dim as string wr
  l=tp and 31
  select case l
  case  1 : wr="byte  "
  case  2 : wr="word  "
  case  4 : wr="dword "
  case  8 : wr="qword "
  case 10 : wr="eword "
  case 12 : wr="eword "
  end select
  function=wr
  '
end function

'----------------------------------------------------------------------
sub MacroMemberType(byref s as string, byref i as sys, byref tp as sys)
'======================================================================
dim as string wt
tp=0
do
  nextinstruct(s,i)
  if isb(ascn) then
    exit do 
  else
    wt=aword(s,i)
    tp=identype(wt) 'TYPE CODE IS STORED IN TYP
  end if
loop
typ=tp 'GLOBAL
end sub

'--------------------------------------------------------------------------------
function MacroMember(byref s as string , wm as string, byref wp as string) as sys
'================================================================================
  dim as sys a,e,i,t
  dim as string w1,w2,w3
  if wm="" then w1="macro" else w1=wm
  dtf=instr(ow,".")
  w2=mid(ow,dtf)
  i=1
  'SCAN MACRO BLOCK
  'itr not efficient for large macros
  do
    w3=aword(s,i)
    if w3="end" then
      if nisxn then e=1 : continue do
    elseif w3=w1 then
      if e then e=0 : continue do
      if w2=aword(s,i) then a=i : exit do
    end if
    e=0
    if lenw=0 then exit do
  loop
  '  
  if a then
    macromembertype(s,a,t)
    wp=captureblock(s,a,wm) 'MEMBER MACRO PROTOTYPE OR MEMBER DEF BLOCK
    ow="("+w1+" member) "+ow
    dtf=0
    return a
  else
    ert=2001 : ers="Unable to find "+w1+" member" : exit function
  end if
end function


'----------------------------------------------------------------------------
function HiMac(byval mm as sys, byref  s as string, byref i as sys) as string
'============================================================================
  dim as sys a,b,C,m,n,md,igb,itm
  dim as string w1,w2,w3,w4,w5,w6,wa,wt,wv
  '
  itermac:
  '
  md=maco(mm,5)   ' MODE 104 #DEFINE 109 ,MACRO
  w1=macso(mm,1)  ' BODY
  wt=macso(mm,2)  ' RETURNTYPE
  w3=macso(mm,3)  ' PROTOTYPE EXCLUDING OUTER BRACKETS
  '
  'PARAMETERS BRACKETS ?
  '
  if itm=0 then
    skiplspace(s,i)
    if ascn=lbr then
      i+=1
      skiplspace(s,i)
      igb=1
    end if
  end if
  '
  wt=rtrim(wt) 'POSSIBLE TYPE OF MAIN MACRO
  '
  if len(wt) then
    inserts(s,newtmpname()+cm,i)
  end if
  '
  'IDENTIFY MACRO MEMBER
  '
  if (dtf)and(md=109) then
    a=MacroMember(w1,"",w3) 'CAPTURE PROTOTYPE IN W3
    if a=0 then exit function
    w1=CaptureBlock(w1,a,"macro") 'CAPTURE BODY
    skiplspace(s,i)
    if typ then wt=typename(typ) 'RETURNTYPE
  end if
  '
  if w3="" then
    goto nhimac 'NO PARAMS TO REPLACE
  end if
  '
  if instr(w3,"=") then 'DEFAULT VALUES
    w4="(,"+w3+",)"
    a=subsas(s,i,w4,w3,igb)
    igb=1 : i+=1
  end if
  '
  'SERIALISED REPLACEMENTS
  '
  a=1
  w6=""
  do
    w4=tword(w3,a)
    select case ascw
    case 0     : exit do
    case 35    : w5=w4 : goto nseri '#REST
    case 44,58 : continue do ','  ':'
    end select
    'w5=newtmpname()
    w5=chr(127)+w4
    if lookupm(w5) then tmpi+=1 : w5+=str(tmpi)
    if md=109 then b=1 else b=0
    replacewdt(w1,w4,w5,b)
    nseri:
    w6+=w5+","
  loop
  '
  w3=w6
  '
  b=1
  c=0
  do
    w4=tword(w3,b)                  'NEXT PARAM FROM PROTOTYPE
    if lenw=0 then exit do          'NO FURTHER PARAMS
    if ascn=44 then b+=1            'CAPTURE PARAM FROM PROTOTYPE (ALSO SKIP COMMA)
    '
    if igb then
      nextinstruct(s,i)              'SUPPORT MULTILINE
    else
      skiplspace(s,i)
    end if
    '
    a=0
    '
    if nisxn then
      a=1
      if ascn=47 then
        i+=1 : c+=1024  'INHIBIT CREATION OF WV RETURN VAR '(/'
      end if
      if w4="#rest" then noco=1
      w2=captsx(s,i) 'CAPTURE SINGLE WORD OR EXPRESSION
      noco=0
    end if
    if ascn=44 then i+=1 : nextinstruct(s,i)
    '
    '
    if a then
      replacewd(w1,w4,w2,1) 'REPLACE W4 WITH W2 IN BODY W1
    end if
    itm+=1
    c+=1
    if c=1 then
      if len(wt)>0 then
        wv=w2
        if typm then
          w2=tword(wt,1)
          if w2="any" then
            wt=typename(typm)
            if ascn=42 then wt+="*"
          end if
        end if
        vars(wt+" "+wv) 'CREATE RETURN VAR
      end if
    end if
    '
  loop
  '
  nhimac:
  '
  if len(wa) then
    function=wa
  else
    if len(wv) then
      hiex+=w1+cr
      w1=wv
      rps=8
    end if
    function=w1
  end if
  if igb then
    nextinstruct(s,i)
    if ascn=rbr then
      i+=1 'closing bracket
    else
      ers="Too many params"
      ert=361
    end if
  end if
  skiplspace(s,i)
  if isc(ascn) then
    endline(s,i) 'avoid comments
  end if
end function


'-----------------------------------------------------------
function readval(byref wm as string, byref k as sys)  as sys
'===========================================================
  '
  dim as sys a
  skipspace(wm,k)
  a=pval(strptr(wm)+k-1) 'support gigs
  nextspace(wm,k) : k+=1
  function=a
  '
end function


'-----------------------------------------------
sub readvals(byref wm as string, byref k as sys)
'===============================================
  '
  dim as sys a,c,m,n,v
  dim as string w1
  '
  n=ascn
  '
  a=readval(wm,k)          'LENGTH OF MEMBER ELEMENT
  woff=readval(wm,k)       'OFFSET
  plq=k                    'PATCH POSITION FOR PROCLIST POSITION
  pls=yword(wm,k)          'PROCLIST POSITION
  varf=readval(wm,k)       'ELEMENT VAR/PROC/METHOD
  cco=asc(wm,k)-65  : k+=1 'CALLING-CONVENTION
  vtq=asc(wm,k)-65  : k+=2 'VIRTUAL MODALITY
  'PARAMS SIGNATURE
  ascn=asc(wm,k)
  if ascn=44 then
    sig="" : k+=1
  else
    sig=uword(wm,k)
  end if
  '
  '
  '
  'RETURN SIGNATURE (AND TYPE)
  '
  sog=yword(wm,k)
  '
  'TYPE GIVEN BY REF-NUMBER, PRIM-CODE OR NAME
  '
  if isn(asc(sog))  then
    typ=wval(sog)
    sog=typename(typ)
  else
    typ=identype(sog)
  end if
  elsize=lent
  lent=a
  '
  '
  'ARRAY SIZE
  '
  if ascn=91 then
    capture(wm,m,k,0)
    m+=1
    aml=wval(mid(wm,m,k-m))
  else
    aml=1
  end if
  '
  'DEFAULT PARAM VALUES (,a=3,b=4,)
  '
  if ascn=lbr then
    capture(wm,m,k,a)
    dvm=mid(wm,m,k-m)
  end if
  '
  ascn=n
  '
end sub


'-----------------------------------
sub splitoperand(byref wr as string)
'===================================
  dim as sys a
  a=instrevn(-1,wr,cr)
  if a then
    a+=2
    wpfx+=left(wr,a-1)
    wr=mid(wr,a)
  end if
end sub


'---------------------------------------------------------------------
function nextmemb(byref wm as string,byref k as sys, mo as sys) as sys
'=====================================================================
  '
  'GET NEXT ELEMENT IN STRUCTURE, EXCLUDING METHODS
  '
  dim as sys a
  dim as string w1
  typ=0
  a=instr(k,wm,"/\"+cr)
  if a then k=a
  do
    k=instr(k,wm,htb)
    if k=0 then exit do
    k+=1
    w1=wordahead(wm,k)
    if right(w1,2)="__" then continue do 'SKIP __ names (pvft etc)
    k=instr(k,wm," ")
    if k=0 then exit do
    '
    'READ ATTRIBUTES
    '
    readvals(wm,k)
    if (varf=5)or(varf=6) then
      if mo=0 then continue do 'IGNORE GROUP HEADER RECORD
    elseif varf then
      if mo=1 then continue do 'GROUP HEADER RECORDS ONLY
    end if
    exit do
  loop
  if (varf=3)or(varf>=8) then typ=cpuw 'TREAT AS POINTERS
  return typ
end function


'--------------------
sub gettoff(m as sys)
'====================
  dim as sys a,c
  toff=0
  'c=lookupm(macso(m,0)+"_table") 'itr potentially lost namespace
   c=maco(m,2) '_table index
  '
  if c then
    regst=mid(macso(c,1),2,3)
    toff=maco(c,2) 'TABLE BASE OFFSET USED LATER
  else
    regst=""
  end if
end sub


'-----------------------------------------------------------------------------------
sub nextproc(byref s as string, byref k as sys, byref wr as string, byref lb as sys)
'===================================================================================
  '
  'FOR FUNCTIONS
  '
  dim as sys m
  k=instr(k,s,"##")
  lb=0
  if k then
    k+=1
    sig=yword(s,k)             'PROTOTYPE SIGNATURE
    sog=yword(s,k)             'RETURN TYPE OR COMMA
    wr=yword(s,k)              'FUNCTION SIGNAME / ALIAS / VECTOR / OFFSET
    '
    'FURTHER OPTIONAL DATA
    '
    if ascn>=48 then
      lb=wval(yword(s,k))      'LIBRARY LIST NUMBER
      mtyp=asc(s,k)-65         'METATYPE
      cco=asc(s,k+1)-65        'CALLING CONVENTION
      k+=3 : ascn=asc(s,k)
    else
      mtyp=16 : cco=0          'CORE FUNCTION
      if cpuw=8 then cco=2     'MS64
    end if
    '
    if ascn>47 then
      pls=yword(s,k)           'LIST OFFSET FOR PROCLIST ENTRY
    end if
    if ascn=40 then
      capture(s,m,k,0)
      dvm=mid(s,m,k-m)         'DEFAULT PARAM VALUES
    end if
    varf=8
    typ=identype(sog)
  end if
end sub


'------------------------------------------------------------------------------------
sub findmemb(byval wki as string,byref wr as string,byref ki as sys, byref kl as sys)
'====================================================================================
  '
  'RESOLVES MEMBERS
  '
  dim as sys a,b,m,n,v,c,k,dt,chmp,ml,mcc
  dim as string wm,wn,w1,wk
  '
  wk=wki : ml=mp
  '
  'IS IT A VARIABLE?
  '=================
  '
  m=maco(ml,0)
  if m>=htyp then m-=htyp
  '
  'STRUCTURE INDEX
  '
  if m>=0 then
    '
    ind=maco(ml,3) and 255 'INDIRECTION
    voff=maco(ml,2)        'BASE OFFSET OF VARIABLE
    '
    wbse=macso(ml,1)
    splitoperand(wbse) 'adds to wpfx
    '
    if (ind=0)and(wpfx="") then
      if asc(wbse,2)=35 then
        a=len(wbse)-2 '[#name]
      else
        a=3
      end if
      wn=mid(wbse,2,a)
    else
      wn=qedi
      indiri(wbse,ind) 'CREATE INDIRECTION CODE
    end if
    '
  else 'm<0 NOT A VAR
    '
    mcc=m
    m=ml
    ind=0
    voff=0
    if maco(ml,3)>1 then
      ers="Not possible with extern virtual/preset: "+ow : ert=601 : exit sub
    end if
    '
  end if
  '
  '
  '
  '-------------------------------------------------
  rmatchm:  'RECURSION POINT FOR INDIRECT STRUCTURES
  '-------------------------------------------------
  '
  'GET STRUCTURE
  '-------------
  '
  mq=m
  wm=macso(m,1)
  '
  if dt=0 then k=ki
  '
  '
  'CHECK ELEMENT EXISTS
  '--------------------
  '
  'element with attached signature
  'addreses of methods etc
  a=instr(wk,"#")
  if (a>0)or(mcc=-3) then
    if a>0 then
      w1=mid(wk,a) 'signature
      wk=left(wk,a-1) 'name without sinature
      c=0
    else
      w1="" 'no signature
      c=1
    end if
    b=len(wk)
    do
      a=instrevn(k,wm,htb+wk+" ")
      if a then
        k=a+b+2
        readvals(wm,k)
        if (c=1)or(w1=splitsi(sig,"")) then
          ki=a : goto methodev
        else
          k=a-1
        end if
      else
        exit do
      end if
    loop
  else 'normal search
    a=instrevn(k,wm,htb+wk+" ") : chmp=0
  end if

  if a=0 then
    '
    'CHECK FOR INDIRECT STRUCTURE
    '----------------------------
    '
    'LOOK FOR DOTTED PART OF NAME
    '
    b=instr(wk,".")
    '
    if b then
      w1=left(wk,b-1)
      if asc(wk,b+1)=62 then b+=1 '.>' ARROW DERIV
      a=instrevn(k,wm,htb+w1+" ") 'ROOT NAME
      '
      if a=0 then
        ki=0 : exit sub 'NOT LOCATED
      end if
      '
      wk=mid(wk,b+1) 'CHOMP W1
      b=len(w1) 'first part of name located
      chmp=1
      '
    else 'no dot
      '
      ki=0 : kl=0 : exit sub 'NOT LOCATED
      '
    end if
  else 'main name located
    b=len(wk)
  end if
  '
  'SET PRIMARY LOCATOR AND DISABLE FURTHER UPDATES
  '
  if dt=0 then
    ki=a
    dt=1
  else
    kl=a
    ki+=1 'FOR INDIRECT OVERLOAD REPEAT SEARCH
  end if
  '
  'READ ATTRIBUTES
  '===============
  '
  k=a+b+2 'skip over identified name
  readvals(wm,k)
  '
  '
  methodev:
  '========
  '
  v=0 : c=m 'SET C SAME AS STRUCTURE
  '
  if varf then
    '
    'CHECK FOR CLASS STATIC ELEMENTS AND METHODS
    '-------------------------------------------
    '
    'VARF CODES
    '
    '1   body member
    '3   pointer body member
    '5   body group header
    '6   static group header
    '8   procedure pointer
    '9   method pointer
    '10+ inherited method pointer
    '
    '
    if (varf<9)or(mcc=-3) then
      v=woff 'STRUCTURE OFFSET
    end if
    '
    '
    'METHODS
    '-------
    '
    if varf>8 then
      gettoff(m)
      if mcc=-3 then
        wn=regst : voff=toff 'USE TABLE BASE FOR METHODS
      end if
    end if
    '
  end if ' VARF
  '
  '
  if (ind=0)and(len(wpfx)=0) then
    v+=voff 'ADD VARIABLE BASE IF VF TABLE IS USED
  end if
  '
  'REBUILD THE ADDRESS OPERAND
  '===========================
  '
  m=asc(wn)
  '
  if (v<>0)or(m=35) then
    '
    'RESOLVE HOST ADDRESS WITH OFFSET
    '
    if m=35 then
      'resolve to abs address
      n=getvarptr(wn)
      if n=0 then ert=300 : ers="Host variable not located: "+wn
      wn=str(n+v) : v=0
    '
    'ADJUST ABSOLUTE ADDRESS OFFSET
    '
    elseif isn(m) then
      '
      'QUICK HEXADECIMAL CHECK
      '
      n=asc(wn,2)
      'if n=&h78 then mid(wn,1)="&h"
      wn=str(wval(wn)+v) : v=0
    end if
    '
  end if
  '
  wr=memreg(wn,v) 'COMPOSE OPERAND
  '
  '
  'CHECK IF INDIRECT STRUCTURE POINTER
  '===================================
  '
  if varf=3 then
    if len(wk) then
      '
      'IF FURTHER RESOLUTION REQUIRED
      '
      indiri(wr,1)
      ind+=1
      '
      if chmp=0 then
        wr=pedi : exit sub 'RESOLVED
      end if
      '
      wn=qedi
      ml=typ-htyp
      m=ml : ind=0
      voff=0 : toff=0
      if kl then k=kl else k=-1 'FOR POSSIBLE INDIRECT OVERLOADING
      goto rmatchm 'LOOP RECURSE FOR NEXT STRUCTURE
    end if
  end if
  '
end sub



'-------------------------------------------------------------------------
function identop(byref s as string, byval k as sys, byref i as sys) as sys
'=========================================================================
  '
  ' n   operator code
  ' prl precedence level
  dim as sys n,a,b
  dim as string wr
  '
  '
  a=asc(s,k)
  if isa(a)=0 then
    '
    if (isq(a))or(isb(a)) then exit function
    '
    n=a
    '
    'higher prl means higher precedence
    '----------------------------------
    if a=92 then prl=7 : goto idop '\
    if a=47 then prl=7 : goto idop '/
    if a=42 then prl=7 : goto idop '*
    '----------------------------------
    'power        8 ^
    'mult div     7 * / \
    'add subtract 6 + -
    'shifts       5 << >>
    'comparators  4 == <> > < >= <=
    'logicals     3 and 2 xor 1 or
    '----------------------------------
    '
    b=asc(s,k+1)
    '
    if (a=43)or(a=45) then
      prl=6                    '+ -
      if a=b then i+=1 : a+=128 : prl=9 '++ -- unary
      goto idop '+
    end if
    '
    n=0
    '
    'AND && &
    '
    if a=38 then
      if b<>a then
        if isa(b)=0 then n=33 : prl=3 : goto idop '&
        goto idop ' &h &o ignore
      end if
      i+=1 : n=71 : prl=1 : goto idop '&&
    end if
    '
    'OR || |
    '
    if a=124 then
      prl=1
      if b<>a then n=34 : goto idop    '|
      i+=1 : prl=1 : n=72 : goto idop  '||
    end if
    '
    if a=33 then
      if b=61 then i+=1 '!=
      n=104 : prl=4
      goto idop 'NOT !
    end if
    '
    '<< < <= <>
    '
    if a=60 then
      if b=60 then
        i+=1
        if asc(s,k+2)=b then
          i+=1
          n=76 '<<< ROTATE LEFT
        else
          n=74 '<<  SHIFT LEFT 
        end if
        prl=5 : goto idop
      end if
      prl=4                    'COMPARATORS
      n=28                     '0x1c <
      if b=61 then i+=1 : n=30 '0x1e <=
      if b=62 then i+=1 : n=21 '0x15 <>
      goto idop '<
    end if
    '
    '= ==
    '
    if a=61 then
      prl=4 : n=20                  '0x14 =  0x14
      if b=61 then i+=1 : goto idop '0x14 == 0x14
      'if cnd=0 then n=0 : prl=0 'EXCLUDES A()= a()=> ASSIGNMENTS
      goto idop
    end if
    '
    '>> > >=
    '
    if a=62 then
      if b=62 then
        i+=1
        if asc(s,k+2)=b then
          n=77
          i+=1  '>>> ROTATE RIGHT
        else
          n=75  '>>  SHIFT RIGHT 
        end if
        prl=5 : goto idop
      end if
      n=31              
      prl=4                     '0x1f >
      if b=61 then i+=1 : n=29  '0x1d >=
      goto idop 'COMPARE
    end if
    '
    if a=94 then
      if a<>b then
        prl=8 : n=a : goto idop '^ power (not C Xor ??)
      else
        i+=1 : n=73 : prl=1 : goto idop 'boolean xor
      end if
    end if
  else
    '
    'WORD OPERATORS
    '
    a=asclc(a)
    if (a=&h61)or(a=&h6f)or(a=&h78) then
      i=k
      wr=tword(s,i) : i=swd+lenw
      if wr="and"  then n=33 : prl=3 : goto idop
      if wr="xor"  then n=35 : prl=2 : goto idop
      if wr="or"   then n=34 : prl=1 : goto idop
    end if
  end if
  '
  'itr unaries?
  '
  idop:
  '
  return n
  '
end function


#if 0
'------------------------------------------
function identopc(byval n as sys) as string
'==========================================
  select case n
  case  0 : return ""
  case  1 : return ""
  case  2 : return "="
  case 11 : return "~"
  case 20 : return "=="
  case 21 : return "!="
  case 28 : return "<"
  case 29 : return ">="
  case 30 : return "<="
  case 31 : return ">"
  case 33 : return "&"
  case 34 : return "|"
  case 35 : return "^"
  case 42 : return "*"
  case 43 : return "+"
  case 45 : return "-"
  case 47 : return "/"
  case 71 : return "&&"
  case 72 : return "||"
  case 74 : return "<<"
  case 75 : return ">>"
  case 76 : return "<<<"
  case 77 : return ">>>"
  case 92 : return "\"
  '73 bool xor
  '94 power
  end select
end function
#endif

'------------------------------------------
function identoph(byval n as sys) as string
'==========================================
  select case n
  case 00 : return "opmov"    '
  case 01 : return "opmov"    '
  case 02 : return "opmov"    '
  case 07 : return "opneg"    'unary negative
  case 42 : return "opmul"    '*
  case 43 : return "opadd"    '+
  case 45 : return "opsub"    '-
  case 47 : return "opdiv"    '/
  '-----------------------------------
  case 33 : return "opand"    '
  case 34 : return "opor"     '
  case 35 : return "opxor"    '
  '-----------------------------------
  case 20 : return "opeq"     '== 0x14
  case 21 : return "opne"     '<> 0x15
  case 28 : return "oplt"     '<  0x1c
  case 29 : return "opge"     '>= 0x1d
  case 30 : return "ople"     '<= 0x1e
  case 31 : return "opgt"     '>  0x1f
  '-----------------------------------
  case 08 : return "opaddeq"  '+=
  case 09 : return "opsubeq"  '-=
  case 14 : return "opmuleq"  '*=
  case 15 : return "opdiveq"  '/=
  '-----------------------------------
  case else
    ers=str(n)+" operator not supported for type of " 
    ert=402 
  end select
end function


'-------------------------------------------------------------------------------
function identopeq(byref s as string, byref i as sys, byref w1 as string) as sys
'===============================================================================
  if ascw=60 then
    exit function
  elseif ascw=61 then
    function=2
    w1="mov "
    if cnd then
      function=&h14
      if asc(s,swd+1)=61 then i+=1 : skiplspace(s,i)
    end if
    exit function
  end if
  '
  op=identop(s,swd,i)
  w1=mid(s,swd,i-swd)
  skiplspace(s,i)
  i+=1
  skiplspace(s,i)
  '
  if (op=0)or(op>=htyp) then
    function=op
    exit function
  end if
  '
  ascw=61
  select case op
  case 43 : w1="add " : function=8  '+=
  case 45 : w1="sub " : function=9  '-=
  case 42 : w1="mul " : function=14 '*=
  case 47 : w1="div " : function=15 '/=
  case 92 : w1="div " : function=15 '\=
  case 33 : w1="and " : function=65 'AND=    
  case 34 : w1="or "  : function=66 'OR=
  case 35 : w1="xor " : function=67 'XOR=
  case 71 : w1="&&"   : function=71 '&&=
  case 72 : w1="||"   : function=72 '||=
  case 73 : w1="^^"   : function=73 '^^=
  case else
    op=0
  end select
end function


'------------------------------------------
function identops(byval n as sys) as string
'==========================================
dim as sys a
dim as string w1
  '
  'CHECK FOR USER DEFINED / EXOTIC OP
  'if n>htyp then function=macso(n-htyp,0) : exit function
  w1=" "+str(n)+" "
  a=instr(opname,w1)
  if a then
    function=yword(opname,a+len(w1))
  end if
end function


'---------------------------------------------------------
function attributes(s as string, byref i as sys) as string
'=========================================================
  '
  dim as sys kn,a,c,k,m,wa
  dim as string wr,w1
  '
  kn=maco(mp,4)
  '
  if ascn=lbr then c=1 : i+=1 'SKIP LEFT BRACKET
  '
  nmac=1
  if nisxn then w1=pword(s,i) else mp=0 : mc=0 'resolve
  nmac=0
  '
  if c then
    if ascn=rbr then
      i+=1 : skiplspace(s,i) 'BLANK RIGHT BRACKET
    end if
  end if
  '
  '
  '
  wr="0" : k=mp : m=k
  '
  'VARIABLE OR STRUCTURE ?
  '
  if mc>=0 then
    m=mc
  end if
  '
  '
  '
  select case kn
  '
  case 1 'SIZEOF
    '
    if mc=0 then
      if isq(ascw) then
        wa=cpuw
        goto attrin
      end if
    end if
    if mp=0 then
      wa=elsz 'LAST MULTIASSIGN
    elseif mc>=0 then
      if varf then wa=elsize else wa=lent
      if maco(mp,4)>0 then wa=cpuw 'INDIRECT TYPE
    elseif instrword(" string wstring bstring bstring2 ",w1) then
      wa=cpuw
    elseif instrword(" char zstring asciiz ",w1) then
      wa=1
    elseif instrword(" wchar zstring2 ",w1) then
      wa=2
    elseif mc<0 then
      a=identype(w1) : if a then wa=lent
    end if
    goto attrin
    '
  case 2 'OFFSETOF
    '
    if mc>=0 then
      wa=maco(mp,2)+woff
    end if
    goto attrin
    '
  case 3 'COUNTOF 'SPANOF NUMBER OF ELEMENTS OF MAIN ARRAY
    '
    if mp=0 then
      wa=elct+1 'LAST DATASET ELEMENT COUNT
    elseif mc>=0 then
      wa=wval(macso(mp,2))
      if wa=0 then wa=1 'not an array
    end if
    goto attrin
    '
  case 4 'BYTES OF: NUMBER OF BYTES OF MAIN ARRAY
    '
    if mp=0 then
      wa=(elct+1)*elsz 'LAST DATASET ELEMENT COUNT
    elseif mc>=0 then
      if varf then a=elsize else a=lent
      if maco(mp,4)>0 then a=cpuw
      wa=wval(macso(mp,2))*a
      if wa=0 then wa=lent 'not an array
    end if
    goto attrin
    '
  case 5 ' 
    '
    if mc>=0 then
      if len(sog) then
        wr=sog
      else
        wr=identypes(typ)
      end if
    elseif mc=-31 then
      wr=sog
    elseif mc=-32 then
      wr="string" 'not bstring
    elseif mc<0 then
      wr="metatype "+str(mc)+" "+_
     dicsn(metatypes,mc) 'TYPEOF TYPE
    end if
    '
  case 6 'STRUCTUREOF ENCODINGOF
    '
    wr=macso(m,1)
    '
  case 7 'PROTOTYPEOF
    '
    wr=macso(k,3)
    '
  case 8 'TYPECODEOF
    '
    wa=typ
    goto attrin
    '
  case 9 'RECORDOF
    '
    wr=writestates(k,k)
    '
  case 10 'WIDTHOF
    '
    wa=typ and 31
    goto attrin
    '

  case 21 'STRPTR
    '
    makestrptr(w1)
    return w1
    '
  end select
  '
  '
  '-----
  attris:
  '-----
  '
  if nl then
    typ=0 'raw code
  else
    wr=iq+wr+iq 'quoted string literal
    typ=&hc1
  end if
  '
  goto attrix
  '
  '-----
  attrin:
  '-----
  '
  wr=str(wa) : typ=cpuw
  '
  '-----
  attrix:
  '-----
  '
  mc=0 : mp=0 : varf=0
  function=wr
  '
end function






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

'-------------------------------------------------------------------
function macres(p as sys,byref s as string,byref i as sys) as string
'===================================================================
  dim as sys a,b,c,d,m,n,r,v
  dim as string w1,w2,wk ',rule(9)
  'then
  wk=macso(p,1)
  if wk="" then exit function
  '
  '---------------
  'LOW LEVEL MACRO
  '===============
  '
  'CHECK NO SUBSTITUTIONS
  '
  if incli then goto nmacres
  '
  'IDENTIFY MACRO MEMBER
  '
  if dtf then
    a=MacroMember(wk,"def",wk)
    if a=0 then exit function
    skiplspace(s,i)
  end if
  '
  'FIND HIGHEST PARAMETER
  '
  a=1 : b=48
  do
    a=instr(a,wk,"%")
    if a=0 then exit do
    a+=1
    v=asc(wk,a)
    if v=48 then
      r=1
    elseif (v>b)and(v<58) then
      b=v 'UP TO 9 PARAMS
    end if
  loop
  '
  'MAKE SUBSTITUTIONS
  '
  b-=48
  a=1
  '
  'GRAB MACRO PARAMETERS
  '
  do
    b-=1 : if b<0 then exit do
    c=asc(s,i)
    '
    'CAPTURE CONTENT BETWEEN BRACKETS
    'ARRAYS AND FUNCTIONS MUST BE CONTAINED INSIDE BRACKETS (..)
    '
    if (ise(c))or(isb(c)) then '
      c=i : nextinstruct(s,c) 'look ahead for brackets
      if isb(ascn) then
        i=c
        capturi(s,m,c,i)
        w1=mid(s,m,c)
      else
        w1=""
      end if
      skiplspace(s,i)
    else
      'CAPTURE INDIVIDUAL WORD / NUMBER
      'ENSURE CAPTURE NEGATIVE NUMBER
      w1=tword(s,i)
      if ascw=45 then
        c=asc(s,swd+1)
        if isn(c) then
          w1+=tword(s,i)
        end if
      end if
    end if
    '
    wp(a)=w1
    a+=1
    '
  loop
  if r then
    capturi(s,m,c,i)
    wp(0)=mid(s,m,c) 'CAPTURE REST OF LINE OR BLOCK
  end if
  a=1
  '
  'SUBSTITUTE WORD SYMBOLS AND MARKUP BLOCK SYMBOLS
  '------------------------------------------------
  '
  do
    a=instr(a,wk,"%") 'ascii 37
    if a=0 then exit do
    a+=1
    b=asc(wk,a)
    if b=37 then ' %% POTENTIAL ESCAPE
      c=a-2
      do
        a+=1
        b=asc(wk,a)
        if b<>37 then
          if (b>=48)and(b<=57) then
            wk=left(wk,c)+mid(wk,c+2) 'REMOVE LEFTMOST '%' WHEN NUMBER %%1 .. %%9
          else
            a+=1
          end if
          exit do  ' NO FURTHER %%
        end if
      loop
      continue do
    end if
    if (b>=48)and(b<=57) then
      b-=48
      c=len(wp(b))
      a-=2
      wk=left(wk,a)+wp(b)+mid(wk,a+3)
      a+=c+1
    else
      a+=1
    end if
  loop
  '
  nmacres:
  '
  incli=0
  function=wk
end function


'---------------------------------------------------------------------
function macrep(p as sys, byref s as string, byref i as sys) as string
'=====================================================================
dim as string wk
dim as sys r
if maco(p,2)=42 then r=1  '*' repeats
do
  if r then
    skiplspace(s,i)
    if ise(ascn)or(ascn=41)or(ascn=93)or(ascn=125) then exit do
    if ascn=44 then i+=1 : nextinstruct(s,i)
  end if
  wk+=macres(p,s,i)
  if r=0 then
    exit do
  end if
loop
if r then
  wk=rtrim(wk)
  r=len(wk)
  if asc(wk,r)=44 then
    wk=left(wk,r-1)
  end if
end if
return wk
end function


'------------------------------
sub LineMark(byref s as string)
'==============================
  dim as sys a,b,c,e,g,i,J,k,m
  dim as string d,w,u
  FixCrLf(s)
  'open "s.txt" for output as 3 : print #3,s : close(3) 'examine
  k=len(s)*1.5+100
  d=space(k)
  u=chr(39)+chr(lnm)
  'ALLOW PREFIXED BLOCKS THROUGH WITHOUT LINEMARK OR OTHER ALTERATIONS  
  i=0
  do
    j=instr(j+1,s,chr(12))
    if j=0 then exit do
    i=j
  loop
  if i then
    mid(d,1)=left(s,i-1)
  end if
  i+=1
  '
  e=i
  do
    c+=1 'LINE COUNTER
    b=i
    skiplspace(s,i)
    select case ascn
    case 0  : exit do 'END OF STRING
    case 13 : i+=2
              mid(d,e)=mid(s,b,i-b) : e=e+i-b
              continue do 'no line tag
    end select
    w=str(c)
    g=len(w)+4
    endcatline(s,i,c,0) 'SUPPORTING MULTI LINE STATEMENTS
    'support line endings: cr lf crlf
    if ascn<>0 then i+=1 : ascn=asc(s,i)
    if ascn=10 then i+=1
    m=i-b 'LENGTH OF LINE
    if m+g+e>=k then d+=space(8000) : k+=8000 'STRETCH BUFFER
    '
    mid(d,e)=u+w+cr+mid(s,b,m)
    e+=g+m
  loop
  s=left(d,e-1) 'TRIM OFF REMAINING BUFFER SPACE, ALWAYS APPEND CR
end sub


'---------------------------------------------------------------
function ResolveAsm(byref s as string, byref i as sys) as string
'===============================================================
  dim as sys a,b,c,m
  dim as string wk,wm,wn,wr,w1
  m=swd
  a=instr(m,s,"]")
  if a>m then
    i=a+1
    '
    if i=swd+2 then goto sqbrw 'EMPTY []
    '
    wk=mid(s,m,a-m)
    '
    b=2 : c=0 : w1=tword(wk,b)
    '
    if ascw=35 then
      b=getvarptr(w1)
      if b then
        w1="["+str(b)+"]" : 'HOST VARIABLE
        ascw=91
        return w1
      end if
    else
      '
      'RESOLVE VARIABLE FB SYNTAX [VAR]
      '
      if dtf then a=dtf-1 else a=lenw 
      a=lookupm(left(w1,a))
      if a then
        c=maco(a,0)
        if (c>=0)or(c=-14) then 'allow [function] or [method]
          ascw=asc(w1) : return w1
        end if
      end if
    end if
    '
    'OTHERWISE ASSUME A NORMAL ASM MEMORY OPERAND
    '
  end if
  '
  'RETURN WHOLE [..] ASM MEMORY OPERAND
  '
  sqbrw:
  '
  swd=m : wr=mid(s,swd,i-swd) : ascw=asc(wr) : skiplspace(s,i)
  '
  return wr
end function


'-------------------------------------------------------------
function idento(byref wr as string, byref wk as string) as sys
'=============================================================
  '
  dim as sys a,b,c,m,mm,nth
  dim as string w1
  '
  'CHECK FOR DOTTED NAMES
  '
  if dtf then
    ow=wr             'make it original (after macro resolution)
    if asc(wr,dtf+1)=62 then a=2 else a=1 
    wk=mid(wr,dtf+a)  'possible member
    wr=left(wr,dtf-1) 'possible name
    if wr="that" then
      wr=wk
      dtf=instr(wr,".")
      nth=1
      ow=wr
    end if
  end if
  '
  '
  mm=lookupm(wr)
  b=0
  '
  if nth then
    goto nlookupmm 'That' override
  end if
  '
  '
  'GIVE PRIORITY TO IMPLICIT `THIS` SYMBOLS IN METHODS
  '---------------------------------------------------
  '
  'CORE SYMBOLS ALWAYS HAVE PRIORITY (MESB)
  'BUT REGISTER-LIKE NAMES CAN BE USED
  '
  if ths then
    if mm=0 then
      b=ths
    elseif mm<mesb then
      '
      ''check for register-like names eg ax bx cx
      '
      if maco(mm,0)=-10 then
        w1=wr : m=maco(ths,0)-htyp
        c=instrevn(-1,macso(m,1),htb+w1+" ")
        if c then 
          wk=w1 : dtf=5 : function=ths : exit function
        end if
      end if
    elseif mm<mest then
      b=ths
    elseif wr="this" then
      function=ths : exit function 'EXPLICIT THIS
    end if
  end if
  '
  if b then
    '
    'CHECK FOR IMPLICIT THIS.
    '------------------------
    '
    m=maco(ths,0)-htyp
    c=0
    '
    if dtf then
      w1=wr+"."+wk
      c=instrevn(-1,macso(m,1),htb+w1+" ")
    else
      w1=wr
    end if
    '
    '
    '
    if c=0 then
      c=instrevn(-1,macso(m,1),htb+wr+" ") 'either non-dotted or possibly indirect
    end if
    '
    if c then
      wk=w1
      dtf=5 'IMPLICIT THIS
      ow="this."+ow
      function=ths
      exit function
    end if
    '
  end if
  '
  nlookupmm:
  '
  function=mm
  '
end function



'   #####                      #####
'  ######                      ######
'  ##                              ##
'  ##   ##########    ##########   ##
'  ##  ############  ############  ##
'  ##  ##    \|/ ##  ##    \|/ ##  ##
'  ##  ##    -O- ##  ##    -O- ##  ##
'  ##  ##    /|\ ##  ##    /|\ ##  ##
'  ##  ############  ############  ##
'  ##   ##########    ##########   ##
'  ##                              ##
'  ######                      ######
'   #####                      #####



'-----------------------------------------------------------
function mword(byref s as string, byref i as sys ) as string
'===========================================================
  '
  'RESOLVES MACROS, CONSTANTS, LITERALS, VARIABLES, ATTRIBUTES, TYPES ETC
  '
  ' s    source
  ' i    position in source
  ' swd  start of word position
  ' a    ascii code
  ' b    general purpose
  ' k    general purpose
  ' wr   word
  ' wk   struc or variable string
  ' wm   struc or variable string
  ' wn   gen
  '
    dim as sys a,b,c,k,m,n,v,kn
    dim as string wr,wk,wm,wn,wo,w1,w2
    '
    rmword:
    '======
    '
    typ=0 : varf=0 : elsize=0
    mc=0 : mp=0 : woff=0
    '
    '
    wr=tword(s,i)
    ow=wr
    owa=wr
    if lenw=0 then goto exitmword1
    '
    '
    'WITH prefix
    '
    if wi then
      if ascw=46 then
        wr=wth+wr
        inserts(s,wr,i)
        wr=tword(s,i)
        ow=wr
      end if
    end if
    '
    if nmb then
      goto numberq
    elseif dtf=1 then
      goto exitmword 'DOT LABEL
    elseif ascn=&h6f then 'OF' type of / size of ...
      if mid(s,i,2)="of" then
        if asc(s,i+2)<33 then
          a=lookupm(wr+"of")
          if a then
            if maco(a,0)=-11 then
              wr+="of"
              ow+=" of"
              i+=2 : skiplspace(s,i)
              mp=a
              mc=-11 : goto mwcases
            end if
          end if
        end if
      end if
    end if
    '
    '
    'CHECK FOR COLON LABELS
    '----------------------
    '
    'FIRST WORD ON LINE
    '
    if nl then
      if ascn=58 then
        if swd+lenw=i then
          mp=lookupm(wr)
          if mp then
            a=maco(mp,0)
            if (a=-13)or(a=-14)or(a=-19) then 
              mc=a : goto mwcases 'exclude these keywords as labels
            end if
          end if
          if (mp=0)or(a=-30) then
            goto exitmword2 'NEW LABEL OR OVERLAY PREVIOUS LABEL
          end if
          a=i+1 : skiplspace(s,a)
          if ise(ascn)=0 then 'MORE STATEMENTS ON THIS LINE
            inserts (s," ",i) : i+=1 : ascn=58 'ENSURE NOT TREATED AS LABEL
          else
           ascn=58 : goto exitmword1
          end if
        end if
      end if
    end if
    '
    if ascw>250 then goto exitmword1 '(not iq4 which is ascii 250)
    '
    '
    wredo:
    '=====
    '
    if qot then goto quotyp
    '
    'HUGE-RECURSION CHECK
    '--------------------
    '
    mct+=1
    if (mct>=&h100000)or(len(s)>mex) then
      ert=102 : goto exitmword2
    end if
    '
    '
    wk=""
    '
    'ASSEMBLER OPERANDS
    '------------------
    '
    if ascw=91 then
      wr=ResolveAsm(s,i)
      owa=wr
      if ascw<>91 then wk=wr : goto insertw 'RECURSE WITH VARIABLE NAME
      goto exitmword 
    end if '[..]  91
    '
    '
    '
    quotyp: 'determine literal string type
    '=====================================
    '
    if qot then
      mc=-32
      typ=&hc1
      sog="bstring"
      goto exitmword1
    end if
    '
    numberq: 'LITERAL NUMBERS CHECK
    '==============================
    '
    if nmb then
      b=swd
      wordval(s,swd,i)
      if nan=0 then
        if dtf then
          typ=&h68 : lent=8 : sog="double"
        else
          typ=4 : lent=4 : sog="long"
        end if
        wr=mid(s,b,i-b)
        mc=-31 'NUM LITERAL
        goto exitmword1
      end if
    elseif (ascw>=36)and(ascw<=64) then 'SYMBOL GROUPS
      goto exitmword
    end if
    '
    '========
    lookupwr:
    '========
    '
    if lenw=1 then
      if ascw=35 then
        if nisxn then
          wr="#"+tword(s,i) '#KEYWORD
        end if
      end if
    end if
    '
    'LOOKUPM SUPPORTS NAMESPACE NOTATION: A::B
    '
    mp=idento(wr,wk)
    '
    if mp=0 then
      if ascw=35 then
        b=getvarptr(wr)
        if b then
          wr=str(b) : nan=0 : goto exitmword
        end if
      end if
      goto exitmword2
    end if
    '
    mc=maco(mp,0)  'METATYPE OR TYPE
    '
    if mc<0 then
      if (mc=-3)or(mc=-8)or(mc=-15) then
        a=i
        nextinstruct(s,i)
        typ=identype(wr)
        '
        'MULTIASSIGN
        if ascn=123 then 'EG: double {1,2,3,4,5}
          if typ then
            elsz=lent
            dataset(s,i,typ)
            wr=aword(s,i)
            goto wredo 'REPROCESS INSERTED TEMP OPERAND
          end if
        end if
        i=a : skiplspace(s,i)
        if dtf then goto isdtf 'CLASS MEMBERS DIRECT
      elseif (mc>=-5)and(mc<=-4)and(funi>0)and(ascn=61) then
        if wr=fnam then 'itr functions, not methods
          wr="_retval" : goto lookupwr
        end if
      elseif mc=-14 then
        a=maco(mp,5)
        'function= sub method= etc
        if (a>=9)and(a<=11) then
          a=0
          if isxn then
            a=1
          else
            w1=wordahead(s,i)
            if (instrword(" = < > + - * / and or xor not ",w1)<>0) then
              a=1
            end if
          end if
          if a then wr="_retval" : goto lookupwr
        end if
      end if
      goto mwcases        'NOT A VARIABLE OR CONSTANT
    end if 'mc<0
    '
    '
    typ=maco(mp,5) 'RESOLVED TYPE
    '
    isdtf: 'IS IT A DOT NAME?
    '========================
    '
    if dtf then
      '
      '
      'MEMBER TYPES
      '------------
      '
      k=-1
      w1=wr
      findmemb(wk,wr,k,0)
      if k=0 then
        ert=402 : ers="Not found : "+ow
      elseif funn<>13 then
        if mp=ths then
          if (varf=1)or(varf=3) then 'itr or(funi=8)
            ert=405 : ers="Uninstantiated class"
          end if
        end if
      end if
      '
      if ert then wr=ow : goto exitmword
      '
      if (ascn=91)or(ascn=lbr) then
        if varf<8 then goto arrfix
      end if
      goto exitmword 'EXCLUDE FUNCTION ARRAY AND PARAMS
      '
    end if 'dtf
    '
    'NON DOTTED NAMES
    '================
    '
    wr=macso(mp,1)
    ascw=asc(wr)
    if ascw=61 then
      wr=mid(wr,2)
      ascw=asc(wr)
      if isn(ascw) then mc=-31
      goto exitmword1 'CONST
    end if
    '
    if asc(wr,2)=35 then '[#var]
      m=2
      swd=1
      wr=ResolveAsm(wr,m)
    end if
    '
    'CHECK FOR WPFX: dim b at p.member
    splitoperand(wr)
    '
    lent=maco(mp,1)
    ind=maco(mp,3)
    'indt=maco(mp,4)
    if ind then
      wbse=wr
      if cpoint=0 then indiri(wr,ind) : wr=pedi
    end if
    w1=macso(mp,3)
    a=1
    sog=tword(w1,a)
    '
    if ascn>32 then
      sig=mid(w1,a) : varf=8 'FUNCTION POINTER WITH SIGNATURE
    end if
    '
    skiplspace(s,i) 'RESTORE ORIGINAL ASCN
    '
    '
    '======
    arrfix: 'ARRAY RESOLUTION
    '======
    '
    if isb(ascn)=0 then
      goto exitmword
    end if
    '
    a=i
    c=i
    do
      capture(s,m,a,0)
      if asc(s,a)=46 then
        w1=aword(s,a)
        if ascn=91 then continue do
      end if
      exit do
    loop
    w1=ow+mid(s,c,a-c)
    skiplspace(s,i)
    '
    if ascn=91 then
      fixsqbr(s,i)
    else
      if nobr=1 then
        if ascn=lbr then nobr=0 'CLEAR ARRAY SUPPRESSION FLAG
        goto exitmword 'INHIBIT ARRAY INTERPRETATION
      end if
    end if
    '
    if ascn=lbr then
      wpfx=arrayres(s,i,wr)
    end if
    '
    'VARIABLE: [ebx+4096] [#12345678] ecx OR NUM CONST 0x123 ETC
    '
    owa=w1 'CAPTURE OUTERMOST (...) AND MEMBERS AND MEMBER ARRAYS
    goto exitmword
    '
    '
    '=======
    mwcases:
    '=======
    '
    if nmac=1 then
      if (mc=-18)or(mc=-19)or(mc=-20) then
        goto exitmword
      end if
    end if
    '
    select case mc
    '
    case -3  : goto exitmword1 'TYPE OR CLASS
    case -4  : varf=8 : goto exitmword1                 'UNPROTOTYPED PROCEDURES
    case -5  : varf=8 : goto exitmword1                 'LABELED OR VECTORED PROCEDURES
    case -8  : goto exitmword1                          'DEF TYPE
    case -9  : goto exitmword1                          'COMMON RESERVED WORDS
    case -10 : typ=maco(mp,5) : lent=maco(mp,1) : sog=macso(mp,3) : goto exitmword 'REGISTERS
    case -11 : wk=attributes(s,i) : goto insertw        'ATTRIBUTES
   'case -12                                            'NAMESPACE RECORD, NOT ACCESSIBLE
    case -13 : goto exitmword1                          'O2 PRIMARY KEYWORD
    case -14 : goto exitmword1                          'O2H PRIMARY KEYWORD
    case -15 : ctype(s,i,wr) : goto exitmword           'C TYPES
    case -16 : varf=8 : goto exitmword1                 'O2H CORE FUNCTIONS VECTORED
    case -17 : goto exitmword1                          'FPU ASM MACRO
    case -18 : wk=macrep(mp,s,i) : mc=0 : goto insertw  'LOW LEVEL MACRO
    case -19 : wr=macso(mp,1) : tmnt=1 : goto exitmword 'SYSTEM TERMINATION MACRO
    case -20 :                                          'HIGH LEVEL MACRO
               wk=himac(mp,s,i)
               if ert then exit function
               if ascn=46 then inserts(s,wk,i) : goto rmword
               goto insertw
    case -21 : goto exitmword  'CODE MACRO
    case -30 : goto exitmword2 'LABEL RECORD
   'case -31 :                 'NUMBER LITERAL ALREADY PROCESSED
   'case -32 :                 'STRING LITERAL ALREADY PROCESSED
    case -33 : goto exitmword  'ENUMERATION
   '
    end select
    '=========
    '
    '
    'CORRUPTION CHECK
    '
    ers="unclassified Word " : ert=123
    '
    insertw:
    '=======
    '
    if len(wk) then
      inserts(s,wk+" ",i)
    end if
    goto rmword
    '
    exitmword:
    '=========
    '
    ascw=asc(wr) : lenw=len(wr)
    '
    exitmword1:
    '==========
    '
    return wr
    '
    exitmword2:
    '==========
    ascw=asc(wr) ': lenw=len(wr)
    return wr
    '
end function




'
'  ###################
'  #    NUMBERS      #        #       #  #  #    ###          ###    ##    #
'  #    STRINGS      #         ##      #####     #              #    # #   #
'  #    ADDRESES     # ############  ## PFX ##   # REG + OFFSET #    #  #  #
'  #    POINTERS     #         ##      #####     #              #    #   # #
'  #    VARIABLES    #        #       #  #  #    ###          ###    #    ##
'  ###################



'----------------------------------------------------------
function pword(byref s as string, byref i as sys) as string
'==========================================================
  '
  'RESOLVES POINTERS / ADDRESSES, CASTING ETC
  '
  dim as sys a,b,c,d,e,k,m,n,v,ty,tyc,gg,adra,da, tm
  dim as string wr,ws,wt
  '
  ind=0 : nan=1 : wpfx="" : ou="" : typk=0
  '
  '
  '============================
  'RECURSION POINT
  ' (FOLLOWING MACRO EXPANSION)
  '============================
  '
  '-----------
  'INDIRECTION * **********
  'and CASTING
  '===========
  '
  b=0 'POINTER '*' COUNTER
  '
  do
    wr=mword(s,i)
    '
    if (dtf<>0)and(funi<>0) then
      'DISCOVER STRING MEMBERS BEING USED IN A FUNCTION
      if isstr(typ) then lcls=1 'ENSURE STRING BUFFERS ARE MADE AVAILABLE
    end if
    if (nan=0)or(qot=1) then
      goto xpword 'literal numbers and quotes
    end if
    '
    if isc(ascw) then goto xpword
    '
    if ert then wr=ow : exit function
    '
    if mc=-14 then
      select case ascw
      case &h74 : if wr="that" then nth=1 : continue do
      case &h69 : if wr="indexbase" then wr=str(ixb) : nan=0 : ascw=asc(wr) : goto xpword
      end select
    end if

    '
    'WORDS STARTING WITH DOT
    '-----------------------
    '
    if dtf=1 then
      if lenw=1 then ers="isolated dot" :ert=502
      goto xpword
    end if
    '
    'CASTING EG: (HANDLE) (void *) H
    '===============================
    '
    if ascw=&h62 then
      if wr="byval" then bvg=1 : ty=cpuw : continue do
    end if
    '
    'DETECT EXPLICIT CASTING
    '-----------------------
    '
    c=0 : d=0 : m=swd
    if ascw=99 then
      if wr="cast" then
        d=4
        if ascn=lbr then ascw=ascn : i+=1 : d=1
      end if
    elseif ascw=lbr then
      d=1
    end if
    '
    'INTERPRET CASTING 
    '-----------------
    '
    ' a = (long) b
    ' a = cast long b
    ' a = cast (long) b
    '
    if d then
      ws=wordahead(s,i)
      if ws="typeof" then
        i=nwd
        ws=mword(s,i)
        c=typ
        nwd=i
      else
        c=identype(ws)
      end if
      if d>1 then
        if c then
          i=nwd
          skiplspace(s,i)
        else
          ert=301 : ers="Unidentified cast "+ws
        end if
      else
        if c=0 then
          'NOT A TYPE CAST
          if wr="cast" then
            ert=301 : ers="Unidentified cast "+ws
          else
            ascw=lbr
            lenw=1         
          end if
          exit do
        end if
        a=i
        i=nwd
        'if isptr(s,i) then c=cpuw
        b+=isptr(s,i)
        if ascn=rbr then
          i+=1
          skiplspace(s,i) '(DOUBLE*) END BRACKET
        else
          'NOT A TYPE CAST
          i=a
          skiplspace(s,i)
          ascw=lbr
          lenw=1         
          exit do
        end if
      end if
      '
      'CAST IDENTIFIED?
      '
      if c then
        tyc=c : tm=typm : typm=c
        b+=indt 'TYPE INDIRECTION
        continue do 'NEXT WORD OR CAST EXPRESSION
      end if
    end if
    '
    'INDIRECTION SYMBOLS * ? &
    '-------------------------
    '
    if ascw=63 then ty=cpuw : ou+=wr : continue do '?'
    if ascw<>42 then exit do           '*'
    if ascn=61 then exit do            '*='
    '
    b+=1 : ou+=wr : 'TALLY '*' INDIRECTION
    '
    '
  loop
  '
  'itr function returning pointers.
  '
  if varf>=8 then
    if varf>8 then mc=-5
    if tyc then ou="" : b=0 'suppress cast ptrs: cast char * fn
  end if
  '
  'INDIRECTION ENCODING
  '--------------------
  '
  if b=0 then
    if (cpoint>0)and(ascw=91) then
      a=maco(mp,3)
      if a>0 then 'POINTER VARIABLE
        if wpfx="" then ty=cpuw 'TREAT AS POINTER (EXCEPT ARRAY)
      end if
    end if
  else 'b>0' POINTERING
    '
    if ascw=91 then
      '
      if mp then
        if ascn=91 then fixsqbr(s,i) '[..] to (..)
      end if
      '
      'prefix wpfx updated
      '
      if (cpoint=0)or(wpfx="") then
        if cpoint then ind=0
        indiri(wr,b)
        ind+=b
        wr=pedi
        lenw=5
      end if
      '
      if cpoint then
        if ind<>maco(mp,3) then ty=cpuw
      else
        ty=cpuw ' TYPE OVERRIDE
      end if
      '
    elseif ascw=lbr then '*(A+B) ETC
      ind+=b
      ty=cpuw
    end if
    '
    if typ=0 then  '*(A+B) ETC
      indiri(cpua,b)
      if ascw=lbr then
        wt=wpfx
        a=cpuw
        c=op
        op=1
        nst+=1
        wpfx=enc("op 4 F ")+express(s,i,a)+wt+enc("op 6 F ")
        if (ascn=rbr)or(ascn=93) then
          i+=1 : skiplspace(s,i)
          nst-=1
        end if
        typ=cpuw
        nan=1
        op=c
        wr=pedi
        ascw=91
        lenw=5
        goto xpword
      end if
    end if
  end if
  '
  '
  '
  '
  '================
  'ADDRESSES & or @
  '================
  '
  if (ascw=38)or(ascw=64) then
    '
    if ascw=64 then i=swd+1 : skiplspace(s,i)
    '
    ou+=wr ' capture indirection
    '
    'ADDRESS OF STRING LITERAL
    '-------------------------
    '
    if ascn=38 or ascn=64 then da=1 : i+=1 'double address && or @@
    '
    '
    'ADDRESS OF ARRAY ELEMENT
    '------------------------
    '
    ws=ou
    wr=pword(s,i) 'RECURSE
    ou=ws+ou
    '
    'ADDRESS OF LITERAL NUMBER (PLACE IN TEMP VAR)
    '
    if mc=-31 then
      wpfx="" : a=0 : b=typ
      if (op>1)and(b=cpuw) then wpfx=operi(4,b,"") : a=1
      ws=tmpvar()
      wpfx+=operi(1,b,wr)+operi(2,b,ws)+leaedi(ws)
      wr=qedi : typ=cpuw : mc=0 : nan=1
      if a then wpfx+=operi(6,b,"")
      goto xpwordx
    end if
    '
    typ=cpuw
    '
    if isq(ascw) then wpfx=enc("qu "+wr) : wr=cpua : ty=cpuw : goto xpword 'address of string data
    if asc(wpfx)=&h6f then ty=cpuw : goto xpword 'address of const o2 ....
    '
    '
    '
    'RENDER PROCS AS PLAIN VARIABLES
    '-------------------------------
    '
    '
    if (ascw=91)or(mc=-3)or(mc=-4)or(mc=-5)or(ascw=38) then
      '
      if varf=8 then
        '
        if ascw<>91 then
          a=ascn
          nextproc(macso(mp,1),1,wr,b) 'itr function overloading / match signatures
          if b then
            wr=addlproc(b,wr)
          end if
          ascw=asc(wr) : ascn=a
        end if
        mc=0
        varf=1
        typ=cpuw
        if ascw<>91 then
           typ=cpuw
         'NO VECTOR?
          if ascn=61 then
            ert=300
            ers="Must refer to a proc pointer: "+wr
          else
            goto addrlab 'ASSUME TO BE A LABELLED FUNCTION
          end if
        end if
        '
        goto xpwordx
        '
      elseif varf>8 then
        '
        'ITR not for com  like methods with remote VA
        '
        'ADDRESS OF (NON DLL) VIRTUAL FUNCTION
        '
        'CHECK FOR PRESENCE OF METHODS TABLE
        '
        a=0
        if maco(mp,0)=-3 then
         if maco(mp,2) then a=1 'IS A CLASS RATHER THAN AN OBJECT
        elseif mc>0 then
          if maco(maco(mp,0)-htyp,2) then a=1 'OTHERWISE CHECK THE CLASS OF THE OBJECT
        end if
        '
        if a=1 then
          '
          'ACCESS FUNCTION TABLE DIRECTLY
          '
          wr=memreg(regst,toff+woff)
          if da then
            wpfx=leaedi(wr)
            wr=qedi
          end if
          '
        else
          '
          'METHODS TABLE NOT DEFINED SO ASSUME
          'EXTERNAL WITH VIRTUAL TABLE POINTER
          '
          indiri(wr,1)
          ind+=1
          wr=memreg(qedi,woff)
        end if
        mc=0 : dtf=0
        varf=1 : goto xpwordx
      end if 'PROCEDURES
      '
      '
      'ADDRESS OF VARIABLE [ebx+/-offset] etc
      '--------------------------------------
      '
      varadr(wr,da)
      '
      if da then 
        ers="Invalid @@ address" : ert=7 : goto xpword
      end if
      '
      goto xpwordx
      '
    end if '[..] OPERANDS
    '
    addrlab:
    '=======
    '
    typ=cpuw
    varf=1
    pls="0"
    if (mc-4)or(mc=-5) then
      ws=macso(mp,1) 'FUNCTION RECORDS
      mc=0
      a=1
      nextproc(ws,a,wt,0) 'itr overload matching?
      typ=cpuw
      varf=1
      sig=""
      sog=""
      skiplspace(s,i)
      if a then
        wr=wt
        if isa(asc(wt))=0 then
          goto xpwordx
        end if
      end if
    end if
    wpfx=enc("ab "+pls+" "+wr+" "+hexci(nsi)+" "+hexci(nsp))
    wr=qedi
    goto xpwordx
    '
  end if 'LABELS
  '
  '
  '
  xpword:
  '======
  '
  if tyc then ty=tyc : typm=tm : sog=ws
  if ty then typ=ty : typk=ty 'typk cast type
  if len(ou) then owa=ou+owa
  return wr 
  '
  xpwordx:
  '======
  ascw=asc(wr)
  lenw=len(wr)
  goto xpword

end function


'-------------------------------------------------------------
function lexiword(byref s as string, byref i as sys) as string
'=============================================================
  dim as string wr
  dim as sys a
  wr=iword(s,i)
  ''MACRO SUPPORT
  if isq(asc(wr))=0 then
    if instrchars(wr,"$:/\.<>")=0 then
      'a=lookupm(wr)
      'if a then
      '  a=maco(a,0)
      '  if (a=18)or(a=20) then
      wr=pword(wr,1) 'CHECK FOR MACRO
      '  end if
      'end if
    end if
  end if
  wr=noquotes(wr)
  ascw=asc(wr)
  lenw=len(wr)
  skiplspace(s,i)
  return wr
end function




'---------------------------------------------------------------------------------
sub erasek(byref w1 as string, byref w2 as string, byval b as sys, byval c as sys)
'=================================================================================
  '
  'ERASE KEYWORD IN A STRING AND C WORDS FOLLOWING
  '
  dim as sys f,m
  dim as string w3
  '
  f=instr(b,w1,w2) : if f=0 then exit sub
  m=f : f+=len(w2)
  do
    c-=1 : if c<0 then exit do
    w3=mword(w1,f)
  loop
  mid(w1,m)=space(f-m) 'erase section
end sub



'---------------------------------------------------------------------------
function cbrencah(byref s as string, byref i as long, byval c as sys) as sys
'===========================================================================
  dim as long a,b
  a=i : b=ascn
  nextinstruct(s,i)
  if ascn=123 then
    if cbri>63 then ert=101 : ers="Too many '{' " : exit function
    cbrk(cbri)=c : cbri+=1 : i+=1 : skiplspace(s,i)
    return 1
  else
    i=a : ascn=b
  end if
end function


'----------------------------------------
function rootpath(wr as string) as string
'========================================
  if asc(wr)<>36 then
    return wr 'exclude when no '$' prefix
  end if
  dim    as sys a,b,e,j
  static as ubyte ptr p,q,r
  static as string buf,co
  '
  if co="" then 'GET MODULE FILE PATH
    buf=string(256,chr(0))
    'p=GetCommandLine
    p=strptr(buf)
    GetModuleFileName(0,buf,256)
    if *p=34 then
      a=34
      p+=1
    else
      a=32
    end if
    q=p
    do
      if (*q=a)or(*q=0) then exit do
      q+=1
    loop
    e=q-p
    q=p
    r=p
    co=space(e)
    for j=1 to e
      if (*q=47)or(*q=92) then r=q
      mid(co,j)=chr(*q)
      q+=1
    next
    co=left(co,r-p)
  end if
  j=2
  a=asc(wr,2)
  if (a=47)or(a=92) then j+=1 else a=47
  if r=p then
    return mid(wr,j)
  else
    return co+chr(a)+mid(wr,j)
  end if
end function


'----------------------------------------------------------------
sub paths(byref s as string, byref i as sys, byref pth as string)
'================================================================
  dim as sys b
  dim as string wr
  if ascn=43 then
    b=1 : i+=1
  elseif ascn=45 then
    b=2 : i+=1
  end if
  wr=lexiword(s,i)
  '
  if b=1 then
    pth+=wr
  elseif b=2 then
    b=len(pth)-len(wr)
    if b>=0 then pth=left(pth,b)
  else
    pth=rootpath(wr)
  end if
end sub


'---------------------------------------------
function filename(byref s as string) as string
'=============================================
  'strip file path from file name
  dim as sys a,b
  do
    a=b+1
    b=instr(a,s,":") : if b then continue do
    b=instr(a,s,"\") : if b then continue do
    b=instr(a,s,"/") : if b then continue do
    exit do
  loop
  function=mid(s,a)
end function


'-------------------------------------------------
function issub(s as string, byref i as sys) as sys
'=================================================
  dim as long a
  dim as string w1
  w1=wordahead(s,i) : a=asc(s,nwd)
  if asc(w1)=91 then
    function=0 'SUB [] ...
  elseif a=lbr then
    function=-1 'SUB XXX(
  elseif a=44 then
    function=0 'SUB XXX,
    w1=wordahead(s,nwd) : a=asc(s,nwd) ',..MULTILINE SUB
    if ise(a) then function=-1 'SUB A, endline
  elseif instrword(" byte word dword qword eword ptr float ",w1) then
    function=0 'SUB WORD ...
  else
    function=-1
  end if
end function


'-------------------------------------------------------------------
function expandm(byref s as string, byref i as sys, a as sys) as sys
'===================================================================
  dim as sys c,d,f
  dim as string w1
  d=swd
  nwd=i
  if a=0 then 
    w1=wordahead(s,i)
    a=lookupm(w1)
  end if
  if a then
    c=maco(a,0)
    '
    'MACRO EXPANSION 'itr one level only
    '
    if (c=-18)or(c=-20) then
      f=nwd
      if c=-18 then w1=macres(a,s,f) else w1=himac(a,s,f)
      s=left(s,d-1)+w1+mid(s,f) 'SUPPORTS MACRO PARAMETERS
      i=d : function=1
    end if
  end if
end function


#if 0
'------------------------------
sub extincli(byref s as string)
'==============================
  dim as sys a=0,b=1,c=0,i=1,j=0
  dim as string wr
  do
    wr=yword(s,i)
    if lenw=0 then exit do
    b=swd : clcase(wr)
    if wr="incl" then
      wr=yword(s,i) : clcase(wr)
      a=lookupm(wr)
      if a then
        c+=1
        if c>200 then
          ers="Suspect recursive inclusions "
          ow=wr : ert=99
          exit do
        end if
        wr=macso(a,1)
      else
        wr=""
      end if
      s=left(s,b-1)+wr+mid(s,i)
    end if
  loop
end sub
#endif
