
function upgradelen(int a, b) as int
====================================
if (a and 15)<(b and 15)
  return (a and 0xffffffe0)or(b and 15)
else
  return a
endif
end function


function arraysize(string*s, int*i) as int
==========================================
  '
  int a,b,m,v,lb,rb
  string wr
  b=i
  lb=asc(s,i)
  if lb=91
    rb=93
  else
    rb=rbr
  endif
  v=1
  m=i
  i++ 'SKIP FIRST LEFT BRACKET
  wr=tword(s,i)
  if ascn<>rb
    ers="Unexpected symbol after array index" : ert=404
  endif
  wr=mword(wr,1) 'macro support
  i++ : skiplspace(s,i) 'OTHERWISE NEXT DIMENSION
  midspace(s,m,i)
  a=val(wr)
  return v*a
  '
end function


procedure appendsig(string*wt, int pt)
'=====================================
  sigs+="#"+wt
  sigd+=chr(pt+48)
end procedure

int astb 'expression index
'
function dimtype(string*s, int*i) as string
===========================================
  astb=0
  int a,b
  string w1,w2,w3
  skiplspace(s,i)
  w3=ow
  a=i
  w1=captsx(s,a) 'was captsr
  if wordahead(s,a)="as"  'AS TYPE
    if a>i
      astb=a
      'print "Expr:" mid(s,i,a-i)
    endif
    b=a
    a=nwd
    w2=tword(s,a)
    midspace(s,b,a) 'BLANK 'AS ..'
    typg=identype(w2)  
  else  'EXAMINE EXPRESSION
    parx=1 : nstod=1
    nobj=1
    ndstr=1
    w2=express(w1,1,0)
    nobj=0
    ndstr=0
    parx=0 : nstod=0 : rps=0 : ert=0
    epfx="" : hiex=""
    if isbstr(typg)
      typg+=32 'BSTRING TO STRING
    endif
    w2=typename(typg)
  endif
  if typg=0
    ert=403 : ers="dim type required" : ow=w3
  endif
  skiplspace(s,i)
  return w2
end function


