
'O2LEXI



'========
'IS WHAT?
'========



'QUOTEMARK

'----------------------------------
function isq(byval a as sys) as sys
'==================================
select case a
case iq1 : function=-1
case iq2 : function=-1
case iq3 : function=-1
case iq4 : function=-1
end select
end function


'COMMENT

'----------------------------------
function isc(byval a as sys) as sys
'==================================
select case a
case ct1 : function=-1
case ct2 : function=-1
end select
end function


'END OF LINE OR COMMENT

'----------------------------------
function ise(byval a as sys) as sys
'==================================
select case a
case 13  : function=-1
case 10  : function=-1
case ct1 : function=-1
case ct2 : function=-1
case 0   : function=-1 ' 
end select
end function


'END OF STATEMENT

'----------------------------------
function iss(byval a as sys) as sys
'==================================
select case a
case 13  : function=-1
case 10  : function=-1
case ct1 : function=-1
case ct2 : function=-1
case sr1 : function=-1
case sr2 : function=-1
case 0   : function=-1 ' 
end select
end function


'END OF EXPRESSION


'----------------------------------
function isx(byval a as sys) as sys
'==================================
select case a
case  13 : function=-1
case  10 : function=-1
case  44 : function=-1 ' ,
case  41 : function=-1 ' )
case  93 : function=-1 ' ]
case 125 : function=-1 ' }
case sr1 : function=-1 ' :
case sr2 : function=-1 ' : or ;
case ct1 : function=-1 ' '
case ct2 : function=-1 ' ;
case   0 : function=-1 ' 
end select
end function


'-----------------------------------
function nisx(byval a as sys) as sys
'===================================
function=not(isx(a))
end function


'---------------------
function isxn() as sys
'=====================
function=isx(ascn)
end function


'---------------------
function nisxn() as sys
'=====================
function=nisx(ascn)
end function


'COMPARATORS

'----------------------------------
function isi(byval a as sys) as sys
'==================================
select case a
case  60 to 62 : function=-1
end select
end function


'LEFT BRACKETS ([{ 'return asc right bracket )]}
  
'----------------------------------
function isb(byval a as sys) as sys
'==================================
select case a
case  40 : function=41
case  91 : function=93
case 123 : function=125
end select
end function



'NOT A SYMBOL ('_'  counted in)

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

'POSSIBLY A NUMBER

'----------------------------------
function isn(byval a as sys) as sys
'==================================
select case a
case &h30 to &h39 : function=-1
case 45 to 46 : function=1
end select
end function


'ALPHA (including all ascii above 126)
  
'----------------------------------
function isa(byval a as sys) as sys
'==================================
select case a
case  &h41 to &h5a : function=-3  'A..Z
case  &h61 to &h7a : function=-5  'a..z
case  &h7f to &hf7 : function=-7  'upper ascii symbols
case            95 : function=-9  '_
case            35 : function=-11 '#
end select
end function


'ALPHANUMERIC ('#' ans '_'  counted in)

'----------------------------------
function isw(byval a as sys) as sys
'==================================
select case a
case  &h30 to &h39 : function=-1  '0..9
case  &h41 to &h5a : function=-3  'A..Z
case  &h61 to &h7a : function=-5  'a..z
case  &h7f to &hf7 : function=-7  'upper ascii symbols
case            46 : function=1   '.
case            95 : function=-9  '_
case            35 : function=-11 '#
end select
end function


'=============
'TYPE CATEGORY
'=============

'ASSUME SYS BYVAL

'--------------------------------
function iscpu(a as sys) as sys
'================================
select case a
case &h0 to &h3f : function=-1
end select
end function

'------------------------------
function isfpu(a as sys) as sys
'==============================
select case a
case &h40 to &h7f : function=-1
end select
end function

'------------------------------
function isfloat(a as sys) as sys
'==============================
select case a
case &h60 to &h7f : function=-1
end select
end function

'------------------------------
function isstr(a as sys) as sys
'==============================
select case a
case &ha0 to &hff : function=-1
end select
end function


'------------------------------
function isdstr(a as sys) as sys
'==============================
select case a
case &hc0 to &hff : function=-1
end select
end function


'------------------------------
function iszstr(a as sys) as sys
'==============================
select case a
case &ha0 to &hbf : function=-1
end select
end function


'------------------------------
function isbstr(a as sys) as sys
'==============================
select case a
case &hc0 to &hdf : function=-1
end select
end function


'------------------------------
function isostr(a as sys) as sys
'==============================
select case a
case &he0 to &hff : function=-1
end select
end function


'------------------------------------------------------------------------------
function instrevn(byval i as sys, byref s as string, byref wr as string) as sys
'==============================================================================
  dim as sys a,k,le
  '
  if i<0 then i=len(s)+1 '-1 indicates start from right
  if i<=1 then exit function
  le=len(wr)
  if le=0 then exit function
  k=asc(wr)
  '
  do
    i-=1
    if i<1 then exit do
    a=asc(s,i)
    if a=k then
      if wr=mid(s,i,le) then exit do
    end if
  loop
  '
  function=i
  '
end function




'----------------------------
sub encrlf(byref s as string)
'============================
dim as sys a=asc(s,len(s))
if (a<>13)and(a<>10) then s+=cr
end sub


'------------------------------------
function asclc(byval a as sys) as sys
'====================================
select case a
case  &h41 to &h5a : a+=32
end select
function=a
end function




'------------------------------------------------------
function ascl(byref s as string, byref i as sys) as sys
'======================================================
  '
  function=asclc(asc(s,i))
  '
end function


'-----------------------------------------
sub nextspace(s as string, byref i as sys)
'=========================================
  do
    select case asc(s,i)
    case 0 to 32 : exit sub
    end select
    i+=1
  loop
end sub


'-----------------------------------------
sub skipspace(s as string, byref i as sys)
'=========================================
  do
    ascn=asc(s,i)
    select case ascn
    case 0 : exit do
    case 65 to 90 : ascn+=32 : exit do 'force lowercase
    case 33 to 255 : exit do
    end select
    i+=1
  loop
  nwd=i
end sub


'------------------------------------------
sub skiplspace(s as string, byref i as sys)
'==========================================
  do
    ascn=asc(s,i)
    select case ascn
    case  0 : exit do
    case 10 : exit do
    case 13 : exit do
    case 65 to 90 : ascn+=32 : exit do 'force lowercase
    case 33 to 255 : exit do
    end select
    i+=1
  loop
  nwd=i
end sub


'---------------------------------------
sub endline(s as string, byref i as sys)
'=======================================
  do
    ascn=asc(s,i)
    select case ascn
    case  0 : exit do
    case 10 : exit do
    case 13 : exit do
    end select
    i+=1
  loop
  nwd=i
end sub


'-----------------------------------------------
sub skipquote(byref s as string, byref i as sys)
'===============================================
  dim as sys a,b
  'skip quoted expression
  b=asc(s,i)
  do
    i+=1
    a=asc(s,i)
    select case a
    case 0  : exit sub
    case b  : exit do
    end select
  loop
  i+=1
end sub


