


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

procedure massign(string*s, int *i)
===================================
  string wr,wm,wp,ws,wt,wc,w1,w2
  int a,b,d,j,k,n,eb
  wr=mrcso(mp,1)
  w2=typename(typr)+"*"
  wr=newtmpvar(w2)
  a=me-1
  d=drc(mp).e
  drc(a).e=d
  drc(a).d=d+1
  wp=string(d+1,"@") 'ptrlevel
  w1=wp+wr+"="+wp+owa+cr 'address
  if d 'a pointer var
    wt="+="+str(cpuw)+cr
  else
    wt="+=sizeof "+wr+cr
  endif
  appe(ws,j,w1)
  nextinstruct(s,i)
  if (ascn=61)or(ascn=62)
    i++ 'skip ' = >  
    nextinstruct(s,i)
  endif
  if ascn=40
    eb=41 ')
    i++
  elseif ascn=123
    eb=125 '}
    i++
  endif
  nextinstruct(s,i)
  if typr>=typh
    wm=mrcso(typr-typh,1)
    w2=mrcso(typr-typh,2)
    if w2
      inserts(s,w2,i) 'default params
    endif
  endif
  elct=0
  do
    n=0
    if eb ') }
      nextinstruct(s,i)
      if ascn=eb
        i++
        exit do
      endif
    else 'end of line
      skiplspace(s,i)
      if ise(ascn)
        exit do
      endif
    endif
    wc=captsx(s,i)
    a=0
    b=asc(s,swd)
    if b=46
      if asc(s,swd+1)>0x39 'not a number
        a=1
      endif
    endif
    if a
      w2=""
    elseif typr>=typh
      if b=123
        w2="=" 'whole array element
        k=0
        n++
      else
        w2="."+nextmembname(wm,k,0)+"="
        if k=0 'rollover
          w1=wp+wr+wt 'stride
          appe(ws,j,w1)
          w2="."+nextmembname(wm,k,0)+"="
        endif
      endif
    else
      w2="="
      n++
    endif
    w1=wr+w2+wc+cr 'assign
    appe(ws,j,w1)
    if n
      w1=wp+wr+wt 'stride
      appe(ws,j,w1)
    endif
    if ascn=44 ',
      i++
      elct++
      nextinstruct(s,i)
    endif
  loop
  inserts(s,left(ws,j),i)
end procedure


function findop(int ty, string *name,*mthd) as int
==================================================
  int a,u
  if name
    u=ty-typh
    if u>=0
      mthd=mrcso(u,0)+"_"+qu+name+qu
      a=lookupm(mthd) 'OPERATIONS GROUP NAME
    endif
  endif
  if a=0
    mthd=""
  endif
  return a
end function


procedure metaskip(string*s, int*i,f)
=====================================
  'new supporting #macro
  'destructive # skip
  '
  int a,b,c,d
  string wr,ke,ek
  if f=4
    ke="#macro"
    ek="#endmacro"
  else 'f=0 1 2
    ke="#if"
    ek="#endif"
  endif
  b=i
  wr=tword(s,i) 'ALWAYS SKIP FIRST WORD
  do
    if ascn=0
      exit do 'PREMATURE END OF STRING TREATED AS TERMINATOR
    endif
    '
    wr=tword(s,i)
    if isc(ascw) 'comment detected
      endline(s,i) : continue do
    endif
    '
    if ascw=35
      '
      '------------------
      'SAME NESTING DEPTH
      '------------------
      '
      if d<=0 
        '
        'f=0: BLANK OUT TILL THE NEXT #ELSE / #ELSEIF / #ENDIF
        'f=1: BLANK OUT TILL #ENDIF
        'f>1: NO BLANKING (SKIP TO #ENDIF ONLY)
        'f=4: SKIP TO #ENDMACRO
        '
        if f=0
          if (wr="#else")or(wr="#elseif")
            '
            'BLANK OUT THE PRIOR CODE WHICH FAILED THE CONDITION
            '
            midspace(s,b,i)
            '
            if wr<>"#else"
              '
              'REPLACE (#IF #ELSEIF) WITH #IF
              '
              i-=4 : mid(s,i)="#if " 'PATCHED BACK INTO CODE STREAM
              '
            endif '#ELSE
            '
            exit procedure 'DONE
            '
          endif '#ELSE #ELSEIF
          '
        endif 'f=0
        '
        if wr=ek
          exit do
        endif
        '
      endif 'd<=0
      '
      'ADJUST DEPTH
      '------------
      '
      if f>2 '4
        if wr=ke
          d++
        endif
      else
        if left(wr,3)=ke
          d++ 'INCREASING NESTING DEPTH
        endif
      endif
      '
      if wr=ek
        d-- 'DECREASING NESTING DEPTH
      endif
      '
    endif
  loop
  '
  if f<2
    midspace(s,b,i) 'BLANK ALL
  endif
  '
  if f<3 '4
    skiplspace(s,i)
  endif
  '
