'------------------------------------------------------------
function dimtype(byref s as string, byref i as sys) as string
'============================================================
  dim as sys a,b
  dim as string w1,w2,w3
  if isq(ascn) then return "string"
  w3=ow
  a=i : w1=captsr(s,a)
  parx=1 : nstod=1
  w2=express(w1,1,0)
  parx=0 : nstod=0 : rps=0 : ert=0
  epfx="" : hiex=""
  if isbstr(typg) then typg+=32 'PROMOTE TO STRING
  if typg=0 then
    ert=403 : ers="dim type required" : ow=w3
  else
    function=typename(typg)
  end if
  skiplspace(s,i)
end function


'------------------------------------------------------------------------
sub exportadd(byref wn as string, byref ali as string, byref eord as sys)
'========================================================================
  '
 if eord>=1000 then ers="too many exports" : ert=400 : exit sub
  expwn(eord)=wn
  expal(eord)=ali
  eord+=1
end sub


'---------------------------------------------------
sub procaddrc(byref s as string, byref wr as string)
'===================================================
  '
  'LATE BIND
  '---------
  '
  dim as sys a,b,d,i,j,k,m,n,q,v
  dim as string wa,wd,we,wp,tt
  i=1
  k=1
  do
    wd=wrd(s,i)
    j=swd
    if lenw=0 then exit do
    if isxn() then
      we=wd
    elseif (isa(ascn)<>0)or(ascn=42) then
      clcase(wd)
      a=identype(wd)
      if a then
        '
        'CREATE LINKED VARIABLES INSTEAD OF FUNCTIONS WITH PROCADDRESS
        v=1 : staticvars()
        d=indt
        wa=""
        do          
          wp=tword(s,i) : b=swd : n=0 : q=1
          while ascw=42 : wa+=wp : wp=tword(s,i) : n=1 : wend 
          if ascn=91 then
            a=instr(i,s,"]") :  wordval(s,i+1,0) : q=dv : i=a+1 : wp=mid(s,b,i-b) : skiplspace(s,i)
          end if       
          vars(wd+" "+wp+" at "+wr+" "+chr(126)+" "+memreg(qedi,m)) 'CREATE VAR DIRECTLY
          if n+d>0 then m+=cpuw else m=m+(lent*q)
          roundupc(m,cpuw) 'ROUND TO 4 OR 8 BYTES
          skiplspace(s,i)
          if ise(ascn) then exit do
          if ascn=44 then i+=1
        loop
        continue do
      end if
      'OTHERWISE READ AS FUNCTION NAME ALIAS
      we=noquotes(wrd(s,i))
    end if
    clcase(wd)
    '
    if ascn=lbr then
      capture(s,b,i,0)
      wp=mid(s,b,i-b)
    else
      b=0
      wp=""
    end if
    if ascn=44 then i+=1 : skiplspace(s,i) ' skip comma
    m=lookupm(wd)
    if m then
      a=maco(m,0) 'GET METATYPE
      if a<=0 then m=0 'OVERRIDE ALL EXCEPT VARIABLES
    end if
    if m then
      wa="" 'NO NEW DECLARATION REQUIRED
    else 'm=0
      wa="!* "+wd+" "+qu+we+qu+" "+wp+" : " 'CREATE NEW DECLARATION
    end if
    wa+="@"+wd+"=getprocaddress "+wr+cm+qu+we+qu+cr
    '
    appbindbuf:
    '----------
    '
    if k+len(wa)>len(tt) then tt+=space(8000) 'stretch buffer
    mid(tt,k)=wa
    k+=len(wa)
  loop
  '
  if v then
    s=""
  else
    s=left(tt,k-1)
  end if
end sub


'--------------------------------------------------------
function assieq(byref s as string, byref i as sys) as sys
'========================================================
  if ascn=58 then
    if asc(s,i+1)=61 then
      mid(s,i)=" " 'blank ":"
      i+=1 : ascn=61 ' :=
      function=1
    end if
  end if
end function


'----------------------------------------------------------------
function checkforlabels(byref s as string, byref i as sys) as sys
'================================================================
  '
  'COLON LABELS: CHANGE TO DOT LABELS
  '
  if assieq(s,i) then exit function      'IS ASSIGNMENT OPERATOR
  if i<>swd+lenw then exit function      'SPACE THEN COLON
  '
  'MAKE LABEL RECORD
  '
  function=-1
end function


'-------------------------------------------------------------------------------------------------------
function captpreproto(byref s as string , byref i as sys, byref wr as string, byref w7 as string) as sys
'=======================================================================================================
  dim as string w3,w4,w5
  dim as sys a,b,c,d
  w7=" "
  '
  if instrword(" fpu ", wr) then w7+=wr+" " : wr="void" : return 3
  do
    skiplspace(s,i)
    w3=wordahead(s,i)
    '
    select case asc(w3)
    case 42 : wr+=w3 : i=nwd : continue do 'POINTER
    case 91 : wr+="*"  'ARRAY POINTER
      do  '[][]...
        capture(s,0,i,0)
        skiplspace(s,i) 
        if ascn<>91 then exit do
      loop
      continue do
    case 40  : function=1 : exit do        'long (*foo)(...)
    case 39 : i=nwd : endline(s,i) : continue do
    end select
    c=lookupm(w3)
    if c then
      d=maco(c,0)
      if (d=-18)or(d=-20) then
        i=nwd
        if d=-20 then w5=himac(c,s,i) else w5=macres(c,s,i)
        if w5="" then continue do
        if isa(asc(w5)) then
          inserts(s,w5+" ",i) 'EXPANDED MACRO
          continue do
        else
          inserts(s,w3+" ",i) : nwd=i 'RESTORE
        end if
      end if
    end if
    '
    if w4="" then
      nextinstruct(s,nwd) : c=asc(s,nwd)
      if c=lbr then function=2 : exit do 'long foo(...)
      if c=123 then return 123 'COMPACT MULTIASSIGN
      'if (c=123) then i=nwd : w7=w3 : skiplspace(s,i) : return 123 'long foo {...}
    end if
    '
    captqualif:
    '
    b=dic(" lib 1, alias 2, cdecl 3, stdcall 4, ms64 5, pascal 6, cpu 7, fpu 8, ",w3)
    if b then
      i=nwd
      if b<3 then w3+=" "+tword(s,i)
      w7+=w3+" "
      nextinstruct(s,i)
      '
      if ascn=lbr then
        if w4="" then function=1 else function=2
        exit do
      end if
    else
      if len(w4) then
        exit do
      else
        c=casf : casf=2 : w4=tword(s,i) : casf=c 'no case alteration
        w3=wordahead(s,i)
        goto captqualif
      end if
    end if
  loop
  if len(w4) then inserts(s,w4+" ",i)
  skiplspace(s,i)