function buildsig(string*s, int *k, mo=0) as string
===================================================
  '
  int a,b,dfv,pt,f,j,opf,ct,xcap,m,ptc,bgw,vq
  string w1="",wa="",wr="",wn="",wt="",ww=""
  sigs=""
  sigd="@"
  sigv=""
  a=k
  b=swd
  pt=bref
  if mo
    wva(2)="" 'PROTYPE VARS DIM BUFFER
  endif
  '
  do
    rbuilds:
    ========
    ptc=isptr(s,k) 'COUNT LEADING POINTERS ***
    wr=tword(s,k)
    if lenw=0
      exit do
    endif
    bgw=swd
    vq=0
    '
    if wr="..."
      if (coco=0)or(coco=8)
        coco=1            'POSSIBLE CDECL
      endif
      sigd+="." : continue do 'ELLIPSIS
    endif
    if wr="byval"
      pt=0 : continue do   'BASIC BYVAL
    endif
    if wr="byref"
      pt=1 : continue do   'BASIC BYREF
    endif
    if wr="optional"
      opf=17 : continue do 'OPTIONAL PARAMS
    endif
    '
    if isc(ascw)
      endline(s,k) : continue do 'SKIP COMMENTS
    endif
    '
    'END OF PARAM EXPRESSION
    if (ascw=44)or(ascw=rbr)
      if xcap=0
        if opf
          sigv+=wn+"=null,"
        else
          sigv+=wn+"=.,"
        endif
      endif
      xcap=0
      if ascw=rbr
        exit do 'END OF PARAMS
      endif
      continue do 'NEXT PARAM
    endif
    '
    'CHECK FOR ARRAY BRACKETS
    if (ascn=91)or(ascn=40) 'whole array
      wa=captsx(s,k) 'capture
      if tword(s,k)="as"
        'no ptc increment
      else
        'o2 syntax
        ptc++ 'reference
      endif
      k=swd
      skiplspace(s,k)
      'print wn+wa cr pt
    endif
    '
    'CHECK FOR DEFAULT VALUES
    if ascn=61
      sigv+=wr+captsx(s,k)+","
      xcap=1
      dfv=1
      vq=1
    endif
    '
    'CHECK FOR 'AS'
    if ascn=97
      if wordahead(s,k)="as"
        k=nwd
        f=2 'BASIC TYPE FOLLOWS
        wn=wr
      endif
    endif
    '
    if f=2
      ct=0
      wt=tword(s,k) 'TYPE
      pt+=ptc+isptr(s,k) 'AS TYPE PTR
      a=ascn
      if a=61 '=' CHECK FOR DEFAULT VALUES
        sigv+=wn+captsx(s,k)+cm
        xcap=1
        dfv=1
        vq=1
      endif
    endif
    '
    'C STYLE
    '=======
    '
    if f=0
      '
      'TYPE RECOGNITION
      '----------------
      '
      'see buildsig tag
      a=0
      ww=wr
      select ascn
      case 0x41 to 0x5a : a=1
      case 0x61 to 0x7a : a=1
      case 95,35        : a=1
      case 42           : a=2
      end select
      if a
        k=swd
        nobr=1
        wr=mword(s,k) 'RESOLVE MACROS AND METATYPE
        nobr=0
        if wr="optional"
          opf=17 : continue do 'OPTIONAL PARAMS
        endif
        if a<>2 'no '*' follows
          a=0
        endif
        if vq '=' assign valie
          a=0
        endif
        if mc<0 'identified metatype
          a=3
        endif
        if a=0
          print "Type? " ww cr wr+" "+mid(s,k,40) cr mc
        endif
        if a
          pt=0 : ct=1 'C STYLE TYPE
          wt=wr
          goto rbuilds 'TO READ VARS
        endif
      endif
      skiplspace(s,k)
      if wt
        pt=ptc
        wn=ww
        wr=wt
        '
        if ascn=lbr
          if pt=0
            pt=1 ' void(...)(...)
          endif
          capture(s,m,k,0) 'void*(...) IGNORE CASTS & INNER PROTOTYPES
          skiplspace(s,k)
          if ascn=lbr
            capture(s,m,k,0)
            skiplspace(s,k)
          endif
        endif 'ascn=lbr
        '
      else 'no wt type
        if ww="void"  '()' NO SIG
          goto rbuilds
        endif
        if mo=18 'TYPE BUT NO PARAM
          pt=0 : wa=""
          appendsig(wr,pt+opf)
          goto rbuilds
        endif
        ert=565
        ers="Undefined type for "+ww
        exit function
      endif 'wt
    endif 'f=0 C STYLE
    '    '
    f=0 'CANCEL BASIC FLAG
    '
    if coco=16
      pt=0 : wt="int"
    elseif coco=17
      pt=0 : wt="fpu"
    endif
    '
    'ADD SIG FRAGMENT
    appendsig(wt,pt+opf)
    '
    if mo
      if mo<>18
        wva(2)+=wt+" "+string(pt,"*")+wn+wa+cr
      endif
      wa=""
    endif
    '
    if ct
      pt=0
    else
      pt=bref  'set ptr to the default level
    endif
  loop 'goto rbuilds
  ==================
  '
  swd=b
  if dfv=0
    if opf=0
      sigv=""
    endif
  endif
  if sigv
    sigv="(,"+sigv+")"   'DEFAULT VALUES
  endif
  return sigs+sigd
  '
end function 'buildsig


'================
'ELEMENT ENCODING
'INTERNAL FORMAT:
'================
'
'FIELDS:
'
' 0 TAB
' 1 ELEMENT NAME
' 2 SIZE
' 3 OFFSET
' 4 PROCLIST POSITION
' 5 VARF
'     1 PROPERTY
'     3 PROPERTY BYREF
'     8 CALL
'     9 METHOD
'     10+ INHERITED METHOD WITH OBJECT OFFSET
'
' 7 CALLING CONVENTION (code + ascii 65)
'     A stdcall
'     B cdecl
'     C ms64
'     D OX64
'     I pascal
'     Q cpu
'     R fpu
'     +0x20 thiscall
'     +0x40 fastcall
'
' 7 VIRTUAL MODALITY
'     A
'     B
'     C
' 8 PROTOTYPE SIGNATURE OR ','
' 9 RETURN TYPE
'10 DEFAULT VALUES?
'     (,A=1,B=32,C=12.5,) etc
'
function readcc(string*wr, int*c) as int
=========================================
  int a
  a=dic(callco,wr)
  if a=0
    return 0
  endif
  if cpuw=4
    if a and 0x60
      crgd=a and 0x60
    else
      c=a and 0x1f
    endif
  else
    if a and 0x60
      crgd=0
    'else
    '  a=a and 0x1f
    '  if (a=1)or(a=8) 'cdecl and pascal ignored
    '  else '0 2 3
    '    c=a
    '  endif
    endif
  endif
  return 1