end procedure

/*
procedure ometaskip(string*s, int*i,f)
=====================================
  'original
  'destructive # skip
  '
  int a,b,c,d
  string wr
  b=i
  wr=tword(s,i) 'ALWAYS SKIP FIRST WORD
  do
    if ascn=0
      exit do 'PREMATURE END OF STRING TREATED AS TERMINATOR
    endif
    '
    wr=tword(s,i)
    if isc(ascw) 'a comment detected
      endline(s,i) : continue do
    endif
    '
    if ascw=35
      '
      '------------------
      'SAME NESTING DEPTH
      '------------------
      '
      if d<=0 
        '
        'f=0: BLANK OUT TILL THE NEXT #ELSE / #ELSEIF / #ENDIF
        'f=1: BLANK OUT TILL #ENDIF
        'f>1: NO BLANKING (SKIP TO #ENDIF ONLY)
        '
        if f=0
          if (wr="#else")or(wr="#elseif")
            '
            'BLANK OUT THE PRIOR CODE WHICH FAILED THE CONDITION
            '
            midspace(s,b,i)
            '
            if wr<>"#else"
              '
              'REPLACE (#IF #ELSEIF) WITH #IF
              '
              i-=4 : mid(s,i)="#if " 'PATCHED BACK INTO CODE STREAM
              '
            endif
            '
            exit procedure 'DONE
            '
          endif '#ELSE ETC
          '
        endif 'f=0
        '
        if wr="#endif"
          exit do
        endif
        '
      endif 'd<=0
      '
      'ADJUST DEPTH
      '------------
      '
      if left(wr,3)="#if"
        d++ 'INCREASING NESTING DEPTH
      endif
      '
      if wr="#endif"
        d-- 'DECREASING NESTING DEPTH
      endif
      '
    endif
  loop
  '
  if f<=1
    midspace(s,b,i) 'BLANK ALL
  endif
  '
  skiplspace(s,i)
  '
end procedure
*/


function cword(string*s, int*i) as string
=========================================
  string wr
  wr=tword(s,i)
  if (ascw=37)or(ascw=36)
    'IGNORE % $ PREFIX
    mid(s,swd)=" " : wr=tword(s,i)
  endif
  function=wr
end function



function sval(string*s, int*i) as double
========================================
  int a
  a=instr(i,s,rmk)
  if a
    function=val(mid(s,i,a-i)) : i=a+1
  endif
end function


function wordorblock(string*s, int*i) as string
===============================================
string w1
int m,b
if ascn=lbr
  capturi(s,m,b,i)
  w1=mid(s,m,b)
  'w1=captureblock(s,i,"")
  w1=ltrim(rtrim(w1))
  return w1
else
  return noquotes(mword(s,i))
endif
end function