'----------------------------------------------------------------
sub skipquotec(byref s as string, byref i as sys, byref c as sys)
'================================================================
  dim as sys a,b
  'skip quoted expression and count cr
  b=asc(s,i)
  do
    i+=1
    a=asc(s,i)
    select case a
    case 0  : exit do
    case b  : exit do
    case 13 : c+=1
    end select
  loop
  i+=1
end sub


'-----------------------------
sub clcase(byref wr as string)
'=============================
  '
  '0 CASE INSENSITIVE
  '1 CASE INSENSITIVE
  '2 CASE SENSITIVE
  '3 CAPITALISED WORD SENSITIVE
  '
  dim as sys b,c,i
  select case casf
  case 0 to 1 : c=1
  case 3
    do
      i+=1
      select case asc(wr,i)
        case 0  : exit do
        case &h61 to &h7a : c=1 : exit do 'a to z :
      end select
    loop
  end select
  if c then
    wr=lcase(wr)
  end if
end sub


'---------------------------------------------------------
function ccomment(byref s as string,byref i as sys) as sys
'=========================================================
  dim as sys b,c
  b=asc(s,i+1)
  if b=47 then
    c=i
    endline(s,i) : function=1
  elseif b=42 then
    c=instr(i+2,s,"*/") : if c then i=c+2 : function=2
  else
    exit function
  end if
  skiplspace(s,i)
end function


'--------------------------------------------------
sub nextinstruct(byref s as string, byref i as sys)
'==================================================
  '
  'SKIP COMMENTS AND BLANK LINES
  'NOTE LAST LINE NUMBER
  '
  dim as sys a,b,c
  do
    skipspace(s,i)
    if ascn=0 then exit do
    if ascn=95 then
      if asc(s,i+1)<33 then i+=1 :continue do 'SKIP _ 
    end if
    if ise(ascn) then
      if ascn=39 then 'comment mark
        a=asc(s,i+1)
        if a=lnm then
          b=i+2 : endline(s,i) : c=i
          continue do
        end if
      end if
      endline(s,i)
      continue do
    end if
    '---' '==='
    if (ascn=45)or(ascn=61) then
      if (asc(s,i+1)=ascn)and(asc(s,i+2)=ascn) then
        endline(s,i) : c=i
        continue do
      end if
    end if
    exit do 'higher ascii is ignored
  loop
  'if c then lnmks=mid(s,b,c-b) 'itr lookaheads may need to keep original line number
end sub


'-------------------------------------------------------
function countcr(s as string, b as sys, e as sys) as sys
'=======================================================
dim as sys k,a=1,c=0
a=b
do
  if a>=e then exit do
  k=asc(s,a)
  select case k
  case 13 : c+=1 : if asc(s,a+1)=10 then a+=1
  case 10 : c+=1
  end select
  a+=1
loop
return c
end function


'----------------------------------------------------------
function tline(byref s as string, byref i as sys) as string
'==========================================================
  '
  dim as sys b=i
  endline(s,i)
  '
  function=mid(s,b,i-b)
  '
end function


'-----------------------------------------------
sub lineblank(byref s as string, byref i as sys)
'===============================================
  '
  'BLANK OUT REST OF LINE WITH SPACES
  '
  dim as sys b,l
  b=i
  while asc(s,i)>13
    i+=1
  wend
  l=i-b
  if l then mid(s,b)=space(l)
end sub


'-----------------------------------------------------------
function repeat(byref w as string, byval n as sys) as string
'===========================================================
  '
  dim as string s
  dim as sys i,e,lw
  lw=len(w) : e=lw*n
  s=string(e,chr(0))
  i=1
  do
    if i>e then exit do
    mid(s,i)=w : i+=lw
  loop
  '
  function=s
  '
end function


'----------------------------------------------------------------------------
sub inserts(byref s as string, byref ws as string, byref i as sys) ' reinsert
'============================================================================
  '
  'NORMAL INSERTION
  '
  'if pres then
  '  s=left(s,i-1)+ws+mid(s,i) : exit sub
  'end if
  '
  'DESTRUCTIVE INSERTION
  '
  leni=len(ws) : ascn=ascl(ws,1)
  if i>len(s) then i=len(s)+1
  '
  'PATCH STRING INTO USED BUFFER SPACE
  '
  if i>leni then inpi=i : i-=leni : mid(s,i)=ws : exit sub
  '
  'OR CHOP BUFFER AND APPEND STRING
  '
  s=ws+mid(s,i) : i=1 : inpi=len(ws)+1
  '
end sub


'---------------------------------------------------------------
sub insertparam(byref s as string, wr as string, byref i as sys)
'===============================================================
  skiplspace(s,i)
  if ascn=lbr then
    i+=1 : skiplspace(s,i)
    if ascn<>rbr then wr+=cm
    inserts(s,"("+wr,i) 'INSERT (PARAM,
  else
    if nisxn then wr+=cm
    inserts(s,wr,i) 'INSERT PARAM,
  end if
end sub


'CAPTURE BRACKETED SOURCE CODE OR GENERAL TEXT

'-----------------------------------------
sub captb(byval s as string,byref i as sys)
'==========================================
dim as sys a,v,sb,eb
sb=ascn : eb=isb(sb)
do
  a=asc(s,i)
  if a=0 then exit do
  if a=sb then
    v+=1
  elseif a=eb then
    v-=1
    if v<=0 then i+=1 : exit do
  end if
  i+=1 
loop
end sub


'----------------------------------------------
function noquotes(byref wr as string) as string
'==============================================
  '
  dim as sys a,b,c
  a=asc(wr) : b=1 : c=len(wr)
  if isq(a) then b+=1 : c-=2
  '
  return mid(wr,b,c)
  '
end function


'---------------------------------------------------
function instrchars(s as string, u as string) as sys
'===================================================
dim as sys lu=len(u),a,i
for i=1 to lu
  a=instr(s,mid(u,i,1)) : if a then return a
next
end function


'----------------------------------------------------------
function yword(byref s as string, byref i as sys) as string
'==========================================================
  skipspace(s,i)
  swd=i
  do
    ascn=asc(s,i)
    select case ascn
    case 0 to 32 : exit do
    case 34 : i=instr(i+1,s,chr(ascn)) : if i=0 then i=len(s)
    end select
    i+=1
  loop
  lenw=i-swd
  skiplspace(s,i)
  if lenw>0 then function=mid(s,swd,lenw)
end function


'----------------------------------------------------------
function iword(byref s as string, byref i as sys) as string
'==========================================================
  skipspace(s,i)
  swd=i
  if ascn=91 then
    i=instr(i+1,s,"]")
    if i=0 then i=len(s)
    i+=1
  elseif isq(ascn) then
    i=instr(i+1,s,chr(ascn))
    'if i=0 then i=len(s)
    i+=1
  else
    select case asc(s,i)
    case 33 to 255 : nextspace(s,i)
    end select
  end if
  lenw=i-swd
  if lenw>0 then function=mid(s,swd,lenw)
end function


'----------------------------------------------------------
function uword(byref s as string, byref i as sys) as string
'==========================================================
  skipspace(s,i)
  swd=i
  do
    select case asc(s,i)
    case 0 to 32 : exit do
    case  34     : i=instr(i+1,s,chr(ascn)) : if i=0 then i=len(s)
    case  39     : exit do ''
    case  59     : exit do ';
    case  44     : exit do ',
    case  40     : exit do '(
    case  41     : exit do ')
    case 123     : exit do '{
    case 125     : exit do '}
    end select
    i+=1
  loop
  lenw=i-swd
  skiplspace(s,i)
  if lenw>0 then function=mid(s,swd,lenw)