end function


'---------------------------------------------------------------------------------
function translateproto(s as string, byref i as sys, byref w2 as string) as string
'=================================================================================
  dim as sys a,b,c,m
  dim as string w3,w4,w5,w6
  '
  'CAPTURE PROTOTYPE
  '
  w4=""
  ascn=asc(s,i)
  if ascn=lbr then
    capture(s,m,i,0) : w4=mid(s,m,i-m)
  end if
  '
  'CLEANUP PROTOTYPE
  '
  w3=""
  a=1
  '
  do
    w5=tword(w4,a)
    if isc(ascw) then endline(w4,a) : continue do 'remove comment
    if lenw=0 then exit do
    b=lookupm(w5)
    if b then 
      if maco(b,0)=-20 then
        c=a
        w6=himac(b,w4,c)
        if len(w6)=0 then a=c : continue do
      elseif w5="const" then
        continue do 'OMIT
      elseif instrword(" struct union enum ",w5) then '(STRUCT ST*S ..)
        w6=wrd(w4,a)
        if ascn=42 then
          if w5<>"enum" then
            a+=1 : skiplspace(w4,a)
          end if
        end if
        w5="sys"
      end if
    end if
    w3+=w5
    if ascn=44 then a+=1 : w3+=","
    if ascn<>41 then w3+=" "
  loop
  if len(w2) then w2=" as "+w2
  '
  'CAPTURE MODIFIERS
  '
  skiplspace(s,i)
  a=i
  do
    select case ascn
    case 0 to 31  : exit do
    case 58 to 59 : exit do
    case 61       : exit do
    case 123      : exit do
    end select
    w5=tword(s,i)
  loop
  if i>a then
    w2+=" "+mid(s,a,i-a)
  end if
  nextinstruct(s,i)
  return w3+w2+cr
end function




'-------------------------------------------------------
function casesyntax(s as string, byref i as sys ) as sys
'=======================================================
dim as sys f=i
dim as string wr
nextinstructla(s,f)
if ascn=44 then
  i=f+1
  nextinstructla(s,i)
  return 4 'CASE SERIES
else
  wr=wordahead(s,f)
  f=0
  if wr="case" then
    f=nwd
    wr=wordahead(s,f)
    if wr<>"else" then
      return 2 'CONTIGUOUS CASES
    end if
  elseif wr="to" then
    return 3 'RANGE TESTING
  end if
end if
end function


'-------------------------------------------------------------------------------------------------------------
function SolveCaseSym(byref s as string, byref i as sys, tp as sys, byref f as sys, byref cp as sys) as string
'=============================================================================================================
dim as sys d,g,p,v,ng
dim as string wr,w1
cp=0
'PWORD AUTOMATICALLY STRIPS LEFT '%'
skipspace(s,i)
'nextinstruct(s,i)
do
  wr=pword(s,i)
  select case ascw
  case 39 : caseval(s,i)
    if ascw<>39 then i=swd ' SINGLE QUOTE OR SKIPPED COMMENT
  case 45   : if isa(ascn) then ng=1 else exit do  ' -
  case 60   : cp or=1        ' <
  case 61   : cp or=2        ' =
  case 62   : cp or=4        ' >
  case else : exit do        ' 
  end select
loop
'
if isq(ascw) then
  typ=cpuw 'ASCII CASE SUPPORTS UP TO 4 CHARS (32 BIT)
  g=1 : p=2 : v=0
  do
    d=asc(wr,p)
    if (d=ascw)or(d=0) then exit do
    v=d*g+v
    g*=256
    p+=1
  loop
  wr=str(v)
elseif nisxn then
  if ascn=&h74 then
    if wordahead(s,i)="to" then goto nsolvecase
  end if
  if ascw=91 then
    ert=601 : ers="must use a const expression" : return wr
  end if
  inserts(s,wr+" ",i)
  dv=metaval(s,i,wr,d)
  skiplspace(s,i)
end if
'
nsolvecase:
'
if ng then
  if isn(asc(wr)) then
    wr="-"+wr : ng=0
  else
    'NEGATIVE VARIABLE
    if (typ<&h40)and(tp<&h40) then
      g=1
      select case typ and 31
      case cpuw : w1=qecx : g=0
      case 4    : w1="ecx"
      case 2    : w1="cx"
      case 1    : w1="cl"
      end select
      if g then
        wpfx+="xor "+qecx+cm+qecx+cr 'zero reg
      end if
      wpfx+="mov "+w1+cm+wr+cr
      wpfx+="neg "+qecx+cr
      select case tp and 31
      case cpuw : wr=qecx
      case 4    : wr="ecx"
      case 2    : wr="cx"
      case 1    : wr="cl"
      end select
    end if
  end if
end if
if isfloat(tp) then
  wpfx+=operi(1,typ,wr)+cvtai(typ,tp)
  if ng then
    wpfx+="fchs"+cr 'NEGATIVE VARIABLE
  end if
  wr=""
end if
f=CaseSyntax(s,i)
return wr
end function


'---------------------------------------------
function extractvarname(s as string) as string
'=============================================
dim as sys a,b,i
b=1
i=len(s)+1
while asc(s,b)=42 : b+=1 : wend 'STRIP '*'
if asc(s,i-1)=44 then a=1    'exclude comma
return mid(s,b,i-b-a)
end function