end function


function callingconv(string*s, int*i, string*wr) as int
'======================================================
  int a
  a=readcc(wr,coco)
  if a
    midspace(s,swd,i) 'BLANKOUT
    if nisxn
      wr=tword(s,i)
    else
      wr=""
    endif
    return -1
  endif
end function




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

function enums(string*s, int*i,mo=0) as int
===========================================
  int a,b,c,d,e,k,m,ae,wi=0
  string wr,wn,w1,ws
  '
  if wordahead(s,i)="bit"
    k=-3 : i=nwd
  else
    k=-2
  endif
  '
  skiplspace(s,i)
  '
  if mo 'TYPEDEF ENUM ...
    if ascn<>123
      function=1
      goto nenums
    endif
  endif

  if isw(ascn)=0
    wn="typedefenum"
    ae=1
  else
    wn=tword(s,i) 'NAME PROVIDED
  endif
  a=i
  nextinstruct(s,i)
  if ascn<>123
    i=a : skiplspace (s,i)
  endif
  '
  captureb(s,i,m,b,"enum")

  e=m+b
  d=1 : c=0
  '
  'start with value of 0
  'or 1 for bitwise
  '
  do
    if m>=e
      exit do
    endif
    wr=tword(s,m)
    if ise(ascw)
      endline(s,m) : continue do
    endif
    if ascn=61
      m++
      nextinstruct(s,m) 'SKIP `=`
    endif
    '
    'numbers including &h .. &o coded
    '
    if (isn(ascn)<>0)or(ascn=38)
      c=wdval(s,m,m) : d=c
    else
      if (ascn<>44)and(nisxn()<>0)
        w1=tword(s,m)
        w1=mword(w1,1)
       'wordval(w1,1,1)
        c=dv
        d=dv
        skiplspace(s,m)
      endif
    endif
    if k=-3
      c=d : d+=d 'BITWISE ENUM
    endif
    if ae=0
      appe(ws,wi," "+wr+" "+str(c)+cm+cr)
    endif
    if (ae=1)or(uniq=0)
      newrecord wr 'NAME
      mrcsi(str(c),me,1) 'ENUMERATION VALUE
      drc(me).a=-18    'METATYPE EQUATE
      addme
    endif
    if k=-2
      c++    'NORMAL ENUM
    endif
    if ascn=44
      m++    'SKIP COMMA
    endif
    nextinstruct(s,m)
  loop
  '
  nenums:
  =======
  newrecord wn 'NAME OF ENUMERATION GROUP
  if ae=0
    ws=left(ws,wi)
    mrcsi(ws,me,1)
  endif
  drc(me).a=-33   'METATYPE ENUMERATION GROUP
  drc(me).b=4     'ASSUMED LENGTH
  drc(me).f=4     'ASSUMED INT TYPE
  addme
  '
  skiplspace(s,i)
end function


'=====================================
'             VARIABLES
'=====================================
'
'
'  ###         ###   ###   #########
'   ##         ##   #####   ##      ##
'    ##  VAR  ##   ##   ##   ##      ##
'     ##     ##   ##    ##    #######
'      ##   ##   ### DIM ##    ##    ##
'       #####   ##        ##    ##    ##
'        ###   ##          ##    ##    ##
'
'=========================================
'             DIM ----> VAR
'=========================================