end function


'----------------------------------------------------------
function wword(byref s as string, byref i as sys) as string
'==========================================================
  dim as string wr
  wr=uword(s,i) : clcase(wr) : ascw=asc(wr) : skiplspace(s,i)
  function=wr
end function


'-----------------------------
sub FixCrLF(byref s as string)
'=============================
dim as string d
dim as sys b,i,l,e,le
d=space(len(s)*2+2)
i=1
e=1
le=len(s)
while i<=len(s)
  b=i
  endline(s,i)
  l=i-b
  select case ascn
  case 0  :
    'REPLACE EMBEDDED NULL CHARS 
    if i<=le then
      mid(s,i)=" " : i=b
      continue while
    end if
  case 10 : i+=1
  case 13 : i+=1 : if asc(s,i)=10 then i+=1
  end select
  mid(d,e)=mid(s,b,l)+cr : e=e+l+2
wend
s=left(d,e-1) 'ALWAYS ENDS WITH CR (EXCEPT FOR EMPTY S)
end sub


'----------------------------------
sub striplineno(byref wr as string)
'==================================
  dim as sys a=1,b
  dim as string ke=chr(39)+chr(lnm)
  '
  'STRIP LINE NUMBERS FROM WITHIN BLOCKS, STRINGS ETC
  '
  do
    a=instr(a,wr,ke)
    if a then
      b=instr(a,wr,cr)
      if b=0 then b=len(wr)
      wr=left(wr,a-1)+mid(wr,b+2)
    else
      exit do
    end if
  loop
end sub



'   #######################
'  #########################
'  ###                   ###
'  ###                   ###
'  ###                   ###
'  ###                   ###
'  ###                   ### 
'  #########################
'   #######################
'
'--------------------------------------------------------
function wrd(byref s as string, byref i as sys) as string
'========================================================
  dim as string wr
  dim as sys a,b,c,d
  skipspace(s,i)
  swd=i
  dtf=0
  ascy=0
  qot=0
  nmb=0
  ascw=asc(s,i)
  if i>len(s) then goto exitw
  '
  i+=1
  a=isw(ascw)
  if a>=0 then 'NOT A WORD, COULD BE DOT
    select case ascw
    case 46 '.'
      dtf=1
      a=asc(s,i)
      if (a>=48)and(a<=57) then 'NUMBERS
        nmb=3 : i+=1
        goto morechars
      else
        i-=1
        goto morechars
      end if
    case 45 '->'
      a=asc(s,i)
      if a=62 then
        i-=1
        goto morechars
      elseif (a>=48)and(a<=57) then 'NUMBERS FOLLOW
        nmb=5
      elseif a=46 then
        a=asc(s,i+1)
        if (a>=48)and(a<=57) then '.NUMBERS FOLLOW
          nmb=7
        end if
      end if
    case 38 '&
      a=asc(s,i)
      b=isa(a)
      if b then
        if b=-3 then a+=32 'convert capitals to lower case
        select case a
        case &h68 : b=16 : c=&h78 'hexadecimal setl
        case &h6f : b=8  : c=&h6f 'octal set
        case &h62 : b=2  : c=&h62 'binary set
        case else : goto exitw
        end select
        do 'FIND BOUNDARY
          i+=1 : d=ascl(s,i)
          a=instr("0123456789abcdef",chr(d))
          if (a=0)or(a>b) then
            if (i>swd+2)and((d<48)or(isx(d))) then
              mid(s,swd)="0"+chr(c) : ascw=48
              nmb=9
            else
              i=swd+1 '&' address symbol
            end if
            ascy=asc(s,i)
            goto exitw
          end if
        loop
      else
        goto exitw
      end if
    case iq1 : a=-1
    case iq2 : a=-1
    case iq3 : a=-1
    case iq4 : a=-1
    end select
    '
    if a=-1 then 'QUOTED TEXT
      a=instr(i,s,chr(ascw))
      if a then
        i=a : qot=1
      else
        ers="Unclosed quote" : ert=502
      end if
      i+=1
    end if
    goto exitw 'NOT ALPHANUMERIC
  elseif a=-1 then
    nmb=1 'IS A NUMBER
  end if
  '
  morechars:
  '
  do
    a=asc(s,i)
    select case a
    case 46 '.'
      if dtf=0 then dtf=i-swd+1
      a=asc(s,i+1)
      if a=62 then
        i+=1 '.>' ARROW DERIV
        goto exitw
      elseif (a>=48)and(a<=57) then
        if dtf=1 then nmb=1
      elseif a=34 then 'SUPPORT QUOTED DOT NAME ."+"
        a=instr(i+2,s,chr(34))
        if a then
          i=a+1
        else
          ers="Unclosed quote" : ert=502
        end if
        goto exitw
      end if
      i+=1 : continue do
    case 45 '-'
      if asc(s,i+1)=62 then '->' ARROW
        if dtf=0 then dtf=i-swd+1
        mid(s,i)="."
        i+=2 : continue do
      end if
    case 58 ':'
      if asc(s,i+1)=58 then ':: NAMESPACE MARKER
        i+=2 : continue do
      end if
    end select
    '
    if isw(a) then
      i+=1
    else
      ascy=a 'boundary symbol
      exit do
    end if
    '
  loop
  '
  exitw:
  '
  lenw=i-swd
  skiplspace(s,i)
  if lenw>0 then
    function=mid(s,swd,lenw)
  end if
end function




'----------------------------------------------------------
function aword(byref s as string, byref i as sys) as string
'==========================================================
'FOR O2ASSM ETC / NO SUFFIX STRIPPING
dim as string wr
wr=wrd(s,i)
if qot=0 then clcase(wr) : ascw=asc(wr)
return wr
end function


'---------------------------------------------------------
function tword(byref s as string, byref i as sys) as string
'=========================================================
  '
  dim as string wr
  dim as sys a,b,c,m

  do 'FOR EACH UNFILTERED WORD
  '===========================

    wr=wrd(s,i)
    if (ascw=95)and(lenw=1) then nextinstruct(s,i) : continue do ' _
    '
    '
    'SKIP % # $ & ? ENDINGS
    '-----------------------
    '
    if (ascw>47)and(ascy>32) then
      do
        a=0
        select case ascy
        case 35 to 38 : a=1
        case 63 : a=1
        end select
        if a then
          'mid(s,i)=" "
          i+=1
          ascy=asc(s,i)
        else
          exit do
        end if
      loop
      skiplspace(s,i)
    end if
    '
    exit do
  loop
  '
  'CONVERT TO LOWERCASE (except quotes)
  if qot=0 then clcase(wr) : ascw=asc(wr)
  '
  'LINE CONTINUATIONS
  do
    '
    if ascn<>95 then
      exit do
    else
      if asc(s,i+1)>32 then exit do 'START OF ANOTHER _WORD
    end if
    '
    'SKIP UNDERSCORE, NEXT INSTRUCTION
    b=i : i+=1
    nextinstruct(s,i)
    'mid(s,b)=space(i-b)
  loop
  '
  function=wr
  '