'------------------------------
#macro prepareprocedurerecord()
'==============================
  w4=lnmks
  '
  '
  'PROCUDURE HEADER
  '
  if n=18 then
    if funi>0 then ert=160 : ers="nested procedure" : goto exitap
  else
    if funi>0 then ert=161 : ers="nested declaration" : goto exitap
    funi=1
    typp=cpuw
    noin=0 'itr global noin?
    funn=0
    lcl=0
    lcls=0
    mlcl=0
    plcl=0
    blcl=0
    funl=0
    flbl=0
    dcs=0
    dts=0
  end if 'n<>18
  if atx then
    atf=1
  else
    atf=0
  end if
  if (cpuw=8)and(ccx=0) then
    ccp=3 '64BIT INTERNAL CALLING CONVENTION
  else
    ccp=ccx
  end if
  '
  wva(1)="" : wva(2)=""      'CLEAR STATE
  if cpuw=8 then
    for a=1 to 4
      typl(a)=0 'CLEAR PARAM TYPES (CHECKING FOR FLOAT)
    next
  end if
  '
  if n=18 then
    w1=wordahead(s,i) 'DECLARE
    if instrword(" function sub ",w1) then
      i=nwd
    end if
    skiplspace(s,i)
    pf+=isptr(s,i) 'FUNCTION POINTER
  end if
  '
  ali=uword(s,i)  'PRIMARY (ALIAS) NAME
  wn=ali
  if asc(ali)=34 then
    ali=noquotes(ali) 'REMOVE QUOTES
  end if
  a=instr(ali,"@")
  if a then 'DERIVE NAME FROM MANGLED ALIAS
    if asc(ali)=95 then b=2 else b=1 'strip leading underscore
    wn=mid(ali,b,a-b)
  end if
  clcase(wn) 'CASE CONVERTED NAME
  
  skiplspace(s,i)
  '
  if vew>0 then
    if(n>=11)and(n<=13) then
      appendt(cr+cr+ucase("'"+wr+" "+wn)+cr+cr)
    end if
  end if
  '
  c=0
  '
  do
    if isxn then
      exit do
    end if
    if isq(ascn) then
      ali=noquotes(tword(s,i))  'IMPLICIT ALIAS
      continue do
    else
      w1=wordahead(s,i)
      a=dic(" lib 1, alias 2, ",w1)
      if a=1 then
        i=nwd
        lby=rootpath(lpath+lexiword(s,i)) 'EXPLICIT LIBRARY
        continue do
      elseif a=2 then
        i=nwd
        ali=noquotes(tword(s,i)) 'EXPLICIT ALIAS
        continue do
      end if
    end if
    a=dic(callco,w1) 'DETECT CALLING CONVENTION
    if a then
      ccp=a and &hff 'leave only the lower byte
      i=nwd : continue do
    end if
    exit do
  loop
  '
  funm=ali    'remember original name
  lnmks=w4 : w4=""  '
  if n=13 then pn=1 'offset allowing for 'this'
  '
  if n=18 then
    if lby="" then lby=libr 'POSSIBLE DEFAULT LIBRARY NAME
    skiplspace(s,i)
  else
    lby=""
  end if
  '
  'LOOKAHEAD FOR BRACKETS
  a=i
  nextinstruct(s,i)
  if (ascn<>lbr)and(ascn<>44) then
    b=-5
    w1=wordahead(s,i)
    d=dic( " as 1, export 2, extern 3, external 3, callback 3, link 4, at 5, = 5, label 6, nosig 7, = 8,",w1)
    if d=0 then i=a : skiplspace(s,i)
    'if (n=18)and((len(lby)>0)or(pf>0)) then
    if n=18 then
      b=-4 'ASSUME UNPROTOTYPED
    end if
    goto ndimbr
  end if
  '
  i+=1 : nextinstruct(s,i) : bpb=1
  '
#endmacro