int flagv=0
int vot=32
'
procedure vars(string*s)
========================
    int a,b,c,d,i,k,m,n,v,w,it,poff
    int arv,tind,indl,cv,hasd,arwd
    string w1,w2,w3,wd,wr,wm,ws,wt,sigs,dstr
    '
    ' create variable and optionally associate with structure
    ' drc:
    '------------------------------
    ' m0 name
    ' m1 macro (no structure spec)
    ' m2 static dimension: elements and dims
    ' m3 name of initial type
    '------------------------------
    ' a  0 0 for primitive or higher-type
    ' b  size
    ' c  offset
    ' d  3 indirection level of variable
    ' e  4 type indirection level
    ' f  5 type code >=typh = user defined
    ' h  7 flags
    '------------------------------
    '
    i=1
    '
    '=====
    varss:
    '=====
    '
    skiplspace(s,i)
    ind=0
    k=0
    '
    'GET TYPE NAME
    '-------------
    '
    ilc=1 : wm=gword(s,i)

    if lenw=0
      jmp fwd xvars
    endif
    '
    if ascw<=57
      it=val(wm)
      w=it and 15 'INTEGER TYPES
    else
      '
      'IDENTIFY TYPE
      '
      it=identype(wm)
      if it=0
        ers="type not located: "+wm : ert=14 : exit procedure
      endif
      '
      tind=indt 'TYPE INDIRECTION
      w=lent
      '
      'POSSIBLE DESTRUCTOR
      '===================
      if it>=typh
        k=it  'CLASS OR UDT
        if ndstr=0
          hasd=findop(it,"free",dstr)
        endif
      endif
    endif
    ws=""
    '
    '
    'CHECK FOR FUNCTION POINTERS (*foo[n])(..)
    '=========================================
    '
    '
    if asc(ary)=40
      'wm="sys"
      'it=cpuw
      ers="use sys (func ptr not supported) " : ert=500 : exit procedure
    endif
    '
    '
    '
    'EACH VARIABLE
    '=============
    '
    do ' each variable on line
      '
      wt=wm
      arv=len(ary)
      '
      '
      'INDIRECTION
      '===========
      '
      skiplspace(s,i)
      '
      do
        if iss(ascn)
          w3=""
          exit do
        endif
        c=isptr(s,i) ' *varname
        w3=tword(s,i)
        if ascw=44
          continue do
        endif
        cv++
        exit do
      loop
      '
      if c
        arv=0
      endif
      '
      c+=tind 'INCLUDE TYPE INDIRECTION
      '
      '
      if w3=""
        exit do
      endif
      wd=""
      b=it
      '
      '
      'STRING / BSTRING PARAMS
      '=======================
      '
      if isostr(it)
        a=0
        if prmf ' bstr params
          a=1 
        elseif cnst
          a=1
        endif
        if a
          if c
            c-- 'TREAT AS DIRECT STRING
          else
            b-=32 'TREAT AS BSTRING
          endif
        endif
      endif
      '
      '
      'VOID TYPES
      '==========
      '
      if b=0x10
        if c
          'b=0
          if tind
            tind-- 'LPVOID TYPE
          endif
          wt="sys" : c-- : b=cpuw : w=cpuw : lent=cpuw
          'treat void* as direct inttem type
        else
          ers="direct void type unusable: "+wm+": "+w3 : ert=13 : exit procedure
        endif
      endif
      '
      ind=c
      '
      'dct=0 'each new var
      newrecord(w3)
      mrcsi(wt,me,3)     'NAME OF TYPE (BUT NOT UNDERLYING TYPEDEF)
      drc(me).a=k        '0 OR UNDERLYING TYPE OR TYPEDEF
      drc(me).b=w        'ELEMENT LENGTH (ignoring indrection)
      drc(me).d=c        'OVERALL LEVEL OF INDIRECTION
      drc(me).f=b        'TYPE CODE (UNDERLYING TYPE) (VOID*==SYS)
      '
      '
      '=========
      'CONSTANTS
      '=========
      '
      if cnst
        drc(me).h or=1 'const flag
        i++ 'skip '='
        dv=metaval(s,i,w1,it)
        mrcsi("="+w1,me,1) 'EXPRESSION OF CONSTANT VALUE
        addme
        skipspace(s,i)
        continue do 
      endif
      '
      '
      v=w                'UNIT SIZE OF PRIMITIVE OR STRUCTURE
      if c
        v=cpuw           'SIZE OF POINTER
      endif
      poff=aoff
      '
      '
      '#######  #############
      'ARRAYS   #  #  #  #  #
      '#######  #############
      '         #  #  #  #  #
      '         #############
      '         #  #  #  #  #
      '         #############
      '
      '
      '
      'CHECK FOR ARRAY TYPE
      '
      if arv
        inserts(s,ary,i) 'itr array of arrays not supported
      endif
      '
      v=w
      '
      if tind
        v=cpuw 'var of indirect type
      endif
      '
      'check for arrays
      '================
      '
      int cta
      int sca[32]
      string wa[32]
      wd=""
      cta=0
      arwd=1
      if ascw=126 '~'
        exit sub 'silently discard
      endif
      skiplspace(s,i)
      if ascn=91
        fixsqbr(s,i) 'CONVERT '[..]' TO '(..)'
      endif
      if ascn=lbr
        i++
        skiplspace(s,i)
        flagv or=2 'ARRAY FLAG
        if c>tind
          flagv or=4 'DYNAMIC FLAG
          if ascn=0x72 'r'
            if tword(s,i)="redim"
              flagv or=16 'REDIM FLAG
            else
              i=swd 'revert
            endif
            skiplspace(s,i)
          endif  
        endif
        if ascn=rbr
          flagv or=8 'NO TERMS GIVEN FLAG
          i++
          skiplspace(s,i)
          cta=1
          goto narray 'EMPTY ARRAY
        endif
        '
        rarray: 'repeat for each dimension
        ==================================
        '
        cta++
        skiplspace(s,i)
        m=metaval(s,i,w1,0)-ixb+1
        if ert
          if flagv and 4 '16
            if ert=503 or ert=504
              ert=0
              m=1
            endif
          endif
          if ert
            exit procedure
          endif
        endif
        arwd*=m
        sca(cta)=m
        '
        if ascn=44 'comma
          i++
          goto rarray 'more dimensions
        elseif ascn=rbr
          i++ 'skip right bracket
          skiplspace(s,i)
          if ascn=44
            i++ : skiplspace(s,i)
          endif
          if ascn=91
            fixsqbr(s,i)
          endif
          if ascn=lbr
            i++
            goto rarray
          endif
        endif
        if c<=tind
          'static arrays only
          'spanof and dimsof
          wd=str(arwd)+" "+str(cta) 'record element count and dimensions
          v*=arwd
          mrcsi(wd,me,2)
        endif
        '
      endif 'ascn=lbr array handling
      '
      narray:
      =======
      '
      drc(me).h=flagv    'FLAGS 
      '
      'see bindrec
      if c>tind
        v=cpuw 
        'one pointer to variable or array
        'otherwise a direct array or direct array of pointers
      endif
      '
      'ALIGNMENT
      'if regs=qebx 'ebx' or 'rbx'
      '  a=8 'compatible with 32/64 bit shared memory
      'else
      '  a=cpuw
      'endif
      if lclv
        a=cpuw
      else
        a=8
      endif
      roundupc(v,a) 'ALIGN FOR 32/64BIT
      '
      'STEP UP OR DOWN
      '---------------
      '
      'itr SIMD 128bit alignments
      '
      int vo
      vo=0
      'TO CREATE TABLE SPACE FOR DIM ATTRIBS
      if cta>=1
        vo=vot+(cta*8)
      endif
      '
      if asce=1
        if prmf 'params (local)
          vo=0
        endif
        aoff=aoff+v+vo
        a=poff+vo 'attribs are below start of array
      else 'asce -1
        aoff-=v
        a=aoff 'attribs are below start of array
        aoff-=vo
        'ASSUME ALL DESCENDING VARIABLES ARE LOCAL
        mlcl+=v+vo 'atr coupled variables, no space allocation will be required
      endif
      '
      drc(me).c=a                'OPERAND OFFSET
      mrcsi(memreg(regs,a),me,1) 'ENCODE OPERAND: [ebx+1234]
      '
      if vo>0
        int ad=a
        int am
        string sa=""
        '
        subroutine arda
        --------------- 
          ad-=4
          sa="mov dword "+memreg(regs,ad)+cm+str(am)+cr
          appendt(sa)
        end subroutine
        '
        am=flagv  : gosub arda 'flagsof
        am=arcm   : gosub arda '#majorminor 0, #minormajor 1
        am=cta    : gosub arda 'dimensions
        am=arwd   : gosub arda 'total elements
        '
        int aa,ab,ai,aj,aq
        if arcm=0
          ai=cta : aj=-1 '#majorminor
        else 'arcm=1
          ai=1 : aj=1 '#minormajor
        endif
        'make scaler and ubound records
        ab=1
        for aa=1 to cta
          aq=ad-(ai*8)
          sa="mov dword "+memreg(regs,aq)+cm+str(ab)+cr+
             "mov dword "+memreg(regs,aq+4)+cm+str(sca(ai))+cr
          appendt(sa)
          ab=sca(ai)*ab 'up scaler
          ai+=aj 'stride back or fwd
        next
      endif 'vo
      '
      'nmultidim
      '=========
      '
      'REGISTERS / VAR LINKAGE
      '=======================
      '
      '
      if ascn=97
        if wordahead(s,i)="at"
          '
          'AT
          '===
          '
          i=nwd
          skiplspace(s,i)
          b=drc(me).d+1 'indirection
          v=0
          '
          'indirection level
          '
          do
            if ascn=35 '#name
              wr=tword(s,i)
              wr="["+wr+"]" 'HOST VAR ADDRESS #VAR
              b--
              ascw=91
              exit do '#HostVar address
            endif
            wr=mword(s,i)
            'see bindrec
            if ascn=126 '~' 'BIND' IMPORTED VARIABLE BYREF
              i++
              wpfx="mov "+qedi+cm+wr+cr
              wr=mword(s,i)
              b--
              exit do
            endif
            if (ascw=38)or(ascw=64) '&' '@'
              b--
              continue do
            elseif ascw=42 '*'
              b++
              continue do 'indirection
            endif
            exit do
          loop
          '
          if mc=-10 'REGISTERS
            if b>0
              wr="["+wr+"]"
              b--
              ascw=91
            else
              typ=cpuw
            endif
          else 'NOT REGISTERS
            a=typ
            if b=0
              a=cpuw 'ALLOW ADDRESS COUPLING
              if mp
                v=drc(mp).c 'TRANSFER OFFSET VALUE
              endif
            endif
            if (ascw<>91)or(isfloat(a)<>0)
              ers="Must use simple sys variable" : wr=ow : ert=122 : exit procedure
            endif
          endif
          '
          'ALTER RECORD
          mrcsi(wpfx+wr,me,1)
          aoff=poff ' no change to offset
          drc(me).c=v  'OPERAND OFFSET
          drc(me).d=b  'INDIRECTION
        endif 'AT linkage
      endif 'ascn=97
      '
      natreg:
      =======

      drc(me).e=tind 'TYPE INDIRECTION LEVEL (needed for arrays)
      '
      'DECLARATION IN CODE
      '===================
      '
      string ss
      ss=mrcso(me,1)
      replace(ss,cr,":")
      w1=mrcso(me,0)
      if asc(w1)=127
        w1="temp_"+mid(w1,2)
      endif
      appendt("|va "+w1+" "+mrcso(me,3)+" "+ss+cr)
      '
      '
      addme 'COMPLETED VARIALE RECORD
      '
      '
      'POSSIBLE CONSTRUCTOR
      =====================
      '
      if ind=0
        if it>=typh
          if findop(it,"init",w2)
            hiex+=w2+"("+w3+cm+str(arwd)+")"+cr
            rps=1
          endif
        endif
      endif
      if (ind=0)and(hasd<>0)
        wr=mrcso(qme,1)
        'null variables check to be done by macro
        w1=dstr+"("+w3+cm+str(arwd)+")"+cr
        if lclv
          if asce=-1
            appe(epgs(brc),epgi(brc),w1) 'no param vars
          endif
        else
          if instr(wr,"bx")
            appe(epgs(0),epgi(0),w1) 'static vars
          endif
        endif
      endif
    loop 'NEXT VARIABLE
    nextinstruct(s,i)
    if ise(ascn)=0
      mc=0 : goto varss 'FURTHER VAR STATEMENTS
    endif
    '
    xvars:
    '
    if lclv=0
      aoffs=aoff
    endif
    flagv=0