end function


declare sub capture(byref s as string, byref m as sys, byref i as sys, byref c as sys)

'-----------------------------------------------------------
function quotex(byref s as string, byref i as sys) as string
'===========================================================
  'itr superquotes not nestable?
  dim as sys a,c,m
  dim as string wr
  nextinstruct(s,i)
  '
  'SUPPORT FOR DOUBLE PASS
  '
  if ascn=iq4 then
    function=wrd(s,i) : exit function
  elseif isb(ascn) then
    m=i+1
    captb(s,i)
    c=i-1
    goto qfillin
  endif
  '
  a=i
  nextspace(s,i)
  lenw=i-a
  wr=mid(s,a,lenw)
  m=i
  if asc(s,m)=32 then m+=1 'OMIT SPACE FOLLOWING
  c=instr(m,s,wr) 'CASE SENSITIVE
  if c then 
    i=c+lenw 'SUPERQUOTE MARKER END BOUNDARY
    if asc(s,c-1)=32 then c-=1 'OMIT SPACE BEFORE
  end if
  '
  qfillin:
  '
  if c then
    wr=iq+mid(s,m,c-m)+iq
    'striplineno(wr) 'REMOVE LINE NUMBERS
    mid(s,swd)=wr+space(i-swd-len(wr)) 'FILL THE VOID WITH SPACES
    skiplspace(s,i) : ascw=iq4
    function=wr
  end if
end function


'----------------------------------------
sub endlineq(s as string, byref i as sys)
'========================================
  dim as sys c,m
  dim as string wr
  do
    ascn=asc(s,i)
    select case ascn
    case  0   : 
    case 10   : 
    case 13   : 
    case ct1  : endline(s,i)
    case ct2  : endline(s,i)
    case iq1  : skipquote(s,i) : continue do
    case iq2  : skipquote(s,i) : continue do
    case iq3  : skipquote(s,i) : continue do
    case iq4  : skipquote(s,i) : continue do
    case else : i+=1 : continue do
    end select
    exit do
  loop
  nwd=i
end sub


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

'-------------------------------
sub clcasewds(byref s as string)
'===============================
dim as sys i=1
dim as string wr
skiplspace(s,i)
do
  if ascn=0 then exit do
  wr=wrd(s,i)
  if qot=0 then
    clcase(wr)
    mid(s,swd)=wr
  end if
loop
end sub


'--------------------------------------------------------------
function wordahead(byref s as string, byval i as sys) as string
'==============================================================
  '
  dim as sys a,b,c
  a=swd : b=ascw : c=ascn
  function=tword(s,i)
  swd=a : ascw=b : ascn=c
end function


'--------------------------------------------------------------------
sub endcatline(s as string, byref i as sys, byref c as sys, m as sys)
'====================================================================
  dim as sys b,d,de
  dim as string wr
  skiplspace(s,i)
  if ascn=35 then
    if uword(s,i)="#define" then
      de=1 'treat as C macro with possible '\' line continuation marker
    end if
  end if
  do
    ascn=asc(s,i)
    b=i
    select case ascn
    case  0        : if i>len(s) then exit do 'TOLERATE NULL CHAR
    case 13        : if d=2 then
                       d=1 : c+=1 : i+=2
                     else
                       exit do
                     end if
    case 1 to 32   : if d<>2 then d=1
    case ct1       : endline(s,i) : continue do
    case ct2       : endline(s,i) : continue do
    case sr1       : if m then  exit do
    case sr2       : if m then  exit do
    case 44        : d=2
    case 47        : if ccomment(s,i) then c+=countcr(s,b,i) : mid(s,b)=space(i-b)  : continue do
    case 92        : if de then d=2 else d=0 '\ macro line continuation
    case 95        : if d>=1 then d=2 else d=0 ' _ LINE CONTINUATION
    case iq1       : skipquotec(s,i,c) : d=1 : continue do
    case iq2       : skipquotec(s,i,c) : d=1 : continue do
    case iq3       : skipquotec(s,i,c) : d=1 : continue do
    case iq4       : skipquotec(s,i,c) : d=1 : continue do
    case &h71
      if asc(s,i-1)<=64 then
        if yword(s,i)="quote" then
          mid (s,swd)="     " 'blank out
          wr=quotex(s,i)
          c+=countcr(wr,1,len(wr)+1)+1
          continue do
        end if
      end if
      i=b : d=0
    case 33 to 255 : d=0
    end select
    i+=1
  loop
  ascn=asc(s,i)
  nwd=i
end sub



'----------------------------------------------
sub nextinstructla(s as string, byref i as sys)
'==============================================
'SKIP HIGHER ASCII CHARS
do
  nextinstruct(s,i)
  if ascn<127 then
    if ascn=35 then
      if wordahead(s,i)="#show" then
        i+=6 :continue do 'SKIP OVER #show
      end if
    end if
    exit do
  end if
  i+=1
loop
end sub





'---------------------------------------------------------------
function splitsi(byref s as string, byref r as string) as string
'===============================================================
  dim as sys d
  d=instr(s,"@")
  r=""
  if d<3 then
    '
  elseif d then
    function=left(s,d-1)
    r=mid(s,d+1)
  else
    function=s
  end if
end function



'----------------------------------------------------------------------
function mcword(byval s as string, byref i as sys, mo as sys) as string
'======================================================================
dim as sys a,l,le=len(s)
skipspace(s,i)
ascw=ascn
swd=i
dtf=0
if isq(ascw) then
  skipquote(s,i) : goto nmcword
end if
do
  a=asc(s,i)
  select case a
  case 48  to 57  : i+=1 : continue do
  case 65  to 90  : i+=1 : continue do
  case 97  to 122 : i+=1 : continue do
  case 127 to 250 : i+=1 : continue do
  case 46 : if dtf=0 then dtf=i-swd+1
            i+=1 : continue do 
  case 95 : i+=1 : continue do 
  end select
  if i=swd then i+=1 'SYMBOL
  exit do
loop
nmcword:
lenw=i-swd
l=lenw
if (mo<>0)and(dtf<>0) then l=dtf-1 'CLIP WORD
return mid(s,swd,l)
end function

declare sub ape(byref s as string,byref k as sys, byval wt as string)

'--------------------------------------------------------------------------------------
sub replacewdt(byref s as string,byval w as string, byval r as string, byval mo as sys)
'======================================================================================
  'DOTTED WORDS
  dim as sys a,b,i,lw,lr,sb
  dim as string bu,wr,w1
  lr=len(r)
  i=1
  sb=1
  do
    wr=mcword(s,i,mo) : lw=lenw
    if ascw=0 then exit do
    if wr=w then
      if (mo<>0)and(dtf<>0) then
        lw=dtf-1
        w1="##"
      else
        w1=""
      end if
      's=left(s,swd-1)+r+w1+mid(s,swd+lw)
      'i=swd+lr
      'if lenw<>lw then i=i+2+lenw-lw
      ape(bu,b,mid(s,sb,swd-sb)+r+w1) : sb=swd+lw
    end if
  loop
  ape(bu,b,mid(s,sb,len(s)+1-sb) ) 'append remainder
  s=left(bu,b)