'-------------------------------
#macro completeprocedurerecord()
'===============================
  '
  macoin me
  w1="" : w5="" : w6=""
  if len(sigd) then w2=sigs+sigd else w2=""
  w9=wn+sigs 'OVERRIDEN FOR 'AT' VECTORS AND LIBRARY CALLS
  dtx=etx 'TO EXPORT ONCE ONLY
  '
  do 'rqualpro:
  '============
  '
  a=i
  nextinstruct(s,i)
  if ascn=44 then
    i+=1 : continue do 'SUPPORT COMMA SPACING
  end if
  w1=wordahead(s,i)
  d=dic( " as 1, export 2, extern 3, external 3, callback 3, link 4, at 5, = 5, label 6, nosig 7, ",w1)
  '
  if d then
    swd=i
    i=nwd
  else
    i=a : skiplspace(s,i)
    if dtx then
      d=2 'DEFAULT EXPORT
      dtx=0
    else
      w1="" : exit do
    end if
  end if
  '
  select case d
  '============
  '
  case 1 'AS TYPE
    '
    ' _RETVAL
    w5=tword(s,i)
    a=identype(w5)
    d=isptr(s,i) 'RETURNING POINTERS (SWALLOW)
    if n<>18 then lcl=1
    if a>=htyp then a=-1 : d=1 
    if a=-1 then 'VOID OR HIGHER TYPE POINTERS
      if d>0 then d-=1 : w5="sys" : a=cpuw else w5="" : a=0
    end if
    wva(1)=w5
    '
    'ASSUME HIGHER TYPES IMPLICITLY RETURN A POINTER
    '       
    'if a>=htyp then
      '
    if a>=&h100 then
      '
    elseif a>=&hc0 then
      if n<>18 then lcl=1 : lcls=1 'GARBAGE COLLECTION
    elseif a>=&ha0 then
      if d=0 then
        a and=&h1f 'RETURN TYPE AS BYTE OR WORD (C direct char)
        w5=identypes(a)
      else
        if n<>18 then lcl=1 : lcls=1 'GARBAGE COLLECTION
        'not w5+=string(d,"*")
        d-=1
      end if
    end if
    '
    if d then w5+=string(d,"*") : a=cpuw 'POINTER RETURN TYPE
    typp=a
    d=0
    '
  case 2 'EXPORT
    '
    'ADD TO EXPORT TABLES
    '--------------------
    '
    'exluding declared functions and methods
    if n=18 then
      if asc(w9)=91 then
        'EXPORT OOP METHOD AS A FUNCTION WITH HANDLE PARAM
        'declare mm at @cc.mm, export
        appendt "jmp fwd _njmp_ : ."+wn+" : jmp "+w9+" : ._njmp_"+cr
        exportadd(wn,ali,eord)
      end if
    elseif n<>13 then
      exportadd(wn,ali,eord)
      atf=1
    end if
    dtx=0 'SUPPRESS DEFAULT EXPORT
    '
  case 3 'EXTERN / EXTERNAL / CALLBACK
    '
    atf=1
  case 4 'LINK
    '
    'IN  ARRAY OR PROCEDURE HEADER
    'GIVE PROCEDURE POINTER TO EXTERNAL OR INTERNAL VARIABLE
    'OR PROVIDE FUNCTION ADDRESS FOR HOST    
    '
    skiplspace(s,i)
    '
    if ascn=35 then
      atf=1 'AUTOMATICALLY SET AS EXTERNALLY ACCESSIBLE PROC
      w6="["+tword(s,i)+"]" : wpfx="" '..link #hv
    else
      w6=pword(s,i) ' link a  link a[2]  link *a ...
    end if
    '
    if dep then
      w6=linkadd(wn+sigs,qeax)+wpfx+operi(2,cpuw,w6)
    else
      if n=18 then
        if len(lby) then  'LINKAGE FROM IMPORT LIBRARY
          c=addlib(lby)
          w1=addlproc(c,ali)
          w1=operi(1,cpuw,w1)+wpfx+operi(2,cpuw,w6)
          inserts(s,w1,i)
        end if
      else 'LINKAGE FROM PROC LABEL LOCATION
        w6=enc("mk 1")+linkadd(wn+sigs,qeax)+wpfx+operi(2,cpuw,w6)+enc("mk 0")
      end if
    end if
    flbl=1 'prevent compaction
    '
  case 5 'AT
    '
    'IN DECLARE STATEMENT
    '
    'EXTERNAL / VECTORED FUNCTION DECLARATION
    '
    'declare function xyz() as sys at a
    '
    '
    if n<>18 then
      i=swd : skiplspace(s,i)
      exit do
    end if
    a=ascn
    skiplspace(s,i)
    if (ascn<>64) then
      w9=NewStatVarStr(0) 'NEW PROCEDURE VECTOR
      pf=0
      inserts(s,w9+"=",i) 'FULL ADDRESS EXPRESSION FOLLOWS
      ascn=64
    else '@ address coupling
      'LINK A FUNCTION TO AN EXISTING VARIABLE OR ANOTHER FUNCTION
      nobr=1
      'i+=1
      w9=pword(s,i) 'DIRECT COUPLING
      if len(wpfx) then w9=ow 'USE ORIGINAL NAME
      nobr=0
      pf=0
    end if
    '
    'itr calling conventions must match
    '
  case 6 'LABEL
    '
    'ADD UNSIGNED LABEL
    flbl=1 ' (also prevents deletion during compaction)
    '
  case 7 'NOSIG
    '
    b=-4 'LOW LEVEL CALL, NO SIGNATURE CHECKING
    flbl=1
    w2="@"
    w5=""
    w9=wn
    '
  end select
  '
  loop
  '
  'MAP  PROCEDURES
  '===============
  '
  ' FUNCTION SUB DECLARE but exclude METHOD
  '
  if w5="" then
    if tys then
      w5=typename(tys)
      wva(1)=w5
      typp=tys
      f=tys
    end if
  end if
  '
  if n<>3 then
    'EXCLUDE METHODS FROM PROCEDURE RECORD
    '
    'CREATE PROCEDURE RECORD
    ' excluding methods
    '
    c=0
    '
    'IF DECLARED
    '-----------
    '
    if n=18 then
      if len(lby) then
        '
        'ADD LIBRARY IF NOT SEEN BEFORE, THEN ADD PROC TO LIST
        '
        c=addlib(lby) : lby="" : w9=ali
        atf=1
      else
        if pf then
          'NEW PROCEDURE VECTOR
          w9=NewStatVarstr(0)
        end if
      end if
      lbw="declare .. "+wn
    else 'N<>18
      lbw=wn
    end if
    '
    '
    '
    if (ccp=3)and(atf>0) then
      ccp=2 '64BIT EXTERNAL CALL
    end if
    '
    if w2="@" then
      w2="#@" 'NO PARAMS
    elseif w2="@." then 'ELLIPSIS
      w2="#@."
    end if
    '
    if w5="" then
      if b=-4 then w5="sys" else w5="," 'NO SPECIFIED RETURN
    end if
    if dfv=0 then w4="" else dfv=0
    if len(w4)and(asc(w4)<>40) then
      w4="(,"+w4+")" 'DEFAULT PARAMS
    end if
    '
    '
    'CREATE FULL PROCEDURE RECORD (READ BY NEXTPROC)
    '
    'prototype / returntype callsig/alias  calllib metatype  callingconvention patchoffs namedparams
    'EG: ##long#string@01 double foo#long#string 0 FA 0.       (,a=3,b="X",)
    '    ##long#string@01 double Foo 0 GA 0.       (,a=3,b="X",)
    '    ##long#string@01 double [ebx+0x1000] 0 HA 0.      (,a=3,b="X",)
    'w9 is callnamesig or alias or vector
    '
    w3="#"+w2+" "+w5+" "+w9+" "+str(c)+" "+chr(65-b)+chr(65+ccp)+" 0.       "+w4+cr
    funl=instr(w3,"0.")-1 'patch location 'allowed 8 spaces for patchin
    '
    '
    'SELECTED OVERLOADING
    '
    mqf=0
    d=0
    if b<>-4 then
      d=lookupm(wn) 'lookup prior
      if d then
        a=maco(d,0)
        if (a=-5)or(a=-16) then
          w3+=macso(d,1)    'overload and append prior
          funl+=spe+4 'patch location
          macsi(w3,d,1)     'update record
          mqf=d
        else
          d=0
        end if 'a
      end if 'd
    end if
    '
    if d=0 then
      '
      '============================================================================='
      macsi(wn,me,0)        ' name
      funl+=spe+4     ' patch location
      macsi(w3,me,1)        ' list of param signatures (overloadable if -5)
      '-----------------------------------------------------------------------------'
      maco(me,0)=b          ' metatype -4 or -5
      '============================================================================='
      '
      addm() : mqf=me : addme() : if ert then goto exitap
      '
    end if
    '
    w5=""
    ali=""
    d=0
    e=0
    '
    'DECLARATION
    '
    if n=18 then
      dcp=0
      goto mainloop
    end if
    '
    '
  end if ' n=11,12,18 but not 13
  '