function metaval(string*s, int*i, string*wa, int tp) as double
==============================================================
  '
  'newline=0
  int    a,k,n,t,o,r,igb,mct,wtal,wtaf,opr
  double b,v,w
  string w1,w2,wr,wp,ws
  int    m=i,j=instr(i,s,cr)
  '
  if j=0
    j=len(s)+1
  endif
  '
  'INSERT BRACKETS TO ESTABLISH OPERATOR PRECEDENCE
  '
  'if ascn=lbr
  '  i++ : igb=1  'IGNORE OUTER BRACKETS
  'endif
  '
  if nprec=0
    met=1 : w1=precedence(s,i,0) : met=0
    inserts(s,w1,i)
  endif
  '
  wa=""
  opr=1 'PRELOAD OPERATOR
  ascw=0
  skiplspace(s,i)
  '
  if (ascn=45)or(ascn=43)
    opr=0
  endif
  '
  do
    '
    'OPERATIONS
    '==========
    '
    w=0
    '
    ' -(v)
    if ascn=95 'neg expression 
      if wordahead(s,i)="_neg"
        i=nwd : v=-v : skiplspace(s,i)
        continue do
      endif
    endif
    '
    if opr=1
      wr="" 'LOAD OPERAND
    else
      wr=tword(s,i) 'GET OPERATOR
      opr=identop(s,swd,i)
      if opr=0
        if ascw=61
          opr=101 'COMPARE '='
        elseif ascw=lbr '((.. MULTIPLE BRACKETS
          opr=1
          i=swd : skiplspace(s,i)
        endif
      endif
    endif
    '
    if (opr<>0)or(ascw=rbr)
      '
      'UNSTACK OR GET NEXT OPERAND
      '---------------------------
      '
      k=1
      if ascw=rbr
        w=v
        n=sval(ws,k)
        v=sval(ws,k)
        opr=asc(ws,k)
        k+=2
        ws=mid(ws,k)
        if n
          m=w : m=not m : w=m
        endif
        goto metoperate
      endif
      '
      '========================================
      operands: 'recursion expansion loop point
      '========================================
      '
      '
      =======
      rmwops:
      =======
      '
      wp=cword(s,i)
      '
      if ascw=92
        continue do '\' C style line continuation
      endif
      '
      if isq(ascw)
        wa+=noquotes(wp)  ' ACCUMULATE STRINGS
        wtal++
      endif
      '
      b=0 : n=0
      '
      'EXAMPLES:
      '---------
      '
      ' #IF NOT (...)
      ' #IF NOT DEF ( X )
      ' OR NDEF ( X )
      ' AND NOT (...)
      'NOT DEF NDEF
      '----------------
      '
      if (wp="not")or(wp="!")
        n=not n 'APPLIED LATER
        wp=cword(s,i)
      endif
      '
      if ascw=lbr 'METASTACK
        ws=str(n)+rmk+str(v)+rmk+chr(opr)+rmk+ws
        v=0
        n=0
        skiplspace(s,i)
        if (ascn=45)or(ascn=43)
          opr=0 'PICKUP OPERATOR
        else
          opr=1 'LOAD OPERAND
        endif
        continue do
      endif
      'META FUNCTIONS
      b=dic(" def 1, ndef 2, defined 1, undefined 2, 
        match 3, leftmatch 4, rightmatch 5, anymatch 6,",wp)
      if b
        if b=2
          n=not(n) 'LATER APPLY OPPOSITE LOGIC
        endif
      elseif wp="#str"
        wtaf=1 : continue do
      elseif wp="#hex"
        wtaf=2 : continue do
      elseif wp="null"
        wp="0"
      endif
      '
      if b
        w=0 'CLEAR OPERAND
        if ascn=lbr
           i++ : r=1 'IGNORE (
          skiplspace(s,i)
        endif
        if nisxn
          if b>2 'MATCH STRING
            w1=wordorblock(s,i)
            if ascn=44
              i++
              skipspace(s,i)
            endif
            w2=wordorblock(s,i)
            if b=4
              w1=left(w1,len(w2)) '#if leftmatch "qwerty", "qwert"
            elseif b=5
              w1=right(w1,len(w2)) '#if rightmatch qwerty, "erty"
            endif
            clcase(w1) : clcase(w2) 'APPLY CASE CONVERSION
            if b=6 'anymatch
              if idword(w1,w2) '#if " gosub goto call " ,"goto" 
                w1=w2
              endif
            endif
            if w1=w2
              m=w : m=not m : w=m 'SET TRUE
            endif
            goto nvaldone
          endif 'b>2
          '
          wp=cword(s,i)
          '
          if isa(ascw)
            ;
            ExciseBr:
            =========
            if isb(ascn) 'brackets
              capture(s,0,i,0)
              skiplspace(s,i)
              if ascn=46 '.' dot
                wp+=cword(s,i)
                'dtf=1
              endif
              goto ExciseBr
              'until no more brackets
            endif 'isb
            '
            mp=lookupm(wp)
            if mp=0
              '
              'CHECK FOR MEMBERS
              if dtf
                wp=mword(wp,1)
                skiplspace(s,i)
                '
                if ert
                  'SUPRESS ERRORS
                  mp=0 : ert=0 : ers=""
                endif 'ert
              endif 'dtf
            endif 'mp=0
            '
          else 'symbol number quote
            mp=-1 'ALWAYS DEFINED
          endif 'isa ascn
          if mp
            m=w : m=not m : w=m 'SET TRUE
          endif
        else 'not nixn
          'void
        endif 'nisxn
        '
        nvaldone:
        '          
        if ascn=rbr
          if r
            i++'IGNORE )
          endif
        endif
        '
        'TO INVERT LOGIC
        if n
          m=w : m=not m : w=m 
        endif
        wp=""
        r=0
        jmp fwd metoperate
      endif 'b meta functions
      '
      'EVALUATE WORD (NO META FUNCTION)
      if wp

        'CHECK IF LITERAL NUMBER / STRING
        '--------------------------------
        '
        a=asc(wp)
        if (isn(a)<>0)or(a=38)
          w=wdval(s,swd,i)
          goto metoperate
        elseif isq(a)
          goto metoperate
        endif
        '
        '
        'CHECK IF SYMBOL
        '---------------
        '        '
        a=lookupm(wp)
        '
        if a=0
          w=0
          if asc(wp)=35
            sys pw
            pw=getvarptr(wp)
            w=pw
            if w=0
              ert=502 : ers="Can't find Symbol: "+wp : exit do
            endif
          else
            if asc(wp)=91
              i--
              capts(s,i) 'skip [..]
              ert=503  : ers="cannot use variable as constant"
            else
              ert=504 : ers="Undefined Symbol: "+wp
            endif
            skiplspace(s,i)
            exit do
          endif
          '
        else 'a>0 found
          '
          'ACCEPT $ % DEF #DEFINE MACRO metatypes
          '--------------------------------------
          '
          inserts(s,wp+" ",i)
          wr=mword(s,i)
          if wr<>wp
            if nmb
              w=val(wr)
              goto metoperate
            endif
            inserts(s,wr+" ",i)
            mct++ 
            if mct>100
              ert=505
              ers="Recursion suspected in macro expression" : exit do
            endif
            goto rmwops
          endif
        endif
      endif 'wp
      '
      '----------
      metoperate:
      '----------
      '
      wp=""
      b=v
      '
      '-------------------------
      ' V ACCUM   W OPERAND
      '=========================
      '
      sys vi=v
      sys wi=w
      select opr
      case 1  : v=w
      case 33 : vi and=wi : v=vi
      case 34 : vi or=wi : v=vi
      case 37 : vi or=wi : v=vi
      case 35 : vi xor=wi : v=vi
      case 74 : vi=vi << wi : v=vi
      case 75 : vi=vi >> wi : v=vi
      case 43 : v+=w
      case 45 : v-=w
      case 42 : v*=w
      case 47 : v/=w
      case 92 : v\=w
      '
      'booleans and/or/xor
      '
      case 71 : v=0 :
        if (b<>0)and(w<>0)
          v=-1
        endif
      case 72 : v=0 :
        if (b<>0)or(w<>0)
          v=-1
        endif
      case 73 : v=0 :
        if b<>w
          v=-1
        endif
      end select
      '
      'comparators
      '
      if (opr>=20)and(opr<32)
        v=0
        select opr
        '
        case 20 :
          if b=w
            v=-1
          endif
        case 28 :
          if b<w
            v=-1
          endif
        case 30 :
          if b<=w
            v=-1
          endif
        case 21 :
          if b<>w
            v=-1
          endif
        case 31 :
          if b>w
            v=-1
          endif
        case 29 :
          if b>=w
            v=-1
          endif
        end select
      endif
      opr=0
      '
    endif ' OPERATORS
    '
    '
    '======================================
    checkendost: 'CHECK IF END OF STATEMENT
    '======================================
    '
    skiplspace(s,i)
    '
    if ascn=rbr
      if ws=""
        exit do
      endif
    endif
    '
    if (ascn<=32)or(ascn=93)or(ascn=44)or(ascn=sr1)
      exit do ' end of [...] , :
    endif
    '
    'NEXT OPERATOR OR BRACKET
    '------------------------
    '
    '
  loop ' # EXPRESSION LOOP
  '
  if wtal+wtaf=0
    wa=str(v)
  else
    if wtaf
      if wtaf=1
        wa+=str(v)
      elseif wtaf=2
        wa+=hex(v)
      endif
    endif
    wa=qu+wa+qu
  endif
  ascw=asc(wa)
  function=v
end function



function caseval(string*s, int*i) as int
========================================
  int a
  string w1
  w1=mid(s,swd,5)
  a=instr(2,w1,"'")
  if (a>0)and(a<=4)
    lenw=a
    i=swd+lenw
    a=asc(w1,2)
    if a=92
      a=asc(w1,3)
      select a
      case 0x62 : a=8  '\b back
      case 0x6e : a=10 '\n linefeed
      case 0x72 : a=13 '\r return
      case 0x74 : a=9  '\t tab
      end select
    endif
    w1=str(a) 'translate into byte value
    mid(s,swd)=w1+space(lenw-len(w1))
    ascw=asc(w1)
  else 'a comment '...
    endline(s,i) : return 0
  endif
  return 1
end function


function defndef(string *s, int *i, c) as int
=============================================
  int a
  int v=-1 'presume true
  string wr
  a=i
  wr=tword(s,i)
  if isa(ascw)
    mp=lookupm(wr)
    if mp=0
      i=a
      wr=mword(s,i) 'affects mp
      if ert
        mp=0 : ert=0 : ers="" 'SUPPRESS ANY ERRORS
      endif
    endif
  else 'not alpha
    mp=-1
  endif
  if c=1
    if mp<>0
      v=0
    endif
  else 'c=0
    if mp=0
      v=0
    endif
  endif
  return v
end function


procedure metaco(string*s, int*i)
=================================

  int a,b,c,d,m,ft,mb
  double v
  string wr,w1,w2,w3,w4,w5,w6,wt
  '
  mb=swd ' START OF BLOCK
  '
  c=md
  '
  'new
  '-------------------------
  'HIGH LEVEL '#DEFINE MACRO
  '=========================
  '
  if (md=104)or(md=109)or(md=114)
    w1=tword(s,i)
    ' 
    'CHECK FOR PARAMS IN BRACKETS
    '----------------------------
    '
    a=0
    '
    if md=109 'MACRO
      if idword(" function sub procedure ",w1)
        'ft=1
        w1=tword(s,i)
      endif
      if ascn=lbr
        a=1
      else
        if nisxn
          wt=tword(s,i) 'RETURN TYPE
          if wt="as"
            wt=tword(s,i)
          endif
          ft or=2
          a=instr(i,s,"(")
          if a>i
            wt+=mid(s,i,a-i) : i=a : ascn=lbr
            wt=rtrim(wt)
          endif
        endif
      endif 'ascn=lbr
    else '104  #define or 114 #macro
      if ascn=lbr
        '
        'MUST BE NO SPACE BETWEEN IDENTIFIER AND BRACKET EG: M(A, B, C)
        '
        if i=swd+len(w1)
          a=1
        endif
      endif
    endif
    '
    'IF PARAMETERS WERE DETECTED...
    '
    if a
      'see himac
      c=i
      capturi(s,m,b,i)
      w3=mid(s,m,b)
      striplineno(w3)
    else 'params not detected
      w3=""
    endif
    '
    '-------
    nmparam:
    '-------
    '
    skiplspace(s,i)
    '
    '-------
    '#DEFINE or #MACRO
    '=================
    '
    'CHECK FOR C TYPE QUOTE ' ' AND MULTILINE \ ASCII 92
    '
    if md<>109 '(md=104) or (md=114)
      m=i
      do
        do
          if (ascn=13)or(ascn=10)or(ascn=0)
            ascw=0 : exit do
          endif
          icas=1
          w2=bword(s,i)
          if ascw=39
            caseval(s,i) 'A'
          elseif ascw=92
            if md=104 '#define
              exit do '\'
            endif
          endif
        loop 'EACH WORD IN LINE
        '
        if ascw<>92 '\'
          exit do
        endif
        mid(s,swd)=" " : ascn=32 'BLANK OUT `\`
        endline(s,i) : i+=2
        skiplspace(s,i)
      loop 'EACH LINE
      b=i-m
      w2=mid(s,m,b)
      striplineno(w2)
    endif
    '
    'OTHERWISE CAPTURE BLOCK
    '
    '-----
    'MACRO
    '=====
    '
    if md<>104 '109 or 114
      '
      if md=109
        captureb(s,i,m,b,"macro")
      else 'md=114
        m=i
        metaskip(s,i,4) '#macro
        b=swd-m
        endline(s,i)
      endif
      skiplspace(s,i)
      if ise(ascn)=0
        endline(s,i) : b=i-m ' (...) ...
        if asc(s,m-1)=lbr
          m-- : b++ 'INCLUDE LEFT BRACKET
        endif
      endif
      '
      macapture:
      '=========
      '
      w2=mid(s,m,b)
      striplineno(w2)
      nocomments(w2)
      skiplspace(s,i)
    endif 'md=109 or mb=114
    '
    if b>0
      nofinalcr(w2)
    else 'empty macro
      w2=""
    endif
    '
    'see himac encode params
    '
    dct=0 'reset recursion counter
    newrecord(w1)
    mrcsi(w2,me,1)  'BODY
    mrcsi(wt,me,2)  'RETURNTYPE
    mrcsi(w3,me,3)  'PROTOTYPE
    drc(me).a=-20   'METATYPE HIGH LEVEL MACROS
    drc(me).d=ft    'MACRO FUNCTION FLAGS
    drc(me).f=md    '104 for '#define'  109 for 'macro'
    addme
    exit procedure
    '
  elseif md=107 'UNDEF '#UNDEF '#UNDEFINE
    do
      if isxn
        exit do
      endif
      wr=tword(s,i) : mp=lookupm(wr)
      if mp
        select drc(mp).a
        case -5 'append signature
          w1=mrcso(mp,1)
          wr+=splitsig(w1)
        case -4,-29,-30 'metatypes involving labels
          appendt("o2 z"+wr+cr) 'linker zap label instruction
        end select
        mrcsi(cr,mp,0) 'knockout name
      endif
      if ascn=44
        i++ : skiplspace(s,i)
      endif
    loop
    exit procedure
    '
    '
  elseif md=108 'ALIAS TYPE AS OTHERNAME (thinBasic)
    dct=0 'each alias
    w1=tword(s,i) : nextspace(s,i) : wr=tword(s,i)
    newrecord(wr)   'NAME
    mrcsi(w1,me,1)  'TYPE
    drc(me).a=-18   'METATYPE
    addme
    exit procedure
  '
  '
  elseif c=100 '#IF
    v=metaval(s,i,wr,0)
  elseif c=110 '#PRINT
    v=metaval(s,i,wr,0)
    wr=noquotes(wr)
    print wr 'display #print result
    exit procedure
  '
  'AFTER ACCEPTING VALID BLOCK:
  'DELETE REMAINDER
  elseif (c=101)or(c=102) '#ELSE #ELSEIF
    i=mb : metaskip(s,i,1) 'BLANK OUT ALL INCLUDING THE TERMINATING #ENDIF
    goto xmetaco
  '
  elseif c=103 '#ENDIF
   v=-1
  '
  elseif (c=105)or(c=106) '#IFDEF '#IFNDEF
    '
    if nisxn
      v=defndef(s,i,c-105)
      skiplspace(s,i)
    else 'isxn
      if c=105
        v=0 'NO OTHER WORD ON THE LINE
      else
        v=-1
      endif
    endif
    '
  elseif c=113 '#EVAL
    v=metaval(s,i,wr,0)
    inserts(s,wr,i)
    exit procedure
  endif
  '
  '-----------
  'META ACTION
  '===========
  '
  if v=0
    '
    'BLANK OUT THIS INVALID BLOCK INCLUDING THE META EXPRESSION
    'BUT STOP WHEN #ELSE #ELSEIF ALTERNATIVE IS ENCOUNTERED
    '
    i=mb : metaskip(s,i,0)
  else
    '
    'THE BLOCK IS VALID THEREFORE
    'BLANK OUT THE TESTING META EXPRESSION ONLY
    '
    'endline(s,i)
    midspace(s,mb,i)
  endif
  '
  xmetaco: 'DONE
end procedure



procedure EncodeEquate(string*s, int*i)
=======================================
  'see lomac
  int a,b
  string wr
  b=asc(s,swd+1)
  if b=ascw  '%% $$
    i++
    swd++
    a=1
    b=asc(s,swd+1)
  endif
  if (b=61)or(46)or(b=42) '$= $. $* %= %. %*
    i++
  endif
  wr=tword(s,i)
  if isa(ascw)=0
   endline(s,i) : exit procedure 'MUST USE ALPHABETIC OR UNDERSCORE 
  endif
  if a
    if lookupm(wr)
      endline(s,i)
      exit procedure 'ALREADY DEFINED
    endif
  endif
  if ascn=61 'SKIP '='
    i++ : skiplspace(s,i)
  endif
  if b=61
    swd=i
    md=113 'EVALUATE TO SINGLE VALUE
    metaco(s,i)
  endif
  dct=0 'each equate
  newrecord(wr)
  if ert
    exit procedure
  endif
  a=i
  endline(s,i)
  wr=mid(s,a,i-a) 'single line only
  nocomments(wr)
  wr=ltrim(wr)
  mrcsi(wr,me,1)  'BODY
  drc(me).a=-18   'METATYPE
  drc(me).c=b     'MODE 61 46 42
  addme
end procedure


function expandm(string *s) as int
==================================
int a,b,c,d,f,i
string wr
b=swd
i=1
do
  if ascn=13
    newline=1
  endif
  wr=tword(s,i) 'itr oop dotted words
  d=swd
  if lenw=0
    exit do 'end of line
  endif
  if newline
    if ascw=37
      EncodeEquate(s,i)
      midspace(s,d,i)
      if ert
        exit function
      endif
      newline=0
      continue do
    endif
  endif
  a=lookupm(wr)
  if a
    c=drc(a).a
    '
    'MACRO EXPANSION
    '
    if (c=-18)or(c=-20)
      f=swd
      if c=-18
        wr=lomac(a,s,i)
      else
        wr=himac(a,s,i)
      endif
      s=left(s,f-1)+wr+mid(s,i) 'SUPPORTS MACRO PARAMETERS
      i=f
      function+=1 'tally expansions
      continue do  'recurse over macro
    endif
  endif
  'otherwise leave word as it is
loop
s+=" "
swd=b
ascn=asc s
end function


string resf="" ' .res filename
string rcf=""  ' .rc filename
string rss=""  ' .rc resource script

procedure includefile(string*s, int*i)
======================================
  '
  'CHECK FOR FILES ALREADY INCLUDED
  '--------------------------------
  '
  '
  '  #################
  '  # INCLUDE FILES #
  '  #################
  '  ###
  '  ###
  '  ###
  '  ##############
  '  ##############
  '  ###
  '  ###
  '  ###
  '  ###
  '  ###
  '  ####
  '  
  int a,b,c,d,e,f,p
  string wd,w1,w2
  string pch
  do
    wd=tword(s,i)
    if wd="once"
      a=1 : continue do
    endif
    i=swd : wd=lexiword(s,i)
    if ascw=60
      f=instr(2,wd,">")
      if f
        wd=mid(wd,2,lenw-2) : p=1
      endif
    endif
    exit do
  loop
  w1=filename(wd)
  if instr(w1,".")=0
    wd+=".inc" : w1+=".inc"
  endif
  w2=lcase(right(w1,4))
  if w2=".res" 'resource file
    resf=wd
    exit procedure
  elseif w2=".rc" 'resource file
    rcf=wd
    exit procedure
  endif
  if a
    b=1
    do
      if b>=fql
        exit do
      endif
      if ssn(b)
        if w1=ssn(b)
          c=1 : d=ssh(b) : exit do
        endif
      endif
      b++
    loop
  endif
  '
  ssn(fql)=w1 'NAME LOG (WITH HASH)
  '
  if wd
    if fq>63
      ers="Too many nested 'include' files "+wd : ert=40 : exit procedure
    endif
    if fql>999
      ers="Too many 'include' files "+wd : ert=40 : exit procedure
    endif
  else
    exit procedure
  endif
  '
  '
  'RESOLVE FILE PATH
  '
  if ipath
    wd=ipath+wd
    p=2
  elseif p
    wd="$\inc\"+wd 'ASSUME FILE IS IN THE INC FOLDER
  endif
  '
  if asc(wd)=36
    wd=rootpath(wd)
  else
    p=-1
  endif
  '
  if pPathCall
    wd=inclpath(wd)
  endif
  '
  sst(fq)=mid(s,i)  'SAVE REMAINING PARENTAL SOURCE CODE
  i=1
  '
  '
  s=getfile(wd)  'GET THE INCLUDE
  '
  'CHECK FOR EMPTY OR NON-EXISTENT FILE
  '
  if not s
    w1=wd
    if p=-1
      wd="$\inc\"+wd
      wd=rootpath(wd) 'LOOK IN THE INC FOLDER
      ert=0 'CANCEL ERROR
      s=getfile(wd) 'TRY AGAIN
    endif
  endif
  '
  if not s
    s=""
    i=1
    ers="Include file not found " w1
    ert=1003
    exit procedure 'ERROR GENERATED
  endif
  '
  'CHECK IF PRIOR FILE SEEMS IDENTICAL
  '
  e=hashid(s)
  '
  if c
    if d=e
      s=sst(fq) 'ALREADY SEEN SO REVERT TO PARENT
      exit procedure
    endif
  endif
  '
  ssh(fql)=e   'FILE CONTENT HASH
  sti(fq)=fql  'INDEX TO NAME & HASH LOG
  ssf(fq)=wd   'REMEMBER NAME
  '
  fq++        'INCR FILE STACK INDEX
  fql++       'INCR FILE LOG INDEX
  '
  ConvertUTF(s)
  LineMark(s)
  cfile=qu+wd+qu
  s="'_"+cfile+cr+s 'EMBED FILENAME
  '
end procedure


procedure intrirec(string*wt)
=============================
  '
  'ACCEPTS METATYPES -4 -9 -10 -11 -13 -14 -15 -16 -17 -18 -19 -20
  '
  int a,b,c,d,m
  string wr,w1,w2
  w1=wt
  c=1
  wr=yword(w1,c)
  w2=yword(w1,c)
  a=w2 'wval
  if a=20
    md=109 'HIGH LEVEL MACRO
    metaco(w1,c)
    exit procedure
  endif
  newrecord wr
  drc(me).a=-a 'METATYPE
  w1=mid(w1,c)
  c=1
  d=w1 'val(w1)
  '
  select a 'METATYPE
  '
  case 4
    if d
      w1=memreg(qebx,d)
    endif
    w1="## int "+w1+" 0 EA 0.       "+cr
  'case 5
  '  c=1
  '  nextspace(w1,c)
  '  wr=yword(w1,c)
  '  d=identype(wr)
  case 10
    d=asc(w1,1)-48
    if d>9
      d-=7
    endif
    if d=15
      d=16
    endif
    drc(me).b=d 'SIZE
    drc(me).f=d
    mrcsi(revdic(idtype,d),me,3) 'REGISTER TYPE NAME
  case 11
    drc(me).e=d
    nextspace(w1,c)
    d=readint(w1,c) : w1=""
  case 16
    c=1
    nextspace(w1,c)
    wr=yword(w1,c)
    d=identype(wr)
  case 17
    d=0x6a 'type for extended floating point
  end select
  '
  if (a>=11)and(a<=17)
    drc(me).f=d 'RETURN-TYPE / KEYWORD ENCODING
    if a=15
      drc(me).b=d and 15 'LENGTH FOR CTYPE KEYWORD
    endif
  endif
  if w1
    mrcsi(w1,me,1) 'BODY
  endif
  addme
end procedure



procedure intriset(string*s)
============================
  int a,b,c,i
  string w1
  i=1
  do
    w1=readdata s,i
    if w1=""
      exit do
    endif
    intrirec(w1)
  loop
end procedure