end sub



'-------------------------------------------------------------------------------------
sub replacewd(byref s as string,byval w as string, byval r as string, byval md as sys)
'=====================================================================================
  '
  dim as sys a,b,bb,c,d,e,lw,lr,ls,sb,pp,pq
  dim as string bu
  '
  lw=len(w)
  if lw=0 then exit sub
  lr=len(r)
  sb=1
  '  
  do
    pp=0 : pq=0
    a=instr(a+1,s,w)
    if a=0 then exit do
    '
    b=0
    '
    'CHECK LEFT BOUNDARY
    if a>1 then
      b=asc(s,a-1)
      if (b=35)and(md=1) then
        if a>2 then
          c=asc(s,a-2)
          if (c=34)or(c=35) then
            'LEFT PASTER OPERATOR ##w "#w
            pp=2
            b=0
          end if
        end if
      end if
      if isw(b) then continue do 'PART OF WORD
    end if
    '
    'CHECK RIGHT BOUNDARY
    b=asc(s,a+lw)
    if (b=35)and(md=1) then
      c=asc(s,a+lw+1)
      if (c=34)or(c=35) then
        'RIGHT "# ## OPERATORS
        pq=2
        b=0
      end if
    end if
    if isw(b) then continue do 'PART OF WORD
    '
    ape(bu,bb,mid(s,sb,a-sb-pp)+r) 'SUBSTITUTION
    a+=lw+pq : sb=a
    a-=1
  loop
  ape(bu,bb,mid(s,sb,len(s)+1-sb)) 'REMAINDER
  s=left(bu,bb)
  '
end sub


'--------------------------------------------------
function hexval(s as string, byref i as sys) as sys
'==================================================
'hex value word primitive
dim as sys a,v
do
  a=asc(s,i)
  i+=1
  select case a
  case 0  to 47  : exit do
  case 48 to 57  : v=v*16+a-48
  case 65 to 70  : v=v*16+a-55
  case 97 to 102 : v=v*16+a-87
  end select
loop
return v
end function


'CONVERT TO TEXT HEX (1 LEADING SPACE)

'--------------------------------------
function hexb(byval v as sys) as string
'======================================
dim as sys a,b
dim as string s=space(3)
a=v and 15
select case a
case 0 to 9   : a+=48
case 10 to 15 : a+=55
end select
b=(v shr 4) and 15
select case b
case 0 to 9   : b+=48
case 10 to 15 : b+=55
end select
mid(s,2)=chr(b)+chr(a)
return s
end function


' CONVERT TO TEXT HEX WORD


'--------------------------------------
function hexw(byval v as sys) as string
'======================================
dim as sys a,b,c,d
dim as string s=space(6)
a=v and 15
select case a
case 0 to 9   : a+=48
case 10 to 15 : a+=55
end select
b=(v shr 4) and 15
select case b
case 0 to 9   : b+=48
case 10 to 15 : b+=55
end select
c=(v shr 8) and 15
select case c
case 0 to 9   : c+=48
case 10 to 15 : c+=55
end select
d=(v shr 12) and 15
select case d
case 0 to 9   : d+=48
case 10 to 15 : d+=55
end select
mid(s,2)=chr(b)+chr(a)+" "+chr(d)+chr(c)
return s
end function


'CONVERT TO TEXT HEX DWORD

'----------------------------------------
function hexl(byval v as ulong) as string
'========================================
return hexw(v)+hexw(v shr 16)
end function


'GET VALUE OF WORD (INCLUDING FLOATING POINT AND E NOTATION)


  '-------------------------------------------
  function pval(byval pt as any ptr) as double
  '===========================================
  '
  ascii_to_float(pt) 'in o2runt.bas
  'NO SUPPORT FOR EXTENDED FLOATS IN C
  asm
  fstp qword ptr [function] 
  end asm
  '
  end function

  '------------------------------------------
  function wval(w1 as string) as double
  '==========================================
  '
  if asc(w1)=0 then exit function
  ascii_to_float(strptr(w1)) 'in o2runt.bas
  'NO SUPPORT FOR EXT FLOATS IN C
  asm
  fstp qword ptr [function] 
  end asm
  '
  end function




'--------------------------------------------------------------
sub wordval(byref s as string, byref st as sys, byref i as sys)
'==============================================================
  '
  dim as string wd
  dim as sys sg,a,b
  dv=0
  nan=0
  skipspace(s,st)
  i=st
  '
  if ascn=45 then 'CHECK FOR NEGATIVE SIGN
    sg=1 : i+=1
    'itr spacing allowed: -  123
  end if
  '
  wd=tword(s,i)
  '
  if nmb=0 then
    dv=0 : nan=1
    if sg then
      i=swd : swd=st : ascn=ascw : ascw=45 : lenw=1
    end if
    exit sub
  end if
  '
  'E NUMBERS AND OTHER SUFFIXES
  '
  a=ascl(wd,lenw)
  select case a
  case &h65 'e
    if (ascn=45)or(ascn=43) then
      b=dtf
      if b=0 then
        if ascn=45 then b=lenw+1
      end if
      i+=1 : a=ascn : wd+=chr(a)+tword(s,i) 'EG: 42.5E+12
      dtf=b
    end if
  case &h6f 'o
  case &h68 'h
  case &h67 to &hff
    mid(wd,lenw)=" " 'REMOVE C DECORATIONS: u l etc
  end select
  '
  dv=wval(wd) 'runtime function
  swd=st
  if sg then dv=-dv
end sub


'--------------------------------------------------------------
function encodenum(byref s as string, byref i as sys) as string
'==============================================================
dim as string wr,w1,w2
dim as sys a
wr=lcase(mid(s,swd,i-swd))
w1=left(wr,2)
w2="nq"
if (w1="&h")or(w1="0x") then w2="hq"
return " "+w2+mid(wr,3)
end function


'--------------------------------------------------------------
sub wordeval(byref s as string,byref st as sys, byref i as sys)
'==============================================================
  '
  ' COMBINE SUMS OF POSITIVE & NEGATIVE LITERAL NUMBERS
  '
  dim as sys a,b,c,d,e
  dim as string w1
  dim as double vv
  b=st
  '
  'itr subsequent &h numbers not detected
  'itr no precedence
  '
  e=i
  i=st
  do
    if asc(s,b)=35 then
      w1=tword(s,b) : a=getvarptr(mid(w1,2)) : i=b : dv=a
      if a=0 then ers="e000 Cant find: "+w1 : ert=1 : exit sub
    else
      wordval(s,b,i)
    end if
    '
    if d then dv+=vv
    if (ascn=43)or(ascn=45) then
      c=ascn
      w1=wordahead(s,i)
      if isn(asc(s,nwd)) then
        b=nwd : vv=dv
        if c=45 then b=i
        d=1 : continue do
      end if
    end if
    exit do
  loop
  ascw=asc(s,st)
  if i<e then i=e
end sub