#endmacro


'---------------------
#macro iterationspec()
''====================
  '
  '
  ' ####   ####   #####
  ' #     #    #  #    #
  ' ####  #    #  #####
  ' #     #    #  #    #
  ' #      ####   #    #
  '
  cnd=0
  e=0
  if ascn=lbr then i+=1 : e=1 'SKIP LEFT BRACKET
  wr=pword(s,i)
  w3=wpfx
  '
  if mp=0 then
    'create it as sys variable
    if relaxed then
      varsal("sys "+wr) : if ert then goto exitap
      wr=macso(me-1,1)
      typ=cpuw
    else
      ers="Iteratator must be defined " : ert=400 : goto exitap
    end if
  end if
  '
  typm=typ
  '
  'SKIP EQUALS SIGN
  '
  skiplspace(s,i)
  '
  if ascn=61 then
    i+=1
  else
    ers="Missing '='" : ert=502 : goto exitap
  end if
  '
  'SET INITIAL VALUE OF ITERATOR
  w2=ow
  op=1
  d=0
  w1=express(s,i,typm)+w3+operi(2,typm,wr)
  if ert then goto exitap
  '
  ow=w2
  '
  w6=ow
  '
  'SET LIMIT VALUE FOR ITERATOR
  '
  w5=tword(s,i) 'TO' or ';'
  '
  if w5="to" then
    '
  elseif (ascw=44)or(ascw=59) then
    '
  else
    ers="missing 'to' or ';' " : ert=503 : goto exitap
  end if
  '
  w3=wordahead(s,i)
  '
  if instr("<>=",w3) then
    'INSERT ITERATOR FOR <E ETC
    swd=i : i=nwd
    identop(s,swd,i)
    w4=w6+mid(s,swd,i-swd)
  elseif instr("<>=",chr(asc(s,nwd))) then
    'I<E ETC
    swd=nwd : i=nwd+1 
    identop(s,swd,i)
    w4=w3+mid(s,swd,i-swd)
  else
    w4=w6+"<=" 'ADJUSTED LATER FOR DESCENDING STEPS
  end if
  '
  w5=w4+precalc(s,i,typm,w1) 'PRECALC EXPRESSION ADDED TO W1
  w1+=sp+"._for"+cr           'EXPRESSIONS & START OF LOOP
  '
  if ert then goto exitap
  '
  'PRESUME INCREMENT
  '
  a=0 : b=0 : c=0 : d=0 : 'cnd=0
  '
  'CHECK FOR STEPPER EXPRESSION
  '============================
  '
  if (ascn=44)or(ascn=59) then
    i+=1 ' COMMA OR SEMICOLON ...
    a=1
  elseif ascn=&h73 then 's
    w7=wordahead(s,i)
    if w7="step" then 'STEP ...
      i=nwd
      a=1
    end if
  end if
  skiplspace(s,i)
  '
  if a then
    '
    if ascn=45 then 'STEP -N
      b=45 : i+=1
    else
      b=43
    end if
    '
    nobr=123 : w2=captsx(s,i) 'STEP EXPRESSION
     w7=wordahead(w2,1)
    if w7=w6 then 'I+=N 'C STYLE STEP
      a=asc(w2,nwd)
      if (a=43)or(a=45) then ' + OR -
        if asc(w2,nwd+1)=61 then '+= -=
          w2=left(w2,nwd-1)+":="+w7+chr(a)+mid(w2,nwd+2) 'convert 'i+=1' to 'i=i+1' etc
        end if
      end if      
      c=1
    else 'BASIC STYLE STEP
      if b=45 then '-'
        a=instr(w5,"<=")
        if a then mid(w5,a)=">" : d=1 'DESCENDING STEP
      end if
      w2=w6+":="+w6+chr(b)+w2 'I = I +/- EXPR
      c=1
    end if
    '
  end if 'STEPPER
  '
  op=1
  w1+=express(w5,1,0)+boolcnd+"jz fwd _end_for"+cr
  w1=epfx+w1 : epfx=""
  skiplspace(s,i)
  '
  if c=0 then 'IMPLICIT STEPPER
    w2=mword(w6,1)
    w2=wpfx+operi(12+d,typ,w2) 'INC [EBP-??]
  else 'EXPLICIT STEPPER
    op=1
    asxp=1 'Complete Assignment expression
    w2=express(w2,1,typm)
    asxp=0
    w2=epfx+w2 : epfx=""
  end if
  nxs(nx)=w2 : nx+=1 'HOLD STEPPER EXPRESSION
  skiplspace(s,i)
  '
  if e then if ascn=rbr then i+=1 'SKIP RIGHT BRACKET
  '
  'CHECK AHEAD FOR {
  '
  a=cbrencah(s,i,4)
  '
  if fro=2 then 'POSSIBLE C EXPRESSION for (i=0;i<4;i++) ...
    if a=0 then
      b=0
      c=i
      while a=0
        w2=wrd(s,i)
        if ascw=59 then a=swd : exit while
        b+=1 : if (b>16)or(ascw=0) then exit while
      wend
      if a then
        w2="{"+mid(s,c,a-c+1)+"}"
        i=a+1
        inserts(s,w2,i)
        cbrencah(s,i,4)
      end if
    end if
  end if
  '
  w2="" : w3="" : w4="" : w5="" : w6="" : w7=""
  fro=0 'DONE FOR