end procedure 'vars



procedure declvars(string*s, int n)
===================================
  int a,b
  if s=""
    exit procedure
  endif
  if n=1
    localvars()
    lcl=1
  elseif (n=3)or(n=4)
    staticvars()
  endif
  '
  vars(s) 'CREATE VARIABLE
  '
end procedure



procedure varsal(string*s)
'=========================
int n=1 'default local space
if funi=0
  n=3 'use static space
endif
declvars(s,n)
end procedure



function NewTmpVar(string*ty) as string
=======================================
int a
string va
tmpi++
va=NewTmpName()
vars(ty+" "+va)
if funi
  if lclv
    lcl=1
    if isstr(typ)
      lcls=1
    endif
  endif
endif
return va
end function


function tmpvar() as string
===========================
varsal("8 "+newTmpName())
return mrcso(qme,1) 'RETURN OPERAND [ebp-xxxx]
end function


'#                 #
'###################
'###    TYPES    ###
'###################
'##     #####     ##
'       #####
'       #####
'       #####     ##    ##     ######       #####
'       #####     ##    ##     ##    ##   ##     #
'       #####     ##    ##     ##    ##   ########
'       #####      #######     ######     ##
'       #####           ##     ##         ##     #
'       #####           ##     ##          ######
'      #######     #####