'--------------------------------------------------------------
function instrword(byref s as string, byref w as string) as sys
'==============================================================
  '
  dim as sys d,e,f
  e=len(w)
  if e=0 then return 0
  d=1
  do
    d=instr(d,s,w)
    if d=0 then
      exit do 'NOT FOUND  
    elseif d=1 then
    elseif asc(s,d-1)<33 then
    else
      d+=e
      continue do
    end if
    'terminating characters:
    d+=e
    select case asc(s,d)
    case 0 to 32 : exit do 'white space
    case 40      : exit do '(
   'case 91      : exit do '[
   'case 123     : exit do '{
    end select
  loop
  return d
  '
end function


'----------------------------------------------------------------
function isendofexpress(byref s as string, byref i as sys) as sys
'================================================================
skiplspace(s,i)
if iss(ascn) then
  if asc(s,i+1)=61 then return 0 ':='
  return -1 ' COMMENT, SEPARATOR END-OF-LINE ETC
elseif ascn=123 then '{'
  return -1
elseif ascn=125 then '}'
  return -1
elseif (ascn=&h65)or(ascn=&h73)or(ascn=&h74)or(&h77) then
  if instrword (endex,wordahead(s,i)) then
    return -1 'DO NOT SWALLOW WORD
  end if
end if
end function


'-------------------------------------------------------------
function wordfrag(byref s as string, byref i as sys) as string
'=============================================================
  '
  ' a boundary character
  ' r last char of fragment
  '
  dim as sys b,j
  '
  'SKIP SPACE AND MARKERS
  '
  do
    b=asc(s,i)
    if b=0 then exit do
    if (b>35)and(b<>64) then exit do
    i+=1
  loop
  j=i
  '
  'LOCATE NEXT SPACE OR MARKER
  '
  do
    b=asc(s,i)
    if (b<36)or(b=64) then exit do
    i+=1
  loop
  function=mid(s,j,i-j)
end function



'-----------------------------------------------------------------------------
sub capture(byref s as string, byref m as sys, byref i as sys, byref c as sys)
'=============================================================================
  '
  ' s source string
  ' m beginning of capture (o)
  ' i source index (io)
  ' c beginning ascci char code
  ' v nesting depth counter
  ' k nesting flag
  ' a ascii code
  ' b another ascii code
  ' d temp
  '
  dim as sys v,k,a,b,d,e,br,rb
  dim as string wr
  skipspace(s,i)
  e=len(s)
  m=i
  c=asc(s,m)
  v=0
  do
    if i>e then
      if v>0 then
        ers="e000 brackets not closed "
      else
        ers="e000 Unexpected end of source code"
      end if
      ert=1 : exit do 'past end of string
    end if
    '
    a=asc(s,i)
    '
    if (v=1)and(a=44) then elct+=1 : i+=1 : continue do 'ELEMENT COUNT
    '
    if isq(a) then skipquote(s,i) : continue do
    '
    'END OF SINGLE LINE
    'END OF NESTED SEQUENCE
    '
    if k=0 then
      if ise(a)or(a=41)or(a=93)or(a=125) then exit do 'EXCLUDES FINAL COMMENT
      if a=nobr then exit do
    end if
    '
    b=isb(a) '( [ {
    if b then
      if br=0 then br=a : rb=b ' ) ] } 'OUTERMOST BRACKETS
    end if
    if a=br then k=1
    '
    if k=1 then
      if isc(a) then endline(s,i) : continue do 'BYPASS COMMENT
      if a=br then
        '
        'INCR NESTING LEVEL
        '
        v+=1
      elseif a=rb then
        '
        'DECR NESTING LEVEL
        '
        v-=1
        '
        'END OF NESTING
        '
        if v<=0 then
          '
          'TERMINATING BRACKET?
          '
          if c=br then i+=1 : exit do ' include end bracket
          '
          'OTHERWISE REVERT TO SINGLE LINE MODE
          '
          k=0
          '
        end if
      end if
      '
      'REACHED END OF STRING
      '
    end if
    i+=1
  loop
end sub



'------------------------------------------------------------------------------
sub capturi (byref s as string, byref m as sys, byref b as sys, byref i as sys)
'==============================================================================
    dim as sys a
    capture(s,m,i,a) : b=i-m
    if isb(a) then m+=1 : b-=2 'EXCLUDE OUTER BRACKETS
end sub


'----------------------------------------------------------------------------------------------------
sub capturend (byref s as string, byref m as sys, byref b as sys, byref i as sys, byref we as string)
'====================================================================================================
  dim as sys a,k
  dim as string wr
  skipspace(s,i)
  m=i
  do
    wr=aword(s,i)
    if wr="" then
      b=0 : i=m : exit do ' no terminator found so null capture
    elseif isb(ascw) then
      i=swd : capture(s,0,i,0) ' ( [ { nestings bypass
    elseif isc(ascw) then
      endline(s,i)
    elseif wr=we then
      a+=1
    elseif wr="end" then
      k=i
      b=swd-m
      if aword(s,k)=we then
        i=k
        if a<=0 then exit do
        a-=1
      else
        skiplspace(s,i)
      end if
    end if
  loop
end sub


'----------------------------------------------------------
'sub braces(byref s as string, byref i as sys, wr as string)
'==========================================================
'  dim as string w1
'  dim as sys b,m
'  capturend(s,m,b,i,wr)
'  if b then w1=mid(s,m,b)
'  inserts(s,"{"+cr+w1+cr+"}"+cr,i)
'end sub


'--------------------------------------------------------------------------------------------------
sub captureb(byref s as string, byref i as sys, byref m as sys, byref b as sys, byref wr as string)
'==================================================================================================
  dim as sys a,c
  dim as string w1
  skiplspace(s,i)
  if ascn=44 then i+=1 : nextinstruct(s,i)
  '
  if ascn=91 then
    '[..] def x [ebx+4096] 'not treated as a block marker
    m=i : endline(s,i) : b=i-m : exit sub
  end if
  '
  if ise(ascn) then
    nextinstruct(s,i)
    if (ascn<>lbr)and(ascn<>123) then
      capturend(s,m,b,i,wr)
      exit sub
    end if
  end if
  '
  '
  'OTHERWISE LOOK FOR END BRACKET
  '
  capturi(s,m,b,i)
  '
  'BUT ALSO LOOKAHEAD TO SEE IF `END X` EXISTS
  '
  a=i
  nextinstruct(s,a)
  if wordahead(s,a)="end" then
    a=nwd
    if wordahead(s,a)=wr then
      '
      'INCLUDE OUTER BRACKETS IN BLOCK
      '
      m-=1
      b=i-m+1
      i=nwd
    end if
  end if
  '
end sub


'-------------------------------------------------------------------------------------
function captureblock(byref s as string, byref i as sys, byref wr as string) as string
'=====================================================================================
  dim as sys m,b
  captureb(s,i,m,b,wr)
  if b then
    function=mid(s,m,b)
  end if
end function


'--------------------------------------------------------------------------------------------------
sub capturedefs(byref s as string, byref i as sys, byref m as sys, byref b as sys, byref wr as string)
'=====================================================================================================
  dim as string w1,w2
  i=swd
  w2=tword(s,i)
  if (ascw=lbr)or(ascw=123) then
    i=swd : ascn=ascw
  else
    '
    'CONTINUE TILL NEXT BOUNDARY
    '
    do
      if (isxn)or(isb(ascn)<>0) then exit do
      w1=tword(s,i)
      if nisxn then
        if (w2="def")or(w2="typedef") then
          endline(s,i) : exit sub
          exit sub
        end if
      end if
    loop
    '
  end if
  '
  'SKIP BLOCK
  '
  captureb(s,i,m,b,wr)
  '
  skiplspace(s,i)
  do
    if ascn=44 then i+=1 : nextinstruct(s,i)
    if isxn then endline(s,i) : i+=2 : exit do
    w1=tword(s,i) '
  loop
end sub


'-------------------------------
sub nofinalcr(byref s as string)
'===============================
dim as sys a, i=len(s)
do
  a=asc(s,i)
  if a=13 then
    s=left(s,i-1)
    exit do
  elseif a<=32 then
    i-=1
    if i<=0 then exit do
  else '>32
    exit do
  end if
loop
end sub


'-------------------------------------------------
sub endcontline(byref s as string, byref i as sys)
'=================================================
  '
  'SKIP TO THE NEXT LINE END THAT HAS NO CONTINUATION MARKERS
  '
  dim as string wr
  dim as sys m,b
  skiplspace(s,i) : if iss(ascn) then exit sub 'END OF STATEMENT
  do
    wr=tword(s,i)
    if isb(ascw) then i=swd : capturi(s,m,b,i) : skiplspace(s,i)
    if iss(ascn) then
      if lenw=1 then
        if (ascw<>44)and(ascw<>95)and(ascw<>92) then exit do 'CONTINUATION SYMBOLS , _ \
      else
        exit do
      end if
      endline(s,i)
    end if
  loop
end sub      '


'-------------------------------------------------
sub captstrings(byref s as string, byref i as long)
'=================================================
  '
  'FOR CAPTURING SINGLE STRING LITERALS OR SERIES OF THEM
  '
  dim as string wr,w1,bu
  dim as sys a,le,bg,ob,lb,lw
  wr=tword(s,i)
  bg=swd : le=lenw
  do
    a=i
    nextinstruct(s,i)
    '
    if isq(ascn) then
      w1=cr+noquotes(tword(s,i))
      lw=len(w1)
      if lw+ob>lb then
        bu+=space(ob+lw+1000) 'ELASTIC BUFFER
        lb=len(bu)
      end if
      mid(bu,ob+1)=w1 : ob+=lw
      continue do
    else
      i=a : skiplspace(s,i) : exit do
    end if
  loop
  if ob then
    bu=left(wr,le-1)+left(bu,ob)+chr(asc(wr))
    mid(s,bg)=bu+space(i-bg-len(bu)-1)
  end if
end sub


'-----------------------------------------------
sub captarray(byref s as string, byref i as sys)
'===============================================
   ' array with element
  dim as sys a,m
  dim as string wr
  skiplspace(s,i)
  do
    if isb(ascn) then
      capture(s,m,i,a)
      if asc(s,i)=46 then
        wr=wrd(s,i)
        continue do
      end if
    end if
    exit do
  loop
end sub

'-------------------------------------------
sub capts(byref s as string, byref i as sys)
'===========================================
  'CAPTURE EXPRESSION
  '
  dim as sys a,b,c,m
  dim as string wr
  'nextinstruct(s,i)
  skiplspace(s,i)
  b=i
  do
    if isb(ascn) then
      '
      if ascn=nobr then exit do 'USED IN 'FOR' EXPRESSION; TERMINATING ON '{'
      '
      capture(s,m,i,a) : skiplspace(s,i)
      continue do
    elseif ascn=44 then
      if noco then i+=1 : nextinstruct(s,i) : continue do else exit do
    elseif isxn then
      if ascn=58 then
        if asc(s,i+1)=61 then ascn=61 : i+=1 : continue do ':='
      end if
      exit do ' ,:;)]}'
    elseif isq(ascn) then
      captstrings(s,i)
      continue do
    end if
    '
    wr=aword(s,i)
    if isn(ascw) then
      continue do
    elseif isxn then
      if instrword(opname,wr) then 'ok: && || <>
        nextinstruct(s,i) 'IGNORE END OF LINE
        continue do
      end if
    end if
    if instrword(endex,wr) then
      i=swd : skiplspace(s,i) : exit do
    end if
  loop
  swd=b
end sub

'-----------------------------------------------------------
function captsx(byref s as string, byref i as sys) as string
'===========================================================
capts(s,i) : function=rtrim(mid(s,swd,i-swd))
end function


'-----------------------------------------------------------
function captsr(byref s as string, byref i as sys) as string
'===========================================================
noco=1
capts(s,i) : function=rtrim(mid(s,swd,i-swd))
noco=0
end function


'---------------------------------
sub nocomments(byref s as string)
'=================================
  '
  'strip out comments 'but not and //.. and /*..*/
  '
  dim as sys f,i
  dim as string wr
  i=1
  do
    wr=wrd(s,i)
    if ascw=0 then
      exit do
    elseif isc(ascw) then
      f=1 : endline(s,i)
    end if
    if f then
      s=left(s,swd-1)+mid(s,i) 'rtrim?
      i=swd-1
      f=0
    end if
  loop
end sub


'----------------------------------------
function hashid(s as string) as sys
'========================================
dim as sys le=len(s)
dim as any ptr p=strptr(s)
asm
  xor eax,eax
  mov edi,[le]
  mov esi,[p]
  rhashid:
    sub edi,4
    jl xhashid
    rol eax,7
    xor eax,[esi]
    add esi,4 
  jmp rhashid
  xhashid:
  mov [function],eax
end asm

end function


'----------------------------------------------------------
function fixsqbr(byref s as string, byval i as sys) as sys
'==========================================================
  dim as sys m,a
  capture(s,m,i,a)
  mid(s,m)="(" : mid(s,i-1)=")"
  ascn=lbr
  function=i
end function


'------------------------------------
function booli(byval n as sys) as sys
'====================================
  if n then return 1
end function


'--------------------------------------
function yes(byref wr as string) as sys
'======================================
  return booli(instrword(" 1 yes true on enable enabled active start ",wr))
end function


'-------------------------------------
function no(byref wr as string) as sys
'=====================================
  return booli(instrword(" 0 no false off disable disabled inactive idle stop ",wr))
end function


'------------------------------------------------------
function isnt(byref s as string, byref i as sys) as sys
'======================================================
  dim as string wr
  dim as sys a,v
  do
    if isxn then exit do
    wr=wordahead(s,i) : a=isx(asc(s,nwd))
    if a=0 then
      if instrword(" not isnt ",wr) then
        i=nwd : v=1-v : continue do
      elseif instrword(" is be mode switched turned ",wr) then
        i=nwd : continue do
      end if
    end if
    exit do
  loop
  skiplspace(s,i)
  function=v
end function


'----------------------------------------------------------
sub yesno(byref s as string,byref  i as sys,byref r as sys)
'==========================================================
  '
  'R DEFAULTS TO 1 WHEN THE AFFIRMING EXPRESSION IS ABSENT
  '
  dim as string wr
  dim as sys t,f,v
  if nisxn then
    v=isnt(s,i)
    if nisxn then
      wr=wordahead(s,i)
      t=yes(wr)
      f=no(wr)
      if t then
        r=1 xor v : i=nwd
      elseif f then
        r=0 xor v : i=nwd
      end if
      'OTHERWISE R IS UNALTERED
    end if
    skiplspace(s,i)
  else
    r=1
  end if
end sub


'------------------------------------------------------
function valchahex(s as string, byval i as sys) as long
'======================================================
  dim as sys a
  a=asc(s,i)
  if a>96 then a-=32
  if a>57 then a-=7
  if a>47 then function=a-48
end function


'---------------------------------------------------------
function dic(byval s as string, byval wr as string) as sys
'=========================================================
  '
  'LOOKUP KEYWORD AND RETURN NUMBER (ASSUMED HEXADECIMAL)
  '
  dim as sys a,e
  dim as any ptr p
  e=len(wr)
  a=instrword(s,wr)
  if a then
    p=strptr(s)+a-1
    asm
    mov ecx,[p]
    call hexaval
    mov [function],eax
    end asm
  end if
  '
end function


'-----------------------------------------------------------
function revdic(byref s as string, byref v as sys) as string
'===========================================================
  '
  'REVERSE DIC
  '
  'hexadecimal is assumed to be trimmed of leading zeros, and capitalised
  '
  dim as sys a,b
  b=instr(s," "+hexci(v)+",")
  if b then
    a=b
    do
      a-=1
      if asc(s,a)<=32 then a+=1 : exit do
    loop
    function=mid(s,a,b-a)
  end if
end function



'----------------------------------------------------------
function dicsn(byref s as string, byref a as sys) as string
'==========================================================
  '
  'LOOKUP LIST OF DECIMAL NUMBERS AND RETURN PHRASE
  '
  dim as sys v,k
  v=instr(s," "+str(a)+" ")
  if v then 
    v=instr(v+1,s," ") : skiplspace(s,v)
    k=instr(v,s,",") 'PHRASE DELIMITED BY COMMA
    if k then
      function=mid(s,v,k-v)
    end if
  end if
end function


'--------------------------------------------------------
function midval(byref s as string, byval i as sys) as sys
'========================================================
function=cvl(mid(s,i,4))
end function


'------------------------------------------------------------------
sub replace(byref s as string,byval w as string, byval r as string)
'==================================================================
  '
  dim as sys a,lw,lr
  '
  lw=len(w) : if lw=0 then exit sub
  lr=len(r)
  do
    a=instr(a+1,s,w)
    if a=0 then
      exit do
    else
      s=left(s,a-1)+r+mid(s,a+lw)
    end if
    a=lr+a-1
  loop
end sub


'--------------------------------------
sub replacecolonscrs(byref s as string)
'======================================
  dim as sys a=1
  do
    a=instr(a,s," : ")
    if a=0 then
      exit do
    else
      mid(s,a)=" "+cr
    end if
    a+=3
  loop
end sub

sub linesltrim(byref s as string)
'================================
  dim as sys a,b,c,d,i
  if s="" then exit sub
  i=1
  b=1
  c=0
  d=1
  do
    a=asc(s,i)
    select case a
    case 9 :
    case 0 to 13 :
      if c=0 then
        if a=0 then exit do
        if a=13 then i+=2 : continue do 'OMIT EMPTY LINES
      end if
      c=0
      if a=13 then i+=2
      mid(s,d)=mid(s,b,i-b) : d=d+i-b
      if a=0 then exit do
      if a<>13 then i+=1 
      continue do 
    case 33 to 255 : if c=0 then b=i : c=1
    end select
    i+=1
  loop
  s=left(s,d-1)
  end sub


'---------------------------------------------------
sub mk2(s as string,i as sys,byval v as short)
'===================================================
dim as any ptr p=strptr(s)+i-1
dim as short ptr q=p
*q=v
end sub


'--------------------------------------------
sub mk4(s as string,i as sys,v as long)
'============================================
dim as any ptr p=strptr(s)+i-1
dim as long ptr q=p
*q=v
end sub


'-----------------------------------------------------
sub mk8(s as string,i as sys,byval v as longint)
'=====================================================
dim as any ptr p=strptr(s)+i-1
dim as longint ptr q=p
*q=v
end sub

#if 0

'=======
'EMITTER
'=======

'------------------------------
sub appendc(byval wt as string) 'APPEND TO EMITTER BUFFER
'==============================
  dim as sys le=len(wt)
  if len(cbuf)<cbi+le then cbuf+=space(le+16000)
  mid(cbuf,cbi)=wt : cbi+=le
end sub


'--------------------
sub cestr(cbj as sys)
'====================
  dim as string w1
  w1="StrFromNum("+mid(cbuf,cbj,cbi-cbj)+")" : cbi=cbj
  appendc(w1)
end sub


'--------------------
sub ceval(cbj as sys)
'====================
  dim as string w1
  w1="NumFromStr("+mid(cbuf,cbj,cbi-cbj)+")" : cbi=cbj
  appendc(w1)
end sub


'----------------------------------------------
function emittype(byval wm as string) as string
'==============================================
  if wm="sys" then
    if cpuw=4 then
      function="int32_t"
    else
      function="int64_t"
    end if
  elseif wm="" then
    function="void"
  else
    function=wm
  end if
end function


'-------------------------------
sub cappendoperand(wr as string)
'===============================
dim as string w1,w2
  if isa(ascw) then
    w1=ow+cpfx 'cpfx: posible array code
    if dtf then  'DOT OR ARROW?
      w2=left(w1,dtf-1)
      if mp then
        if mc>0 then
          if maco(mp,3)=1 then
            w1=w2+"->"+mid(w1,dtf+1) 'ARROW
          end if
        end if
      end if
    else 'NO DOT
      if mp then
        if mc>=0 then
          if maco(mp,3)=1 then
            if (ascn<>lbr)and(ascn<>91) then 'NOT ARRAY
              w1="*"+w1 'POINTER
            end if
          end if
        end if
      end if
    end if 'DTF
  else
    w1=wr 'numbers and symbols
  endif
  '
  '
  'STRING TEST
  '
  if (typ>&ha0)and(typ<&hff) then
    select case op
    case 0 to 1 : w2="NewCatStr("
    case      2 : w2="AssignCatStr("
    case     43 : w2="AddCatStr("
    end select
    appendc(w2+w1+cm+str(typ)+")"+cr)
  else
    appendc(" "+w1)
  end if
  cpfx=""
end sub


'------------------------
function Coutput() as sys
'========================
  '
  dim as string s,t
  s="#include <stdlib.h>"+cr+_
    "#include <stdio.h>"+cr+_
    "#include <string.h>"+cr+_
    "#include <math.h>"+cr+cr
  t=""+cr
  open cexn for output as 3
  print #3,s+left(cbuf,cbi-1)+cr+cr+t
  close 3
  function=1
  '
end function

#endif 'C emitter routines

'-------------------------------------------------------------------------------
function findlinek(byref b as sys, s as string, k as string, p as sys) as string
'===============================================================================
dim as sys a,c
a=instrevn(b,s,k)
if a then
  c=instr(a,s,cr)
  if c then
    a+=p
    return mid(s,a,c-a+2) 'include cr
  end if 
end if  
end function


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