#endmacro


'-----------------------
#macro ParseDim()
'=======================
  '
  dimiter:
  '=======
  '
  do
    '
    'CHECK END OF DIM
    '================
    '
    m=0
    skiplspace(s,i)
    '
    if n>10 then
      if isc(ascn) then nextinstruct(s,i)
    end if
    '
    'CHECK FOR END OF DIM
    '
    'check for closing ')'
    '
    if bpb then
      if ascn=rbr then
        i+=1
        skiplspace(s,i)
        m=2 : bpb=0
      elseif (iss(ascn)<>0)or(ascn=125) then
        nextinstruct(s,i)
        if ascn=rbr then i+=1
        m=2 : bpb=0
      end if
    else 'no bpb ')' expected
      if iss(ascn)or(ascn=125) then m=2 ':' '}' EXIT DIM STATEMENT
    end if
    '
    if n<10 then
      if len(wt) then
        if ws="" then
          m=0 : nextinstruct(s,i) 'LOOK AHEAD FOR VARIABLE NAMES
        end if
      end if
    end if  
    '
    'END OF DIM OR DELARATION
    '
    if m=2 then
      '
      'LOCAL VARIABLES SETUP INLINE
      '
      '
      'ASSIGN TYPE IF NEEDED
      '
      if len(ws) then
        if wt="" then
          if tys then
            wt=typename(tys)
          else
            wt="sys"
          end if
        end if
      end if
      wr=wt
      dg=2 : goto recovar
    end if 'm=2 'end of dim or declaration
    '
    '
    'NEXT PARAMETER OR TYPE IN THE LIST
    '==================================
    '
    if ascn=44 then
      i+=1 : nextinstruct(s,i)
    end if
    '
    '
    do
      wr=tword(s,i)
      select case dic(" * 1, ptr 1, byval 2, byref 3, optional 4, $ 5, % 5, ' 6, ; 6, ... 7, ",wr)
      case 0 : exit do
      case 1 : fdd+=1
      case 2 : fc=1 : fdd=0
      case 3 : fc=2 : fdd=1
      case 4 : opa=17 'set optional flag
      case 5 : 'IGNORE
      case 6 : endline(s,i) 'COMMENT
      case 7 
        a=ccp
        if (a=0)or(a=8) then a=1 'AUTO CDECL ELLIPSIS
        'a or=256
        ccp=a
        sigd+=chr(46)
        goto dimiter 'ELLIPSIS ...
      end select
    loop
    '
    '
    'IDENTIFY TYPE
    '=============
    '
    f=0
    if wr="as" then 
      wr=tword(s,i) 'AS TYPE
      f=2
    elseif n=18 then
      a=i
      if ascn=42 then
        b=isptr(s,i)
      else
        b=0
      end if
      '
      if (ascn=44)or(ascn=rbr)or(fc<>0) then
        if typf=0 then
          if (identype(wr)>0)or(b>0) then 'NO VOID but void*
            fdd=b
            f=3 'TYPE WITHOUT PARAM NAME
          end if
        end if
      else 'more words
        if b then
          i=a : skiplspace(s,i) 'STEP BACK TO INCLUDE '*'
        end if
      end if
    end if
    '
    ow=wr
    '
    if f then goto astype
    '
    'CHECK FOR VARIABLE NAMES
    '
    if typf then
      if isxn then
        if n<10 then
          goto addvarlis 'VARIABLE NAME
        end if
      end if
    end if
    '
    if ascn=97 then
      w1=wordahead(s,i)
      if w1="as" then
        if n>10 then
          if fc=0 then fdd+=bref 'IMPLICIT BYREF PARAM
        end if
        goto addvarlis 'VARIABLE NAME
      elseif w1="at" then
        goto addvarlis 'VARIABLE NAME
      end if
    elseif ascn=123 then
      goto addvarlis 'MULTIASSIGN {..}
    end if
    '
    'C TYPES
    '
    if (isa(ascn))or(ascn=42) then
      '
      i=swd 'REPARSE
      a=0
      '
      nobr=1 : wr=mword(s,i) : nobr=0 'MACRO EXPANSION
      '
      if lenw=0 then
        '
        continue do 'FOR EXIT PROCEDURE
      '
      elseif (mc=-4)or(mc=-9)or(mc=-13)or(mc=-14) then
        '
        if n=18 then
          a=0
        else
          ers="reserved word" : ert=319 : goto exitap
        end if
        '
      else 'PRIMITIVES UDT / CLASSES
        '
        'a=identype(ow)
        a=identype(wr)
        '
      end if
      '
      if a then
        f=1 : typf=a
        goto astype
      end if
      '
    end if 'identify c type
    '
    '-------------
    'IMPLICIT TYPE
    '=============
    '
    assieq(s,i)
    '
    a=0
    if n>10 then
      if (ascn=44)or(ascn=lbr)or(ascn=rbr)or(ascn=61)or(ascn=91) then a=1
    end if
    '
    'PROTOTYPES ONLY
    '
    if a then
      '
      if ascn=rbr then
        if wr="void" then continue do 'IGNORE VOID
      end if
      '
      'skip ()() [] etc
      '
      if (ascn=lbr)or(ascn=91) then
        '
        if n=18 then
          b=identype(wr)
          if b then wt=wr : wr="__" : typf=b
        end if
        '
        if wt="void" then
          wt="sys"
        else 'not void
          fdd+=1 'ADD INDIRECTION
        end if
        if isostr(typf) then
          fdd+=1 'EXTRA INDIRECTION FOR STRINGS
        end if
        '
        'SWALLOW [] ()
        while (ascn=lbr)or(ascn=91)
          capture(s,m,i,0)
          skiplspace(s,i)
        wend
       '
        ascw=asc(wr)
        assieq(s,i)
        '
      end if ' (..) [..]
      '
      '
      'C TYPE OR DEFAULT TYPE FOR FUNCTION PARAMS
      '------------------------------------------
      '
      ws=string(fdd,"*")+wr
      '
      'CHECK FOR INFERRED TYPE (BY EXPRESSION)  IN A PROTOTYPE
      '
      typd=typf
      a=0
      select case ascn
      case 41 : a=1 ')'
      case 44 : a=1 ','
      case 61 : a=2 '='
        if len(wt)=0 then
          'opa=17 'set optional flag
          wr=dimtype(s,i+1)
          typd=typg
        end if
      end select
      '
      if a then
        if len(wt) then
          wr=wt 'PRIORITY
        elseif a=2 then
          'INFERRED
        elseif typd then
          wr=typename(typd)
        else 'UNDEFINED
          wr="sys" ' 32 / 64 BIT ACCORDING TO MODE
        end if
        '
        appendsig(wr,fdd+opa)
        skiplspace(s,i)
        dg=1 : goto recovar
      end if ' a<>0
    end if 'n>10
    '
    astype:
    '======
    '
    if f then
      '
      'EXPLICIT TYPE
      '-------------
      '
      a=typf
      '
      if f>=2 then
        a=identype(wr)
        if f=2 then
          typf=a 'REMEMBER TYPE FOR FURTHER PARAMS
        end if
        f=2 'CHANGE FROM F=3
      end if
      '
      if a=0 then
        ers="Unknown type " : ert=201 : ow=wr : goto exitap
      end if
      '
      '
      'PB format: AS ASCIIZ*80
      '
      if n<10 then
        if iszstr(a) then
          skiplspace(s,i)
          if ascn=42 then
            a=i
            i+=1
            w1=tword(s,i)
            'w1=mword(w1,1)
            if nmb then
              wordval(s,a+1,i)
              ws=left(ws,len(ws)-1)+"["+str(dv)+"],"
            else
              i=a
              ascn=42
            end if  
          end if
        end if
      end if
      '
      w3=wr 'type
      b=0 : w5=""
      '
      if len(ws) then
        a=isptr(s,i)
        if a then fdd+=a : b+=a : w5="*"
      end if
      '
      if w3="string" then
        if n<>18 then
          lcl=1 : lcls=1 ' FLAG LOCAL DYNAMIC STRINGS
        end if
      end if
      '
      skiplspace(s,i)
      '
      'ARRAY OF A TYPE
      '
      if ascn=91 then
        inserts(s,"__",i)
      end if
      '
      if n>10 then
        if f=2 then appendsig(w3,fdd+opa)
      end if
      '
      'itr w5 */ptr applies to one element only
      '
      if ws="" then
        wt=w3+w5
        continue do 'FIRST TIME PREDEF ONLY
      end if
      '
      dg=1
      '
      if wt="" then
        wr=w3+w5 'POSTDEF
        if ascn=61 then
          dg=4
          nwd=i+1
        elseif ascn=97 then
          if wordahead(s,i)="at" then
            dg=3
          end if
        end if
        if dg>=3 then 'REARRANGE ORDER OF TERMS
          m=i
          i=nwd
          capts(s,i)
          ws=left(ws,len(ws)-1) 'REMOVE END COMMA
          if dg=4 then
            if iszstr(typf) then
              a=asc(ws,len(ws))
              if (a<>41)and(a<>93) then ws+="[]" 'TO AUTO SIZE CHAR ARRAY 
            end if
          end if
          wt=ws+" "+mid(s,m,i-m)+" as "+wr+" "
          inserts(s,wt,i) 'REPROCESS VARIABLE
          ws="" : wt="" : dg=0
          goto dimnext
        end if
        '
      else 'WT ALREADY DEFINED
        '
        wr=wt    'PREDEF
        wt=w3    'SET NEXT PREDEF
      end if
    end if 'f=1 IDENTIFIED TYPE f=2 'AS' TYPE 
    '
    '
    recovar: 'DECLARE VAR
    '====================

    '
    'DG=0 NO TYPE YET
    'DG=1 TYPE IDENTIFIED
    'DG=2 END OF DIM STATEMENT
    'DG=3 PREVENT APPENDING VARIABLE NAME TO WS LIST
    '
    if dg then 'ALL DG STATES
      a=ascn
      '
      'RECORD VARIABLES/PARAMS
      '
      assieq(s,i)
      if len(ws) then
        pn+=1
        '
        'CHECK FOR ARRAY TYPEs
        '
        if (ascn=91)or(ascn=lbr) then
          if fdd=0 then fdd=1 'ensure byref
          if isostr(typf) then fdd+=1
          while (ascn=91)or(ascn=lbr)
            capture(s,m,i,0) 'discard [] () 'SWALLOW MULTI
            skiplspace(s,i)
          wend
        end if
        '
        if n<10 then
          declvars(wr+" "+ws+cr,n,w4)
        else 'n>=10
          if n<18 then wva(2)+=wr+" "+ws+cr
          if cpuw=8 then
            a=identype(wr)
            if (a=&h6a)and(asc(ws)<>42) then
              ers="Cannot pass extended float params byval"
              ert=501
            end if
            typl(pn)=a
          end if
        end if
        '
        if ert then goto exitap
        skiplspace(s,i)
        assieq(s,i)
        '
        if (ascn=60)or(ascn=61)or(ascn=123)or(n>10) then
          wr=ws : ws="" : w2="" : w3="" : dg=3
          goto assig
        end if
        ws=""
      end if 'len ws
      '
      '
      if f=1 then
        if (a=60)or(a=61)or(a=123) then
          ascn=a : b=1
          wr=wv : goto assig 'DIM A AS FLOAT=1.618
        end if
      end if
      if dg=2 then 'END OF DIM
        '
        'INITIALIZATION
        '
        'includes stack allocation and zero and explicit vales
        '
        if n<10 then 'VARIABLES
          '
          if len(w4) then hiex+=w4 : rps=1 'APPEND EXPLICIT ASSIGNMENTS
          w1="" : cnst=0
          goto cleardown
          '
        else 'n>=10 'PROTOTYPES
          '
          ws="" : exit do 'FURTHER PROCESSING FOR PROCEDURES
          '
        end if
      end if 'dg=2
      dg=0
      goto dimnext 'NEXT ITEM IN DIM STATEMENT
    end if 'dg
    '
    '
    addvarlis: 'ADD VARIABLE TO LIST
    '===============================
    '
    '
    w2="" 'at ..
    w3="" 'possible array
    c=0   'flag empty brackets
    '
    '
    skiplspace(s,i)
    '
    'CAPTURE ARRAY SUPPORTING MULTIPLE [][].. 
    '=============
    '
    while (ascn=lbr)or(ascn=91)
      '
      'CHECK FOR EMPTY BRACKETS
      '
      w1=wordahead(s,i+1)
      a=asc(w1)
      c=-1 'ARRAY PRESENT
      '
      if (a=rbr)or(a=93) then
        i=nwd : c=1 'SIGNAL EMPTY BRACKETS
      else
        capture(s,m,i,a) : w3+=mid(s,m,i-m)
      end if
      skiplspace(s,i)
    wend
    '
    '
    'AT POINTER
    '==========
    '
    if ascn=97 then
      if wordahead(s,i)="at" then
        m=i
        i=nwd
        '
        'SUPPORT DIRECT COUPLING OF VARIABLES BY ADDRESS
        'ALSO REGISTERS .. at @ecx  at @rcx
        'do
        '  a=asc(s,i)
        '  if (a=38)or(a=64) then
        '    i+=1 : continue do
        '  end if
        '  exit do
        'loop
        '
        'SUPPORT COUPLING OF 'AT' VARIABLE
        '
        'CAPTURE OPERAND IN SQUARE BRACKETS
        if asc(wordahead(s,i))=91 then
          a=instr(nwd,s,"]")
          if a then
            nwd=a+1
            skiplspace(s,nwd)
          end if
        end if
        '
        a=isx(asc(s,nwd))
        '
        if a=0 then
          b=nwd
          if wordahead(s,b)="as" then
            a=2
          end if
          nwd=b
        end if
        if a=0 then               'AN EXPRESSION FOLLOWS
          wr="*"+wr               'SPECIFY BYREF
          mid(s,m)="= "           'REPLACING 'at'
          i=m
          ascn=61
        else 'a<>0 'linkage/coupling to another variable or address
          i=nwd
          w2=" "+mid(s,m,i-m)
          skiplspace(s,i)
        end if
      end if
    end if 'at
    '
    assig: 'INITIALISE
    '=================
    '
    'SIMPLE ASSIGNMENT =
    'AND
    'MULTIASSIGNMENT <=' '=>' '={...}' '<={...} '=>{...}'
    '
    ' 
    m=0
    '
    if (ascn=60)or(ascn=61)or(ascn=123) then
      '
      b=i
      a=i+1
      m=ascn
      '
      if m=60 then '<=
        a+=1
      elseif m=123 then '{
        a-=1
      end if
      '
      skipspace(s,a)
      '
      '
      'CHECK FOR ARRAY DATA
      '
      if (c=1)or(isq(ascn)) then '[] () "abc"
        '
        'ONLY SUPPORTS ONE STRING LITERAL
        '
        if iszstr(typf)and(w3="") then 'CHAR
          c=2
          w1=tword(s,a+0)
          w3="["+str(lenw)+"]" 'INSERT ARRAY 'INCLUDES 2 END NULLS
        end if
      end if
      '
      'CAPTURE EXPRESSION
      '
      i=a : elct=0 : nextinstruct(s,i) : capts(s,i)
      '
      if elct then
        if len(w3)<3 then
          w3="["+str(elct+ixb)+"]" 'insert array
        end if
      end if
      '
      'IF EXPRESSION EXISTS
      '
      if i>a then
        w1=wr
        e=1
        w2=""
        '
        while asc(w1,e)=42
          e+=1
        wend
        '
        'if typf>0 then 'EXCLUDE VOID* which is treated as sys
        if (n<10)and(cpoint=0)and((e>1)or(fdd>0)or(indt>0)) then
          'ASSIGN POINTER VALUE BUT NOT IN PROTOTYPES (n>10)
         if indt then w2="@@" else w2="@"
        end if
        'end if
        '
        w1=w2+extractvarname(w1)+mid(s,b,i-b)
        if (n<10)and(cnst=0) then
          w4+=w6+w1+cr+w7
        else 'PARAMS DEFAULTS
          if n>10 then dfv=1
          w4+=w1+cm
        end if
        w2=""
      end if
      '
    else 'NO EXPLICIT ASSIGN
      '
      a=1
      if ascn=97 then
        if wordahead(s,i)="as" then a=0 'DO LATER
      end if
      if (n>10)and(a) then
        'OPTIONAL DEFAULT PARAMS
        if opa=17 then w9="=null," else w9="=.,"
        w4+=extractvarname(wr)+w9 'IMPLICIT ASSIGNMENT
      end if
    end if
    '
    '
    'APPEND VARIABLE NAME (AND ARRAY) TO VARIABLE LIST
    'exclude PostDef Params F(N=V AS XXXX, ...)
    '
    if dg<>3 then
      wv=wr
      if ise(ascn)=0 then w2+=cm
      ws+=string(fdd,"*")+wv+w3+w2
    end if
    dg=0
    '
    '
    dimnext:
    '=======
    '
    skiplspace(s,i)
    '
    if (ascn=44)or(ascn=125) then
      fdd=0 : fc=0 'CLEAR INDIRECTION FLAGS
    end if
    '
  loop ' NEXT DIM MEMBER
  '=====================
  '
#endmacro