' aml   array size multiplier
' buil  table builder string
' wmn   union base offset
' wmx   union max offset
' pof   offset value building def
' vof    next offset value building def
' vp    hold offset for inherited strucs



procedure CaptHead(string *s, int*i)
====================================
  int a,c
  string w1
  do
    skiplspace(s,i)
    if ise(ascn)
      c=i : nextinstruct(s,i)
      if ascn<>lbr
        i=c : exit do
      endif
    endif
    if (ascn=123)or(ascn=61)or(ascn=sr1)
      exit do 'FUNCTION .. {}   FUNCTION .. =
    elseif ascn=lbr
      if a
        exit do 'assume start of body
      endif
      capturi(s,1,1,i)
      a=1 'flag prototype capture
      continue do
    else
      w1=tword(s,i) 'EAT WORD
    endif
  loop
end procedure


procedure CaptBody(string *s, int i, *d, int mo)
================================================
  string w1,w2,w3
  int a,b,c,g
  '
  d=0
  '
  'LOOKAHEAD FOR BODY CONTAINED BY {..}
  '------------------------------------
  '
  nextinstruct(s,i)
  '
  if ascn=123
    capturi(s,1,1,i)
    endline(s,i)
    d=i+2
    exit procedure
  elseif ascn=61
    endline(s,i)
    d=i+2
    exit procedure
  endif
  '
  'SPECIAL BLOCK CAPTURE
  '---------------------
  '
  do
    g=i
    c++
    w2=tword(s,i)
    if lenw=0
      exit do 'UNEXPECTED END
    endif
    b=dic(" function 1, procedure 1, sub 2, method 3, type 4, class 5, ",w2)
    if b 'INNER BLOCKS
      if isa(ascn)
        w1=w2
        w3=wordahead(s,i) 'POSSIBLE NAME
        if idword(" and or xor ",w3)=0
          if b<=3
            if c=1
              if mo=2
                exit do 'ANOTHER HEAD, NOT A BODY
              endif
            endif
          endif
          'OTHERWISE:
          'PROCEDURE/FUNCTION INSIDE A PROCEDURE/FUNCTION ETC
          if b=2
            if issub(s,i)=0
              endline(s,i) : continue do
            endif
          endif
          if b<=3
            CaptHead(s,i)
          else
            w2=tword(s,i) 'SWALLOW NAME
          endif
          'NO RECURSION
          captureb(s,i,1,1,w1)
          if mo=3
            continue do  'NO CAPTURE
          endif
          w1="static "+mid(s,g,i-g)+cr
          midspace(s,g,i)
          if uniq
            w1="#unique off"+cr+w1+"#unique on"+cr
          endif
          defpro+=w1
          undefpro+="undef "+w3+cr
        endif
      endif
    elseif w2="exit"
      w2=tword(s,i) 'SKIP EXIT NAME
    elseif (w2="end")and(isxn()=0)
      w2=tword(s,i)
      if lenw=0
        exit do 'UNEXPECTED END OF PROGRAM
      endif
      if idword(" function procedure sub method ",w2) 'END 
        endline(s,i)
        if ascn=13
          i+=2
        endif
        d=i
        exit do 'CONFIRMED BODY NOT JUST HEADER
      endif
    elseif ascw=35 
      if left(w2,3)="#if"
        metaskip(s,i,2) 'METABLOCK
      endif
    elseif (ascw=lbr)or(ascw=123)
      i=swd : capturi(s,1,1,i) 'SKIP (..) {..}
    elseif isc(ascw)
      endline(s,i)
    endif
  loop
  '
end procedure
 



