DECLARE SUB GetSubType (name$, tname$, mempos&)
DECLARE SUB kw.setvect ()
DECLARE SUB kw.fval (text$)
DECLARE SUB kw.codeptr ()
DEFINT A-Z
DECLARE SUB kw.val (text$)
DECLARE SUB mem.REDIM ()
DECLARE SUB GetDimensionsString (size$, a%)
DECLARE SUB MultiDimStrings (size$)
DECLARE SUB GetDimensions (size$, a%)
DECLARE SUB MultiDim (size$)
DECLARE SUB Precedence ()
DECLARE FUNCTION GetCommands% (Line$, Num%)
DECLARE SUB kw.seek ()
DECLARE SUB kw.trim (mode%)
DECLARE SUB loadmakefile (file$)
DECLARE SUB printerr (text$)
DECLARE SUB kw.mid ()
DECLARE SUB kw.asc (text$)
DECLARE SUB kw.len (text$)

DECLARE SUB kw.pokes ()
DECLARE SUB kw.inp (size%, curop%)
DECLARE SUB kw.out (size%)
DECLARE SUB kw.string (text$)
DECLARE SUB kw.lucase (text$, mode)
DECLARE SUB Checkargs (callargs, kargs)
DECLARE SUB cleanbasfile ()
DECLARE SUB addfile (a$)
DECLARE SUB kw.int16 ()
DECLARE FUNCTION fixstring$ (text$)
DECLARE FUNCTION processcif ()
DECLARE SUB Dosfunction ()
DECLARE SUB fPRINT (filen%, text$, lc$)
DECLARE SUB kw.setnewoffset ()
DECLARE FUNCTION Getconsttype% (name$, value&, stringvalue$, floatvalue#)
DECLARE SUB CString.parser (stringt$)
DECLARE SUB CMath.parser (value#)
DECLARE FUNCTION Scanconstline% (text$)

DECLARE SUB kw.const ()
DECLARE SUB readline (number%, t$)
DECLARE SUB kw.int (extended)
DECLARE SUB kw.memcopy (size, mode)
DECLARE SUB kw.poke (mode)
DECLARE SUB call.sub (name$, calltype)
DECLARE SUB kw.declare ()
DECLARE SUB kw.endsub ()
DECLARE SUB add.sub (mode, asm)
DECLARE SUB kw.lptr (mode)
DECLARE SUB kw.filegetput (mode)
DECLARE SUB kw.close ()
DECLARE SUB kw.open ()
DECLARE SUB printclr (text$)
DECLARE SUB getcommandline ()
DECLARE SUB kw.locate ()
DECLARE SUB kw.color ()
DECLARE SUB Jmpendprog ()
DECLARE SUB kw.print ()
DECLARE SUB kw.do ()
DECLARE SUB kw.loop ()
DECLARE SUB kw.exit ()
DECLARE SUB CND.SelectProcess (worktype)
DECLARE SUB kw.case ()
DECLARE SUB CND.Select ()
DECLARE SUB kw.select ()
DECLARE SUB kw.incdec (mode)
DECLARE SUB kw.goto ()
DECLARE SUB kw.gosub ()
DECLARE SUB SecondPass ()         ' La segunda pasada para la optimizacion del programa
DECLARE SUB kw.for ()
DECLARE SUB kw.next ()
DECLARE SUB loop.for ()
DECLARE SUB kw.else ()
DECLARE SUB kw.if ()
DECLARE SUB kw.elseif ()
DECLARE SUB kw.endif ()
DECLARE SUB PUSH (value)
DECLARE SUB POP (value)
DECLARE SUB getconditions (text$, cond1$, cond2$, cond$)
DECLARE SUB CND.IF (elsenum)
DECLARE SUB dectmp ()
DECLARE SUB dPRINT (file%, text$)
DECLARE SUB store.string (name$, size$)
DECLARE SUB BuildMaxOffset (subversion%)
DECLARE SUB Addvlenstring (name$, varshared%, vartype%, text$)
DECLARE SUB string.parser (text$)
DECLARE SUB Addstringarray (name$, size$, stringtype%, varshared%, lenght$)
DECLARE SUB Addstring (name$, varshared%, stringtype%, ssize$)
DECLARE SUB Copyfile (file$)
DECLARE SUB BuildFiles ()
DECLARE SUB Checkothers (name$)
DECLARE SUB Cleartstack ()
DECLARE SUB Clearstack ()
DECLARE SUB autoaddvariable (name$)
DECLARE SUB Fmath.Parser (text$, continue%, currentx%)
DECLARE SUB Getvarvalue (name$, current%, typeobj$, leave%, gotvartype%)
DECLARE SUB Poptext ()
DECLARE SUB printc (text$)
DECLARE SUB Quickshow ()
DECLARE SUB IMath.Parser (text$)
DECLARE SUB Math.parser (text$, endtype%, dontconvert%)
DECLARE SUB mem.DEF (vartype%)
DECLARE SUB Addarray (name$, vartype%, varshared%, size$)
DECLARE SUB Addvar (name$, vartype%, varshared%, size$)
DECLARE SUB Pushtext (changeto$)
DECLARE SUB mem.DIM ()
DECLARE SUB Gettypestructure ()
DECLARE SUB Main ()
DECLARE SUB Addvariable (name$, vartype%, varshared%)
DECLARE SUB show.error (errnum%, word$)
DECLARE SUB Pusht (text$)
DECLARE SUB Popt (text$)
DECLARE SUB Addcustomvar (name$, mempos&, vartype)
DECLARE SUB ontextwin ()
DECLARE SUB updatewin ()
DECLARE FUNCTION kw.varptr ()
DECLARE FUNCTION existFUNCTION (name$, i%)
DECLARE FUNCTION clrspc$ (t$)
DECLARE FUNCTION getarg (mode, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)
DECLARE FUNCTION Getscond$ (CMP$, end$)
DECLARE FUNCTION GetNextcase$ ()
DECLARE FUNCTION addpoint$ (text$)
DECLARE FUNCTION returntypesize& (name$, typenum%)
DECLARE FUNCTION STR2$ (value)
DECLARE FUNCTION getnword$ ()
DECLARE FUNCTION gettempdir$ ()
DECLARE FUNCTION getword$ (wordtype%)
DECLARE FUNCTION getchar$ ()
DECLARE FUNCTION gettypemempos& (name$, obj$, objtype%)
DECLARE FUNCTION getoptype% (text$)
DECLARE FUNCTION memused% (vartype%)
DECLARE FUNCTION extracttype% (name$)
DECLARE FUNCTION exist% (name$, i%, typeblock$, mempos&)
DECLARE FUNCTION subexist% (name$, i%, varshared%, typeblock$, mempos&)
DECLARE FUNCTION sexist% (name$, i%, typeblock$, mempos&, varshared)
DECLARE FUNCTION Scanline% (text$, changepos%)
DECLARE FUNCTION Stringexist% (name$, leave%, i%, isarray%, size$)
DECLARE FUNCTION getshift& (number%)
DECLARE FUNCTION existSUB% (name$, i)
DECLARE FUNCTION ClearFilenum$ (text$)

' Ultrabasic for DOS
' The worst source you had ever seen
' Gabriel Fernandez
COMMON SHARED fixedvar, forfixedvarsize$

COMMON SHARED curstring, cursubstring, curstringmem AS LONG, cursubstringarray
COMMON SHARED cursubstringmem AS LONG, stringsize, curstringarray
COMMON SHARED curinmd, par$

COMMON SHARED codetext$, getcharpos AS INTEGER, linenumber AS LONG, outfile$, submemalloc$
COMMON SHARED basfile$, ignorefloaterror, asmfile$, insidesub, codefile$, subfile$

COMMON SHARED Savedtext$(), cursave, savedpos(), datafile$, fullcodetext$
COMMON SHARED defletters() AS INTEGER, Addcomments, Autoaddvars

COMMON SHARED fpuworkmethod, tsp, usedirtmp, ignorestep, emptyifline
COMMON SHARED tmpstringsize, stringformat, platform, version$, vlenarraysav
COMMON SHARED curvar, curarray, cursubvar, cursubarray, lastfound
COMMON SHARED curvarmem AS LONG, cursubvarmem AS LONG, curfpuval

COMMON SHARED vlenstring$(), subvlenstring$()
COMMON SHARED curvlenstring, cursubvlenstring, stringblocksize AS LONG
COMMON SHARED curstore, cursub, subpars, maketextwindow, writeerrorstofile
COMMON SHARED Arg$(), sub$(), globalsub, tmpdir$, ignorenumbertype
COMMON SHARED subvariable$(), subvariables() AS LONG
COMMON SHARED array$(), subarray$(), directaddsub$, extraarraydata() AS STRING * 1
COMMON SHARED subextraarraydata(), arrayatfixedoffset
COMMON SHARED vstack(), sp, subfound, funcname$, curbasline
COMMON SHARED forcounter, fortype(), functiontype
COMMON SHARED curif, workif, curelse, filecounter
COMMON SHARED savedif, curselect, curcase, workselect
COMMON SHARED curfor, workfor, fortype, stepsign, forvar$
COMMON SHARED curtype, dtypename$, nexttypepos AS LONG, asmsub, secstack
COMMON SHARED constdef$, constdat$, constcounter, cstringcounter, cfloatcounter
COMMON SHARED avoidfunc$, floatoptimize$, curfop, workfop, nclearstackpc
COMMON SHARED typename$(), cleanbas$, globalbasinc, incfile$(), incfilen() AS LONG
COMMON SHARED errfile$, completedfile$
COMMON SHARED substrings() AS LONG, substringarray$()
COMMON SHARED substringarrays() AS LONG, substringarraysextra() AS LONG, SubStringOffset
COMMON SHARED ObjArrayDim(), SubObjArrayDim()


DIM SHARED incfilen(20) AS LONG
DIM SHARED incfile$(20)
DIM SHARED fortype(20)
DIM SHARED subextraarraydata(1)' AS STRING * 1
DIM SHARED extraarraydata(1) AS STRING * 1
DIM SHARED Arg$(30)
DIM SHARED vstack(100), tstack$(30), asmscan
DIM SHARED defletters(25) AS INTEGER, optimizepushpop$
DIM SHARED Savedtext$(140), savedpos(140), selectcasetmp$, compilermode

CONST true = 1, false = 0, lineeof = "EOF", leavevalue = 1, leavemem = 2, leavemem3 = 4
CONST leavemem2 = 3, condor = 1, condand = 2, neg = 3, positive = 4, skip = 1
CONST win32 = 1, dos = 2, dec = 1, add = 2, distribute = 1
CONST fget = 1, fput = 2
CONST ubsub = 1, ubfunction = 2, asmmode = 3

REDIM SHARED sub$(1)

' ****---- Para GetWord ----****
' Tipos de datos
CONST stringtype = 1, intgr = 2, float = 3, condition = 4
CONST Endofcondition = 5, normal = 6, withpar = 7

' ****---- Para variables y matrices ----****
CONST tbyte = 1, tinteger = 2, tlong = 3, tsingle = 4
CONST tdouble = 5, textended = 6, tstring = 7, arraytype = 1, tnullstring = 8
CONST tlongsingle = 9

REDIM SHARED variable$(1)
REDIM SHARED variables(1) AS LONG
REDIM SHARED subvariable$(1)
REDIM SHARED subvariables(1) AS LONG

REDIM SHARED array$(1)
REDIM SHARED subarray$(1)

' ****---- Para IF ----****
CONST stringop = 1, mathop = 2

' ****---- Para SELECT CASE ----****
workselect = -1

' ****---- Para FOR ----****

' ****---- Para Strings ----****
CONST varlenght = 1, fixedlenght = 2, rvarlenght = 3

' */*/--- Tama¤o variable(como las de qb) *\*\
REDIM SHARED vlenstring$(1)
REDIM SHARED subvlenstring$(1)

' --- *** ---
REDIM SHARED stringsn$(1)
REDIM SHARED strings(1) AS LONG
REDIM SHARED substringsn$(1)
REDIM SHARED substrings(1) AS LONG
REDIM SHARED stringarray$(1)
REDIM SHARED substringarray$(1)
REDIM SHARED stringarrays(1) AS LONG
REDIM SHARED substringarrays(1) AS LONG
REDIM SHARED substringarraysextra(1) AS LONG
REDIM SHARED ObjArrayDim(1)
REDIM SHARED SubObjArrayDim(1)

' ****---- Para TYPE ----****

REDIM SHARED typename$(1)

' ****---- Parametos ----****

FOR i = 0 TO 25
  defletters(i) = tlong
NEXT i

DIM SHARED writebaslinetoasm

writebaslinetoasm = true
compilermode = distribute
version$ = "v0.21 alpha"

Addcomments = true
Autoaddvars = true
emptyifline = true

fpuworkmethod = tdouble 'textended

tmpstringsize = 15        ' En formato shift
stringsize = 500
stringblocksize = 65545   ' Para tener lo mismo que en qbasic
                          ' unos bytes demas para hacer mas rapido la
                          ' copia
stringformat = varlenght
ignorestep = true
vlenarraysav = false      ' Todavia no agregue las matrices de var-len-strings

platform = win32
platform = dos

'maketextwindow = true
ignorefloaterror = true

' ****---- Principal ----****
IF compilermode = distribute THEN
  a$ = gettempdir$
  tmpdir$ = MID$(a$, 1, LEN(a$) - 1)
  fpuworkmethod = tdouble
  usedirtmp = false
  platform = dos
  codetext$ = COMMAND$
  getcommandline
ELSE
  usedirtmp = true

  a$ = gettempdir$
  tmpdir$ = MID$(a$, 1, LEN(a$) - 1)

  basfile$ = "test\test.bas"
  outfile$ = "test.asm"
END IF

floatoptimize$ = gettempdir$ + "float.dat"
constdef$ = gettempdir$ + "const.def"
constdat$ = gettempdir$ + "const.dat"
codefile$ = gettempdir$ + "out.asm"
datafile$ = gettempdir$ + "dat.asm"
asmfile$ = gettempdir$ + "tmp.asm"
selectcasetmp$ = gettempdir$ + "slcase.dat"
subfile$ = gettempdir$ + "ubsubs.dat"
submemalloc$ = gettempdir$ + "submem.dat"
optimizepushpop$ = gettempdir$ + "oppp.dat"
cleanbas$ = gettempdir$ + "cleanbas.tmp"
CLS

cleanbasfile
Main

SUB Addarray (name$, vartype, varshared, size$)

printc "Array " + STR$(curarray) + STR$(cursubarray)

MultiDim size$
IF varshared = true THEN
  tmp = 128
ELSE
  tmp = 0
END IF
tmp = tmp + vartype
tmp$ = CHR$(tmp) + name$

IF insidesub = true THEN
  REDIM PRESERVE subarray$(cursubarray + 1)
  REDIM PRESERVE subextraarraydata(cursubarray + 1)' AS STRING * 1
  subextraarraydata(cursubarray) = cursubvarmem
  'arraytext$ = "subArray"
  arraytext$ = "ESI +" + STR$(cursubvarmem)
  cursubvarmem = cursubvarmem + 8
  label$ = "sub" + LTRIM$(STR$(cursub)) + "Arrayskip" + LTRIM$(STR$(cursubarray))
  IF arrayatfixedoffset = true THEN
    subextraarraydata(cursubarray) = -cursubvarmem'"S"
    'PRINT #3, arraytext$ + STR2$(curarray) + " DD 0"
    Math.parser size$, intgr, 0
    PRINT #2, "MOV [" + arraytext$ + "], EAX"
    IF dtypename$ = "" THEN
      subarray$(cursubarray) = tmp$
    ELSE
      ' subarray$(cursubarray) = tmp$ + " " + typename$(typenum) + CHR$(0)
      subarray$(cursubarray) = tmp$ + " " + dtypename$ + CHR$(0)
    END IF
    cursubarray = cursubarray + 1
    EXIT SUB
  END IF
ELSE
  REDIM PRESERVE array$(curarray + 1)
  REDIM PRESERVE extraarraydata(curarray + 1) AS STRING * 1
  extraarraydata(curarray) = CHR$(0)
  arraytext$ = "Array"
  label$ = "subArrayskip" + LTRIM$(STR$(curarray))
  IF arrayatfixedoffset = true THEN
    extraarraydata(curarray) = "S"
    PRINT #3, arraytext$ + STR2$(curarray) + " DD 0"
    Math.parser size$, intgr, 0
    PRINT #2, "MOV [" + arraytext$ + STR2$(curarray) + "], EAX"
    IF dtypename$ = "" THEN
      array$(curarray) = tmp$
    ELSE
      array$(curarray) = tmp$ + " " + dtypename$ + CHR$(0) ' (typenum)
    END IF
    curarray = curarray + 1
    EXIT SUB
  END IF
END IF

printc size$
IF insidesub = 0 THEN
  PRINT #2, "CMP DWORD [" + arraytext$ + LTRIM$(STR$(curarray)) + "], 0"
ELSE
  PRINT #2, "CMP DWORD [" + arraytext$ + "], 0"
END IF
PRINT #2, "JNE " + label$

Math.parser size$, intgr, 0

IF dtypename$ = "" THEN
  SELECT CASE vartype              ' *---* Para hacer que el programa sea mas
    CASE tdouble: PRINT #2, "SHL EAX, 3"                          '    rapido
    CASE tlong: PRINT #2, "SHL EAX, 2"
    CASE tinteger: PRINT #2, "SHL EAX, 1"
    CASE tsingle: PRINT #2, "SHL EAX, 2"
    CASE textended: PRINT #2, "MOV EBX, 10": PRINT #2, "MUL EBX"
  END SELECT
  
  dPRINT 2, "MOV [push1], EAX"

  IF insidesub = true THEN PRINT #2, "PUSH ESI"

  IF platform = dos THEN     '-------------------|
    PRINT #2, "CALL NEAR AllocBlock"            '| De acuerdo al OS
  ELSE : PRINT #2, "CALL NEAR AllocBlockw"      '|
  END IF               '-------------------------|
  IF insidesub = 0 THEN
    a$ = LTRIM$(STR$(curarray))
    PRINT #3, arraytext$ + a$ + " DD 0"
    PRINT #3, arraytext$ + "Handle" + a$ + " DD 0"
    PRINT #2, "MOV [" + arraytext$ + a$ + "], EAX"
    IF platform = dos THEN
      PRINT #2, "MOV [" + arraytext$ + "Handle" + a$ + "], SI"
      PRINT #2, "MOV [" + arraytext$ + "Handle" + a$ + "+2], DI"
      PRINT #2, "MOV EBX, [push1]"
      PRINT #2, "CALL Clearblock"
    ELSE : PRINT #2, "MOV [" + arraytext$ + "Handle" + a$ + "], EBX"
    END IF

  ELSE
    PRINT #2, "POP ESI"
    PRINT #2, "MOV [" + arraytext$ + "], EAX"
    IF platform = dos THEN
      PRINT #2, "MOV [" + arraytext$ + "+4], SI"
      PRINT #2, "MOV [" + arraytext$ + "+6], DI"
      PRINT #2, "MOV EBX, [push1]"
      PRINT #2, "PUSH ESI"
      PRINT #2, "CALL Clearblock"
      PRINT #2, "POP ESI"

    ELSE : PRINT #2, "MOV [" + arraytext$ + "+4], EBX"
    END IF

  END IF

  'IF insidesub = true THEN PRINT #2, "POP ESI"
  PRINT #2, "MOV EDI, [varedi]"
  
  IF insidesub = true THEN
    subarray$(cursubarray) = tmp$
  ELSE : array$(curarray) = tmp$
  END IF
ELSE
' *-------------------------------------------------------------------*
' *                     SI USA UN BLOQUE DE TYPE                      *
' *-------------------------------------------------------------------*
  a$ = "MOV EBX, " + STR$(returntypesize&(dtypename$, typenum))
  PRINT #2, a$
  PRINT #2, "MUL EBX"

  dPRINT 2, "MOV [push1], EAX"

  IF insidesub THEN PRINT #2, "PUSH ESI"

  IF platform = dos THEN     '-------------------|
    PRINT #2, "CALL NEAR AllocBlock"            '| De acuerdo al OS
  ELSE : PRINT #2, "CALL NEAR AllocBlockw"      '|
  END IF               '-------------------------|
  IF insidesub = 0 THEN
    a$ = LTRIM$(STR$(curarray))
    PRINT #3, arraytext$ + a$ + " DD 0"
    PRINT #3, arraytext$ + "Handle" + a$ + " DD 0"
    PRINT #2, "MOV [" + arraytext$ + a$ + "], EAX"
    IF platform = dos THEN
      PRINT #2, "MOV [" + arraytext$ + "Handle" + a$ + "], SI"
      PRINT #2, "MOV [" + arraytext$ + "Handle" + a$ + "+2], DI"
      PRINT #2, "MOV EBX, [push1]"
      PRINT #2, "CALL Clearblock"
    ELSE : PRINT #2, "MOV [" + arraytext$ + "Handle" + a$ + "], EBX"
    END IF
  ELSE
    PRINT #2, "POP ESI"
    PRINT #2, "MOV [" + arraytext$ + "], EAX"
    IF platform = dos THEN
      PRINT #2, "MOV [" + arraytext$ + "+4], SI"
      PRINT #2, "MOV [" + arraytext$ + "+6], DI"
      PRINT #2, "MOV EBX, [push1]"
      PRINT #2, "PUSH ESI"
      PRINT #2, "CALL Clearblock"
      PRINT #2, "POP ESI"

    ELSE : PRINT #2, "MOV [" + arraytext$ + "+4], EBX"
    END IF

  END IF
  'IF insidesub THEN PRINT #2, "POP ESI"
  PRINT #2, "MOV EDI, [varedi]"

  IF insidesub = true THEN
    subarray$(cursubarray) = tmp$ + " " + typename$(typenum) + CHR$(0)
  ELSE : array$(curarray) = tmp$ + " " + typename$(typenum) + CHR$(0)
  END IF
END IF

' ******\
' ******/

IF insidesub = true THEN
  cursubarray = cursubarray + 1
ELSE : curarray = curarray + 1
END IF
PRINT #2, label$ + ":"
END SUB

SUB Addcustomvar (name$, mempos&, vartype)

REDIM PRESERVE subvariable$(cursubvar + 1)
REDIM PRESERVE subvariables(cursubvar + 1) AS LONG

tmp$ = CHR$(vartype) + name$

subvariable$(cursubvar) = tmp$
subvariables(cursubvar) = mempos&
cursubvar = cursubvar + 1

END SUB

SUB Addstring (name$, varshared, stringtype, ssize$)

IF NOT ssize$ = "" THEN ss = stringsize: stringsize = VAL(ssize$)

IF stringsize = 0 THEN show.error 22, ssize$

IF insidesub = true THEN
  REDIM PRESERVE substringsn$(cursubstring + 1)
  REDIM PRESERVE substrings(cursubstring + 1) AS LONG
ELSE
  REDIM PRESERVE stringsn$(curstring + 1)
  REDIM PRESERVE strings(curstring + 1) AS LONG
END IF

IF varshared = true THEN
  tmp = 128
ELSE
  tmp = 0
END IF

tmp = tmp + stringtype
tmp$ = CHR$(tmp) + name$

IF insidesub = true THEN
  substringsn$(cursubstring) = tmp$
  substrings(cursubstring) = cursubstringmem
  IF stringtype > 64 THEN
    substrings(cursubstring) = subpars
  ELSE
    cursubstringmem = cursubstringmem + stringsize
    IF SubStringOffset < 0 THEN
      'SubStringOffset = cursubvarmem
    'ELSE
      SubStringOffset = cursubvarmem
      cursubvarmem = cursubvarmem + 8
    END IF
  END IF
  cursubstring = cursubstring + 1
ELSE
  stringsn$(curstring) = tmp$
  strings(curstring) = curstringmem
  curstringmem = curstringmem + stringsize
  curstring = curstring + 1
END IF

IF NOT ssize$ = "" THEN stringsize = ss

END SUB

SUB Addstringarray (name$, size$, stringtype, varshared, lenght$)

MultiDimStrings size$

IF insidesub = true THEN
  REDIM PRESERVE substringarray$(cursubstringarray + 1)
  REDIM PRESERVE substringarrays(cursubstringarray + 1) AS LONG
  REDIM PRESERVE substringarraysextra(cursubstringarray + 1) AS LONG
  'arraytext$ = "SubStringHandle" + LTRIM$(STR$(cursubstringarray))
  'arrayoffset$ = "SubStringOffset" + LTRIM$(STR$(cursubstringarray))
  substringarraysextra(cursubstringarray) = cursubvarmem
  arraytext$ = "ESI+" + LTRIM$(STR$(substringarraysextra(cursubstringarray) + 4))
  arrayoffset$ = "ESI+" + LTRIM$(STR$(substringarraysextra(cursubstringarray)))
  cursubvarmem = cursubvarmem + 8
  label$ = "sub" + STR2$(cursub) + "stringskip" + LTRIM$(STR$(cursubstringarray))
ELSE
  REDIM PRESERVE stringarray$(curstringarray + 1)
  REDIM PRESERVE stringarrays(curstringarray + 1) AS LONG
  arraytext$ = "StringHandle" + LTRIM$(STR$(curstringarray))
  arrayoffset$ = "StringOffset" + LTRIM$(STR$(curstringarray))
  label$ = "stringskip" + LTRIM$(STR$(curstringarray))
END IF

IF varshared = true THEN
  tmp = 128
ELSE
  tmp = 0
END IF

tmp = tmp + stringtype
tmp$ = CHR$(tmp) + name$

PRINT #2, "CMP DWORD [" + arraytext$ + "], 0"
PRINT #2, "JNE " + label$

  Math.parser size$, intgr, 0
IF stringtype = varlenght THEN
  a = VAL(lenght$)
  a = a + 4
  lenght$ = STR$(a)
END IF
  PRINT #2, "MOV EBX, " + lenght$
  PRINT #2, "MUL EBX"
IF insidesub = true THEN PRINT #2, "PUSH ESI"

  IF platform = dos THEN     '-------------------|
    PRINT #2, "CALL NEAR AllocBlock"            '| De acuerdo al OS
  ELSE : PRINT #2, "CALL NEAR AllocBlockw"      '|
  END IF               '-------------------------|
  IF insidesub = 0 THEN
    PRINT #3, arraytext$ + " DD 0"
    PRINT #3, arrayoffset$ + " DD 0"
  END IF
IF insidesub = true THEN PRINT #2, "POP ESI"

IF platform = dos THEN
  PRINT #2, "MOV [" + arraytext$ + "], SI"
  PRINT #2, "MOV [" + arraytext$ + "+2], DI"
ELSE : PRINT #2, "MOV [" + arraytext$ + "], EBX"
END IF

PRINT #2, "MOV [" + arrayoffset$ + "], EAX"

'IF insidesub = true THEN PRINT #2, "POP ESI"
PRINT #2, "MOV EDI, [varedi]"

IF insidesub = true THEN
  substringarray$(cursubstringarray) = tmp$
  substringarrays(cursubstringarray) = VAL(lenght$)
  cursubstringarray = cursubstringarray + 1
ELSE
  stringarray$(curstringarray) = tmp$
  stringarrays(curstringarray) = VAL(lenght$)
  curstringarray = curstringarray + 1
END IF
PRINT #2, label$ + ":"
END SUB

SUB Addvar (name$, vartype, varshared, size$)

IF NOT dtypename$ = "" AND size$ = "" THEN
  IF arrayatfixedoffset = true THEN Addarray name$, vartype, varshared, forfixedvarsize$: EXIT SUB
  Addarray name$, vartype, varshared, "1"
  EXIT SUB
END IF

IF size$ = "" THEN
  Addvariable name$, vartype, varshared
ELSE
  IF arrayatfixedoffset = true THEN Addarray name$, vartype, varshared, forfixedvarsize$: EXIT SUB
  Addarray name$, vartype, varshared, size$
END IF

END SUB

SUB Addvariable (name$, vartype, varshared)

IF insidesub = true THEN
  REDIM PRESERVE subvariable$(cursubvar + 1)
  REDIM PRESERVE subvariables(cursubvar + 1) AS LONG
ELSE
  REDIM PRESERVE variable$(curvar + 1)
  REDIM PRESERVE variables(curvar + 1) AS LONG
END IF

IF varshared = true THEN
  tmp = 128
ELSE
  tmp = 0
END IF

IF arrayatfixedoffset = true THEN tmp = tmp + 64
tmp = tmp + vartype
tmp$ = CHR$(tmp) + name$

IF insidesub = true THEN
  IF arrayatfixedoffset = true THEN
    Math.parser forfixedvarsize$, intgr, 0
    PRINT #2, "___STACKEDIT1___"
    PRINT #2, "MOV [ESI+" + STR$(cursubvarmem) + "], EAX"
    vartype = tlong
  END IF

  subvariable$(cursubvar) = tmp$
  subvariables(cursubvar) = cursubvarmem
  cursubvarmem = cursubvarmem + memused(vartype)
  cursubvar = cursubvar + 1
ELSE
  IF arrayatfixedoffset = true THEN
    Math.parser forfixedvarsize$, intgr, 0
    PRINT #2, "MOV [EDI+" + STR$(curvarmem) + "], EAX"
    vartype = tlong
  END IF

  variable$(curvar) = tmp$
  variables(curvar) = curvarmem
  curvarmem = curvarmem + memused(vartype)
  curvar = curvar + 1
END IF

END SUB

' Para los vlen Reales
SUB Addvlenstring (name$, varshared, vartype, text$)

IF insidesub = true THEN
  REDIM PRESERVE subvlenstring$(cursubvlenstring + 1)
  t1$ = "subvlenstringoffset"
  t2$ = "subvlenstringsize"
  t3$ = "subvlenarrayoffset"
  t4$ = "subvlenarrayhandle"
  t5$ = "subvlenstringwork"
  t6$ = "subvlenarraysize"
  t7$ = "subvlenarraydatastart"
  t = cursubvlenstring
ELSE
  REDIM PRESERVE vlenstring$(curvlenstring + 1)
  t1$ = "vlenstringoffset"
  t2$ = "vlenstringsize"
  t3$ = "vlenarrayoffset"
  t4$ = "vlenarrayhandle"
  t5$ = "vlenstringwork"
  t6$ = "vlenarraysize"
  t7$ = "vlenarraydatastart"
  t = curvlenstring
END IF

IF varshared = true THEN
  tmp = 128 + vartype
ELSE
  tmp = 0 + vartype
END IF

IF NOT vartype = arraytype THEN
  PRINT #3, t1$ + LTRIM$(STR$(t)) + " DD 0"
  PRINT #3, t2$ + LTRIM$(STR$(t)) + " DD 0"
  PRINT #3, t5$ + LTRIM$(STR$(t)) + " DD 0"
ELSE
  PRINT #3, t3$ + LTRIM$(STR$(t)) + " DD 0"
  PRINT #3, t4$ + LTRIM$(STR$(t)) + " DD 0"
  PRINT #3, t6$ + LTRIM$(STR$(t)) + " DD 0"
  PRINT #3, t7$ + LTRIM$(STR$(t)) + " DD 0"

  PRINT #2, "CMP DWORD [" + t3$ + "], 0"
  PRINT #2, "JNE createvlenarray" + LTRIM$(STR$(t))
  ' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
  Math.parser text$, intgr, 0
  PRINT #2, "MOV [" + t6$ + LTRIM$(STR$(t)) + "], EAX"
  PRINT #2, "SHL EAX, 3"
  PRINT #2, "ADD EAX, 8"
  PRINT #2, "MOV [" + t7$ + LTRIM$(STR$(t)) + "], EAX"
  PRINT #2, "ADD EAX, 20"
  IF platform = dos THEN     '-------------------|
    PRINT #2, "CALL NEAR AllocBlock"            '| De acuerdo al OS
  ELSE : PRINT #2, "CALL NEAR AllocBlockw"      '|
  END IF               '-------------------------|

  PRINT #2, "ADD [" + t7$ + LTRIM$(STR$(t)) + "], EAX"
IF platform = dos THEN
  PRINT #2, "MOV [" + t3$ + "], EAX"
  PRINT #2, "MOV [" + t4$ + "], SI"
  PRINT #2, "MOV [" + t4$ + "+2], DI"
ELSE
  PRINT #2, "MOV [" + t3$ + "], EAX"
  PRINT #2, "MOV [" + t4$ + "], EBX"
END IF
  ' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
  PRINT #2, "createvlenarray" + LTRIM$(STR$(t)) + ":"
END IF

IF insidesub = false THEN
  vlenstring$(curvlenstring) = CHR$(tmp) + name$
  curvlenstring = curvlenstring + 1
ELSE : subvlenstring$(cursubvlenstring) = CHR$(tmp) + name$
  cursubvlenstring = cursubvlenstring + 1
END IF

EXIT SUB

END SUB

SUB autoaddvariable (name$)

varshared = false
dtypename$ = ""
t$ = MID$(name$, LEN(name$), 1)

SELECT CASE t$
  CASE "%": Addvariable name$, tinteger, varshared
  CASE "&": Addvariable name$, tlong, varshared
  CASE "#": Addvariable name$, tdouble, varshared
  CASE "!": Addvariable name$, tsingle, varshared
  CASE "@": Addvariable name$, textended, varshared
  CASE ELSE: Addvariable name$, extracttype(name$), varshared
END SELECT

END SUB

SUB BuildMaxOffset (subversion)

IF curvlenstring = 0 THEN EXIT SUB

PRINT #1, "vlenGetMaxOffset:"
PRINT #1, "MOV EBX, 0"
t1$ = "vlenstringoffset"
t2$ = "vlenstringsize"
t3$ = "vlenstringwork"
FOR i = 0 TO curvlenstring - 1
  a$ = MID$(vlenstring$(i), 1, 1)
  a = ASC(a$)

  IF a >= 128 THEN a = a - 128
  IF NOT a = arraytype THEN
   a$ = LTRIM$(STR$(i))
   PRINT #1, "CMP DWORD [" + t3$ + a$ + "], 0"
   PRINT #1, "JE NEAR lasts" + a$
   PRINT #1, "MOV EAX, [" + t1$ + a$ + "]"
   IF i = 0 THEN
     PRINT #1, "SUB EAX, [stringblockoffset]"
   ELSE : PRINT #1, "SUB EAX, [" + t1$ + LTRIM$(STR$(i - 1)) + "]"
   END IF
   PRINT #1, "ADD EBX, EAX"
   PRINT #1, "JMP NEAR nexts" + a$
   PRINT #1, "lasts" + a$ + ":"
   IF NOT i = 0 THEN PRINT #1, "  ADD EBX, [" + t2$ + LTRIM$(STR$(i - 1)) + "]"
   PRINT #1, "nexts" + a$ + ":"
  END IF
NEXT i
PRINT #1, "ADD EBX, [" + t2$ + LTRIM$(STR$(i - 1)) + "]"
PRINT #1, "RET"

' Para cuando se mueve hacia la derecha

PRINT #1, "vlenupdateright:"

FOR i = 0 TO curvlenstring - 1
  a$ = MID$(vlenstring$(i), 1, 1)
  a = ASC(a$)

  IF a >= 128 THEN a = a - 128
  IF NOT a = arraytype THEN
    a$ = LTRIM$(STR$(i))
    PRINT #1, "CMP DWORD [" + t3$ + a$ + "], 0"
    PRINT #1, "JE NEAR next2s" + a$

    PRINT #1, "CMP [" + t1$ + a$ + "], EAX"
    PRINT #1, "JNGE next2s" + a$
    PRINT #1, "ADD [" + t1$ + a$ + "], EDX"
    PRINT #1, "next2s" + a$ + ":"
  END IF
NEXT i

PRINT #1, "RET"
' Para cuando se mueve hacia la izquierda

PRINT #1, "vlenupdateleft:"

FOR i = 0 TO curvlenstring - 1
  a$ = MID$(vlenstring$(i), 1, 1)
  a = ASC(a$)

  IF a >= 128 THEN a = a - 128
  IF NOT a = arraytype THEN
    a$ = LTRIM$(STR$(i))
    PRINT #1, "CMP DWORD [" + t3$ + a$ + "], 0"
    PRINT #1, "JE NEAR next3s" + a$

    PRINT #1, "CMP [" + t1$ + a$ + "], EAX"
    PRINT #1, "JNGE next3s" + a$
    PRINT #1, "SUB [" + t1$ + a$ + "], ECX"
    PRINT #1, "next3s" + a$ + ":"
  END IF
NEXT i
PRINT #1, "RET"

END SUB

SUB Clearstack
sp = 0
END SUB

SUB Cleartstack
tsp = 0
END SUB

SUB dectmp
PRINT #2, "DEC DWORD [curtmpblock]"
END SUB

FUNCTION exist (name$, i, typeblock$, mempos&)

' PRINT fullcodetext$ + " :: " + name$ + " ";
lastfound = 0
fixedvar = 0

IF curvar >= 1 THEN

FOR i = 0 TO curvar - 1
  IF UCASE$(MID$(variable$(i), 2, LEN(variable$(i)) - 1)) = UCASE$(name$) THEN
    tmp = ASC(MID$(variable$(i), 1, 1))
    IF tmp > 128 THEN tmp = tmp - 128
    IF tmp > 64 THEN tmp = tmp - 64: fixedvar = true
    mempos& = variables(i)
    exist = tmp
    ' PRINT "f"
    EXIT FUNCTION
  END IF
NEXT i
END IF

IF curarray >= 1 THEN
FOR i = 0 TO curarray - 1
  typeblock$ = ""
  tmp = INSTR(array$(i), " ")
  IF NOT tmp = 0 THEN
    t$ = MID$(array$(i), 1, tmp - 1)
    typeblock$ = MID$(array$(i), tmp + 1, LEN(array$(i)) - (tmp + 1))
GOTO label06
  END IF

  t$ = array$(i)
label06:
  
  IF UCASE$(MID$(t$, 2, LEN(t$) - 1)) = UCASE$(name$) THEN
    tmp = ASC(MID$(t$, 1, 1))
    IF tmp > 128 THEN tmp = tmp - 128
    lastfound = arraytype
    exist = tmp
    ' PRINT "f"
    EXIT FUNCTION
  END IF
NEXT i
END IF

exist = -1
' PRINT "nf"
END FUNCTION

FUNCTION existFUNCTION (name$, i)

oname$ = ""
IF INSTR(name$, "->") THEN
   oname$ = name$
   Object$ = LEFT$(name$ + " ", INSTR(name$, "->") - 1)
   a = sexist(Object$, i, typeblock$, mempos&, varshared)
     name$ = typeblock$ + "::" + RTRIM$(MID$(name$ + "  ", INSTR(name$, "->") + 2))
   'END IF
END IF

FOR i = 0 TO globalsub - 1
  IF UCASE$(sub$(i)) = UCASE$(name$) THEN
    OPEN tmpdir$ + "\subd." + STR2$(i) FOR INPUT AS #108
     INPUT #108, type$
     INPUT #108, vartype
      IF oname$ <> "" THEN name$ = oname$
    CLOSE #108
    existFUNCTION = vartype
    EXIT FUNCTION
  END IF
NEXT i

IF oname$ <> "" THEN name$ = oname$
existFUNCTION = false

END FUNCTION

FUNCTION existSUB (name$, i)
subfound = true

oname$ = ""
IF INSTR(name$, "->") THEN
   oname$ = name$
   Object$ = LEFT$(name$ + " ", INSTR(name$, "->") - 1)
   a = sexist(Object$, i, typeblock$, mempos&, varshared)
     name$ = typeblock$ + "::" + RTRIM$(MID$(name$ + "  ", INSTR(name$, "->") + 2))
   'END IF
END IF
   

FOR i = 0 TO globalsub - 1
  IF UCASE$(sub$(i)) = UCASE$(name$) THEN
  OPEN tmpdir$ + "\subd." + STR2$(i) FOR INPUT AS #100
    INPUT #100, type$
    IF type$ = "__SUB" THEN
      existSUB = true
      CLOSE #100
      IF oname$ <> "" THEN name$ = oname$
      EXIT FUNCTION
    END IF
  CLOSE #100
  END IF
NEXT i

subfound = false
existSUB = false
IF oname$ <> "" THEN name$ = oname$

END FUNCTION

FUNCTION extracttype (name$)
  SELECT CASE MID$(name$, LEN(name$), 1)
    CASE "%": extracttype = tinteger
    CASE "&": extracttype = tlong
    CASE "#": extracttype = tdouble
    CASE "!": extracttype = tsingle
    CASE "$": extracttype = tstring
    CASE "@": extracttype = textended
    CASE ELSE
      a$ = UCASE$(MID$(name$, 1, 1))
      extracttype = defletters(ASC(a$) - 65)
  END SELECT
END FUNCTION

SUB Fmath.Parser (text$, continue, currentx)
' Math Parser, para numeros de coma flotante

Pushtext text$
printc "FloatMath: " + text$
current = 0

IF continue = true THEN
  current = 1
  lastc = 2
  PRINT #2, "MOV [tmpvar], EAX"
  PRINT #2, "FILD DWORD [tmpvar]"
END IF

DO WHILE NOT endloop = true
  a$ = getword$(wordtype)
  typeblock$ = ""
  IF a$ = lineeof THEN
Poptext
currentx = lastcur         ' current + 1: EXIT SUB
EXIT SUB
  END IF
  
  ' *---- PRIMERA LECTURA
  IF current = 0 THEN
    ' Para los bloques de TYPE
    IF wordtype = withpar AND NOT a$ = "" THEN
      SELECT CASE UCASE$(a$)
       CASE "VAL"
        kw.fval par$
       CASE "ABS", "SIN", "COS", "TAN", "SQRT"
        Math.parser par$, skip, true
        PRINT #2, "F" + UCASE$(a$)
      END SELECT

      SELECT CASE existFUNCTION(a$, i)
        CASE tsingle: Pushtext par$: call.sub a$, ubfunction: Poptext
          PRINT #2, "FLD DWORD [eax]"
        CASE tdouble: Pushtext par$: call.sub a$, ubfunction: Poptext
          PRINT #2, "FLD QWORD [eax]"
        CASE textended: Pushtext par$: call.sub a$, ubfunction: Poptext
          PRINT #2, "FLD TWORD [eax]"
        CASE ELSE: GOTO label23
      END SELECT

      lastcur = 1
      current = 1
      lastc = 1
      GOTO label16
    ELSEIF wordtype = withpar AND a$ = "" THEN
      'PRINT #2, "FFREE st1"
      'PRINT #2, "FFREE st0"

      Math.parser par$, float, true
      
      PRINT #2, "MOV [tmpvar], EAX"
      PRINT #2, "FILD DWORD [tmpvar]"

      lastcur = 1
      current = 1
      lastc = 1
      GOTO label16
    ELSEIF NOT wordtype = intgr AND NOT wordtype = float THEN
label23:
      ' -------- KEYWORDS -------

      SELECT CASE UCASE$(a$)
        CASE "TIMER": PRINT #2, "CALL Timer": lastcur = 1: current = 1: lastc = 1: GOTO label16
      END SELECT

      SELECT CASE existFUNCTION(a$, i)
        CASE tsingle: Pushtext par$: call.sub a$, ubfunction: Poptext
          PRINT #2, "FLD DWORD [eax]"
          lastcur = 1: current = 1: lastc = 1: GOTO label16
        CASE tdouble: Pushtext par$: call.sub a$, ubfunction: Poptext
          PRINT #2, "FLD QWORD [eax]"
          lastcur = 1: current = 1: lastc = 1: GOTO label16
        CASE textended: Pushtext par$: call.sub a$, ubfunction: Poptext
          PRINT #2, "FLD TWORD [eax]"
          lastcur = 1: current = 1: lastc = 1: GOTO label16
      END SELECT

      IF NOT sexist(a$, i, typeblock$, mempos&, varshared) = -1 THEN GOTO label15

      IF Getconsttype(a$, value&, stringvalue$, floatvalue#) = intgr THEN
        PRINT #2, "MOV DWORD [temp], " + STR$(value&)
        PRINT #2, "FILD DWORD [temp]"
        GOTO label60
      ELSEIF Getconsttype(a$, value&, stringvalue$, floatvalue#) = float THEN
        value% = value&
        PRINT #2, "FLD QWORD [Constfloatval" + STR2$(value%) + "]"
        GOTO label60
      END IF
      
      sa$ = UCASE$(a$)
      tmp = INSTR(a$, ".")
      IF tmp > 0 THEN typeobj$ = MID$(a$, tmp + 1, LEN(a$) - (tmp)): a$ = MID$(a$, 1, tmp - 1)

      IF sexist(a$, i, typeblock$, mempos&, varshared) = -1 THEN
      IF Autoaddvars = true THEN
        IF ASC(MID$(sa$, 1, 1)) >= 65 AND ASC(MID$(sa$, 1, 1)) <= 90 THEN autoaddvariable sa$: GOTO label15
      END IF
      show.error 8, a$
      END IF
    END IF

label15:
    IF NOT sexist(a$, i, typeblock$, mempos&, varshared) = -1 THEN
      Getvarvalue a$, 3, typeobj$, leavemem, gotvartype
      SELECT CASE gotvartype
        CASE tbyte
          PRINT #2, "MOV EBX, 0 "
          PRINT #2, "MOV BL, [EAX]"
          PRINT #2, "MOV [temp], EBX"
          PRINT #2, "FILD DWORD [temp]"
        CASE tinteger: PRINT #2, "FILD WORD [EAX]"
        CASE tlong: PRINT #2, "FILD DWORD [EAX]"
        CASE tsingle: PRINT #2, "FLD DWORD [EAX]"
        CASE tdouble: PRINT #2, "FLD QWORD [EAX]"
        CASE textended: PRINT #2, "FLD TWORD [EAX]"
      END SELECT
    ELSE
      IF INSTR(a$, ".") = 0 THEN
        wp$ = a$ + ".0"
      ELSE
        wp$ = a$
      END IF
    IF fpuworkmethod = textended THEN
      PRINT #3, "FPUVAL" + LTRIM$(STR$(curfpuval)) + " DT " + wp$
      PRINT #2, "FLD TWORD [FPUVAL" + LTRIM$(STR$(curfpuval)) + "]"
    ELSE
      PRINT #3, "FPUVAL" + LTRIM$(STR$(curfpuval)) + " DQ " + wp$
      PRINT #2, "FLD QWORD [FPUVAL" + LTRIM$(STR$(curfpuval)) + "]"
    END IF

      curfpuval = curfpuval + 1
    END IF
label60:
    lastcur = 0
    current = 1
    lastc = 1
    GOTO label16
  END IF

  ' *---- CARGA LA OPERACION
  IF current = 1 THEN
    IF NOT par$ = "" THEN getcharpos = getcharpos - LEN(par$) - 3
    lastc$ = a$
    current = 2
    GOTO label16
  END IF

  IF current = 2 THEN
   IF wordtype = withpar AND a$ = "" THEN
      PUT #10, , curfop
      tmpfop = curfop
      curfop = curfop + 1
      IF lastc = 2 THEN
        'PRINT #2, "FXCH"
        PRINT #2, "FFREE st1"
      END IF
        PRINT #2, "FSTP QWORD [floatsave]"
        PRINT #2, ";ubsp1; Float save optimize"

        Math.parser par$, skip, true
      PRINT #2, ";ubsp2; Float save optimize"
      PUT #10, , tmpfop
      PRINT #2, "FLD QWORD [floatsave]"
      'PRINT #2, "FXCH"
   ELSEIF wordtype = withpar AND NOT a$ = "" THEN
      SELECT CASE UCASE$(a$)
       CASE "VAL"
         kw.fval par$
         GOTO label61
       CASE "ABS", "SIN", "COS", "TAN", "SQRT"
        simplenum = false
        spar$ = par$
        Pushtext par$
          d$ = getword$(wordtype)
          b$ = getword$(wordtype)
          IF b$ = lineeof THEN simplenum = true
          PRINT
        Poptext

        IF simplenum = true THEN
          Math.parser spar$, skip, true
        ELSE
          PUT #10, , curfop
          tmpfop = curfop
          curfop = curfop + 1
          IF lastc = 2 THEN
           'PRINT #2, "FXCH"
            PRINT #2, "FFREE st1"
          END IF
          PRINT #2, "FSTP QWORD [floatsave]"
          PRINT #2, ";ubsp1; Float save optimize"
            Math.parser spar$, skip, true
        END IF
        PRINT #2, "F" + UCASE$(a$)
        ' fPRINT 2, "FXCH", lastc$

        IF simplenum = false THEN
          PRINT #2, ";ubsp2; Float save optimize"
          PUT #10, , tmpfop
          PRINT #2, "FLD QWORD [floatsave]"
          'PRINT #2, "FXCH"
        END IF
        lastcur = 1
      END SELECT

      tmp = existFUNCTION(a$, i)
      IF tmp = tsingle OR tmp = tdouble OR tmp = textended THEN
        PRINT #2, "FSTP QWORD [tmp]"
        PRINT #2, "PUSH DWORD [tmp]"
        PRINT #2, "PUSH DWORD [tmp+4]"
      SELECT CASE tmp
        CASE tsingle: Pushtext par$: call.sub a$, ubfunction: Poptext
          PRINT #2, "POP DWORD [tmp+4]"
          PRINT #2, "POP DWORD [tmp]"
          PRINT #2, "FLD QWORD [tmp]"
          PRINT #2, "FLD DWORD [eax]"
        CASE tdouble: Pushtext par$: call.sub a$, ubfunction: Poptext
          PRINT #2, "POP DWORD [tmp+4]"
          PRINT #2, "POP DWORD [tmp]"
          PRINT #2, "FLD QWORD [tmp]"
          PRINT #2, "FLD QWORD [eax]"
        CASE textended: Pushtext par$: call.sub a$, ubfunction: Poptext
          PRINT #2, "POP DWORD [tmp+4]"
          PRINT #2, "POP DWORD [tmp]"
          PRINT #2, "FLD QWORD [tmp]"
          PRINT #2, "FLD TWORD [eax]"
      END SELECT
      ELSE : GOTO label24
      END IF

    ELSEIF wordtype = intgr OR wordtype = float THEN
      IF INSTR(a$, ".") = 0 THEN
        wp$ = a$ + ".0"
      ELSE
        wp$ = a$
      END IF
    IF fpuworkmethod = textended THEN
      PRINT #3, "FPUVAL" + LTRIM$(STR$(curfpuval)) + " DT " + wp$
      PRINT #2, "FLD TWORD [FPUVAL" + LTRIM$(STR$(curfpuval)) + "]"
    ELSE
      PRINT #3, "FPUVAL" + LTRIM$(STR$(curfpuval)) + " DQ " + wp$
      PRINT #2, "FLD QWORD [FPUVAL" + LTRIM$(STR$(curfpuval)) + "]"
    END IF
      curfpuval = curfpuval + 1
    ELSE
label24:
      IF NOT wordtype = intgr AND NOT wordtype = float THEN
        IF NOT sexist(a$, i, typeblock$, mempos&, varshared) = -1 THEN GOTO label17

      tmp = existFUNCTION(a$, i)
      IF tmp = tsingle OR tmp = tdouble OR tmp = textended THEN
        PRINT #2, "FSTP QWORD [tmp]"
        PRINT #2, "PUSH DWORD [tmp]"
        PRINT #2, "PUSH DWORD [tmp+4]"
      SELECT CASE tmp
        CASE tsingle: Pushtext par$: call.sub a$, ubfunction: Poptext
          PRINT #2, "POP DWORD [tmp+4]"
          PRINT #2, "POP DWORD [tmp]"
          PRINT #2, "FLD QWORD [tmp]"
          PRINT #2, "FLD DWORD [eax]"
          GOTO label61
        CASE tdouble: Pushtext par$: call.sub a$, ubfunction: Poptext
          PRINT #2, "POP DWORD [tmp+4]"
          PRINT #2, "POP DWORD [tmp]"
          PRINT #2, "FLD QWORD [tmp]"
          PRINT #2, "FLD QWORD [eax]"
          GOTO label61
        CASE textended: Pushtext par$: call.sub a$, ubfunction: Poptext
          PRINT #2, "POP DWORD [tmp+4]"
          PRINT #2, "POP DWORD [tmp]"
          PRINT #2, "FLD QWORD [tmp]"
          PRINT #2, "FLD TWORD [eax]"
          GOTO label61
      END SELECT
      END IF

      SELECT CASE UCASE$(a$)
        CASE "TIMER"
          PRINT #2, "FSTP QWORD [tmp]"
          PRINT #2, "PUSH DWORD [tmp]"
          PRINT #2, "PUSH DWORD [tmp+4]"
          PRINT #2, "CALL Timer"
          PRINT #2, "POP DWORD [tmp+4]"
          PRINT #2, "POP DWORD [tmp]"
          PRINT #2, "FLD QWORD [tmp]"
          GOTO label61
      END SELECT
      
      IF Getconsttype(a$, value&, stringvalue$, floatvalue#) = intgr THEN
        PRINT #2, "MOV DWORD [temp], " + STR$(value&)
        PRINT #2, "FILD DWORD [temp]"
        GOTO label61
      ELSEIF Getconsttype(a$, value&, stringvalue$, floatvalue#) = float THEN
        value% = value&
        PRINT #2, "FLD QWORD [Constfloatval" + STR2$(value%) + "]"
        GOTO label61
      END IF

        sa$ = UCASE$(a$)
        tmp = INSTR(a$, ".")
        IF tmp > 0 THEN typeobj$ = MID$(a$, tmp + 1, LEN(a$) - tmp): a$ = MID$(a$, 1, tmp - 1)

        IF sexist(a$, i, typeblock$, mempos&, varshared) = -1 THEN
          IF Autoaddvars = true THEN
           IF ASC(MID$(sa$, 1, 1)) >= 65 AND ASC(MID$(sa$, 1, 1)) <= 90 THEN autoaddvariable sa$: GOTO label17
          END IF
          show.error 15, typeobj$ + "." + a$
        END IF
      
      END IF
label17:
      Getvarvalue a$, 3, typeobj$, leavemem, gotvartype
      
      SELECT CASE gotvartype
        CASE tbyte
          PRINT #2, "MOV EBX, 0 "
          PRINT #2, "MOV BL, [EAX]"
          PRINT #2, "MOV [temp], EBX"
          PRINT #2, "FILD DWORD [EBX]"
        CASE tinteger: PRINT #2, "FILD WORD [EAX]"
        CASE tlong: PRINT #2, "FILD DWORD [EAX]"
        CASE tsingle: PRINT #2, "FLD DWORD [EAX]"
        CASE tdouble: PRINT #2, "FLD QWORD [EAX]"
        CASE textended: PRINT #2, "FLD TWORD [EAX]"
      END SELECT
    END IF
label61:
    baklastcur = 0
    'IF lastcur = 0 THEN PRINT #2, "FXCH"': savewritepos& = SEEK(2): baklastcur = 1
    
    SELECT CASE UCASE$(lastc$)
      CASE "/", "\": PRINT #2, "FDIVP st1, st0"
      CASE "*": PRINT #2, "FMULP st1, st0"
      CASE "-": PRINT #2, "FSUBP st1, st0"
      CASE "+": PRINT #2, "FADDP st1, st0"
    END SELECT

    'PRINT #2, "FXCH"
    'PRINT #2, "FFREE st1"
    lastcur = 2
    current = 1
    lastc = 2
    GOTO label16
  END IF

label16:
LOOP
EXIT SUB

END SUB

FUNCTION getarg (mode, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)

startpos = getcharpos
IF startpos = 0 THEN startpos = 1
curarg = 1
DO WHILE NOT endloop = true
  a$ = getword$(wordtype)
  
  IF a$ = lineeof THEN Arg$(curarg) = MID$(codetext$, startpos, getcharpos - startpos): GOTO exitgetarg
  
  IF a$ = "," THEN
    Arg$(curarg) = MID$(codetext$, startpos, getcharpos - startpos)
    startpos = getcharpos + 1
    curarg = curarg + 1
  END IF
LOOP

exitgetarg:
getarg = curarg
IF mode = 0 THEN
arg1$ = Arg$(1)
arg2$ = Arg$(2)
arg3$ = Arg$(3)
arg4$ = Arg$(4)
arg5$ = Arg$(5)
arg6$ = Arg$(6)
arg7$ = Arg$(7)
arg8$ = Arg$(8)
arg9$ = Arg$(9)
arg10$ = Arg$(10)
END IF

END FUNCTION

FUNCTION getchar$

getcharpos = getcharpos + 1
IF getcharpos > LEN(codetext$) THEN getchar$ = lineeof: EXIT FUNCTION
getchar$ = MID$(codetext$, getcharpos, 1)

END FUNCTION

SUB getconditions (text$, cond1$, cond2$, cond$)
Pushtext text$

DO WHILE NOT endloop = true
  a$ = getword$(wordtype)
  IF a$ = lineeof THEN
    IF emptyifline = true THEN
    cond1$ = text$
    cond2$ = ""
    Poptext
    EXIT SUB
    ELSE : show.error 27, ""
    END IF
  END IF

  IF wordtype = condition THEN EXIT DO
LOOP

cond1$ = MID$(text$, 1, getcharpos - LEN(a$) - 1)
cond2$ = MID$(text$, getcharpos + 1, LEN(text$) - getcharpos)
cond$ = a$
Poptext
END SUB

FUNCTION GetNextcase$

DO WHILE NOT EOF(5)
  LINE INPUT #5, a$

  IF a$ = "; SELECT CASE START" THEN sel = sel + 1: GOTO label46

  IF a$ = "; SELECT CASE END" THEN
    IF sel = 0 THEN
      GetNextcase$ = "END": EXIT FUNCTION
    ELSE : sel = sel - 1: GOTO label46
    END IF
  END IF

  IF sel = 0 THEN GetNextcase$ = a$: EXIT FUNCTION
label46:
LOOP
show.error 31, ""

END FUNCTION

FUNCTION getnword$

word$ = getword$(wordtype)
IF NOT wordtype = normal AND NOT wordtype = withpar THEN show.error 3, word$
getnword$ = word$

END FUNCTION

FUNCTION Getscond$ (CMP$, end$)

CMP$ = ""
end$ = ""
startpos = getcharpos

DO WHILE NOT endloop = true
  a$ = getword$(wordtype)
    
  IF a$ = lineeof THEN
    Getscond$ = MID$(codetext$, startpos + 1, getcharpos - startpos - 1)
    end$ = "END"
    EXIT FUNCTION
  END IF

  IF UCASE$(a$) = "CASE" THEN startpos = getcharpos: GOTO label45

  IF UCASE$(a$) = "IS" THEN
    b$ = getword$(wordtype)
    IF NOT wordtype = condition THEN show.error 32, ""
    IF wordtype = condition THEN CMP$ = b$: startpos = getcharpos: GOTO label45
  END IF

  IF a$ = "," THEN
    Getscond$ = MID$(codetext$, startpos, getcharpos - startpos)
    EXIT FUNCTION
  END IF

label45:
LOOP
END FUNCTION

FUNCTION getshift& (number)
getshift2& = 1
FOR i = 1 TO number
  getshift2& = getshift2& * 2
NEXT i
getshift& = getshift2&
END FUNCTION

FUNCTION gettempdir$

IF usedirtmp = true THEN gettempdir$ = "tmp\": EXIT FUNCTION

a$ = ENVIRON$("TEMP")
IF NOT a$ = "" THEN
  IF NOT MID$(a$, LEN(a$), 1) = "\" THEN a$ = a$ + "\"
  gettempdir$ = a$
  EXIT FUNCTION
END IF

a$ = ENVIRON$("TMP")
IF NOT a$ = "" THEN
  IF NOT MID$(a$, LEN(a$), 1) = "\" THEN a$ = a$ + "\"
  gettempdir$ = a$
  EXIT FUNCTION
END IF

gettempdir$ = "TMP\"

END FUNCTION

FUNCTION gettypemempos& (name$, obj$, objtype)

FOR i = 0 TO curtype
  IF UCASE$(name$) = UCASE$(typename$(i)) THEN
    tfile$ = tmpdir$ + "\tf" + LTRIM$(STR$(i)) + ".typ"
    OPEN tfile$ FOR INPUT AS #100
    DO WHILE NOT EOF(100)
      INPUT #100, a$
      IF UCASE$(a$) = UCASE$(obj$) THEN
        INPUT #100, gettypemempos&
        INPUT #100, b$
        SELECT CASE b$
          CASE "STRING": objtype = tstring
          CASE "LONG":   objtype = tlong
          CASE "INTEGER": objtype = tinteger
          CASE "EXTENDED": objtype = textended
          CASE "SINGLE":  objtype = tsingle
          CASE "DOUBLE":  objtype = tdouble
          CASE "BYTE":    objtype = tbyte
        END SELECT
        
        INPUT #100, a$
        IF NOT EOF(100) THEN
          INPUT #100, a$
          nexttypepos = VAL(a$)
        ELSE : nexttypepos = VAL(a$)
        END IF

        CLOSE #100
        EXIT FUNCTION
      END IF
    LOOP
    CLOSE #100
    gettypemempos& = -1
    EXIT FUNCTION
  END IF
NEXT i
gettypemempos& = -1

END FUNCTION

' ---- Sub para cargar las estructuras TYPE
SUB Gettypestructure

IF insidesub = true THEN show.error 10, ""

REDIM PRESERVE typename$(curtype + 1)

tname$ = getnword$

typename$(curtype) = tname$

tfile$ = tmpdir$ + "\tf" + LTRIM$(STR$(curtype)) + ".typ"

endloop = false
mempos& = 0
OPEN tfile$ FOR OUTPUT AS #100
  DO WHILE NOT endloop = true

    readline 1, codetext$
    getcharpos = 0

    'a$ = getnword$
    a$ = getword$(wordtype)
    IF a$ = lineeof THEN GOTO loop01

    Dims = 1
    IF wordtype = withpar THEN 'For Arrays inside types
      Pushtext par$
        Args = getarg(1, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)
      Poptext
      FOR i = 1 TO Args
        Dims = Dims * VAL(Arg$(i))
      NEXT
    END IF

    IF UCASE$(a$) = "END" THEN
      IF UCASE$(getnword$) = "TYPE" THEN PRINT #100, mempos&: endloop = true: GOTO loop01
    END IF
    b$ = getnword$
    IF NOT UCASE$(b$) = "AS" THEN show.error 4, ""
    t$ = getnword$
    PRINT #100, UCASE$(a$)
    PRINT #100, mempos&
    SELECT CASE UCASE$(t$)
      CASE "STRING":
        C$ = getnword$
        IF NOT C$ = "*" THEN show.error 5, ""
        C$ = getword$(wordtype)
        IF NOT wordtype = intgr AND NOT wordtype = float THEN show.error 6, ""
        tmp& = VAL(C$)
        mempos& = mempos& + tmp& * Dims
      CASE "LONG": mempos& = mempos& + 4 * Dims
      CASE "INTEGER": mempos& = mempos& + 2 * Dims
      CASE "EXTENDED": mempos& = mempos& + 10 * Dims
      CASE "SINGLE": mempos& = mempos& + 4 * Dims
      CASE "DOUBLE": mempos& = mempos& + 8 * Dims
      CASE "BYTE": mempos& = mempos& + 1 * Dims
      CASE ELSE
        PRINT #100, UCASE$(t$)
        GetSubType t$, a$, mempos&
        t$ = ""
        'mempos& = mempos& + returntypesize&(t$, typenum) * Dims
    END SELECT
    IF t$ <> "" THEN PRINT #100, UCASE$(t$)
loop01:
  LOOP
CLOSE #100
curtype = curtype + 1
END SUB

SUB Getvarvalue (name$, current, typeobj$, leave, gotvartype)
a$ = name$

IF insidesub = true THEN vartype = subexist(a$, i, varshared, typeblock$, mempos&)
IF NOT insidesub = true THEN vartype = exist(a$, i, typeblock$, mempos&)

IF vartype = -1 THEN show.error 15, a$

IF current <= 1 THEN
  b$ = "EAX": b2$ = "AX": b3$ = "AL"
ELSE : b$ = "EBX": b2$ = "BX": b3$ = "BL"
END IF

' *-----------------------*
' *   Variables Comunes   *
' *-----------------------*
IF NOT lastfound = arraytype THEN
  IF varshared = true OR NOT insidesub = true THEN
    e$ = "EDI"
  ELSEIF insidesub = true THEN
    e$ = "ESI"
  END IF

  IF leave = leavevalue THEN
   IF mempos& = 0 THEN
     regadd$ = ""
   ELSE
     regadd$ = "+" + STR$(mempos&)
   END IF

   IF vartype = tbyte THEN
   IF directaddsub$ = "" THEN
     IF fixedvar = true THEN
       PRINT #2, "MOV " + b$ + ",0"
       PRINT #2, "___STACKEDIT1___"
       PRINT #2, "MOV EDX, [" + e$ + regadd$ + "]"
       PRINT #2, "MOV " + b3$ + ", [EDX]"
     ELSE
       PRINT #2, "MOV " + b$ + ",0"
       PRINT #2, "___STACKEDIT1___"
       PRINT #2, "MOV " + b3$ + ", [" + e$ + regadd$ + "]"
     END IF
   ELSE
     PRINT #2, "___STACKEDIT1___"
     directaddsub$ = "[" + e$ + regadd$ + "]"
   END IF
   END IF
   IF vartype = tinteger THEN
   IF directaddsub$ = "" THEN
     IF fixedvar = true THEN
       PRINT #2, "MOV " + b$ + ",0"
       PRINT #2, "___STACKEDIT1___"
       PRINT #2, "MOV EDX, [" + e$ + regadd$ + "]"
       PRINT #2, "MOV " + b2$ + ", [EDX]"
     ELSE
       PRINT #2, "MOV " + b$ + ",0": PRINT #2, "___STACKEDIT1___": PRINT #2, "MOV " + b2$ + ", [" + e$ + regadd$ + "]"
     END IF
   ELSE
     PRINT #2, "___STACKEDIT1___"
     directaddsub$ = "[" + e$ + regadd$ + "]"
   END IF
   END IF

   IF vartype = tlong THEN
   IF directaddsub$ = "" THEN
     IF fixedvar = true THEN
       PRINT #2, "___STACKEDIT1___"
       PRINT #2, "MOV EDX, [" + e$ + regadd$ + "]"
       PRINT #2, "MOV " + b$ + ", [EDX]"
     ELSE
       PRINT #2, "___STACKEDIT1___": PRINT #2, "MOV " + b$ + ", [" + e$ + regadd$ + "]"
     END IF
   ELSE
     PRINT #2, "___STACKEDIT1___"
     directaddsub$ = "[" + e$ + regadd$ + "]"
   END IF
   END IF

   IF vartype = tsingle THEN PRINT #2, "MOV EAX, [" + e$ + "+" + STR$(mempos&) + "]"
   IF vartype = tdouble THEN
     PRINT #2, "MOV EAX, [" + e$ + "+" + STR$(mempos&) + "]"
     PRINT #2, "MOV EBX, [" + e$ + "+" + STR$(mempos& + 4) + "]"
   END IF
   IF vartype = textended THEN
     PRINT #2, "MOV EAX, [" + e$ + "+" + STR$(mempos&) + "]"
     PRINT #2, "MOV EBX, [" + e$ + "+" + STR$(mempos& + 4) + "]"
     PRINT #2, "MOV CX, [" + e$ + "+" + STR$(mempos& + 8) + "]"
   END IF
   gotvartype = vartype
 ELSEIF leave = leavemem3 THEN
   IF fixedvar = true THEN vartype = tlong: fixedvar = false: GOTO label32
 ELSEIF leave = leavemem2 THEN
label32:
   IF mempos& = 0 THEN
     e2$ = e$
   ELSE
     e2$ = e$ + "+" + STR$(mempos&)
     PRINT #2, "___STACKEDIT1___"
   END IF

   IF fixedvar = true THEN
     PRINT #2, "MOV EDX, [" + e2$ + "]"
     IF vartype = tbyte THEN PRINT #2, "MOV [EDX], AL"
     IF vartype = tinteger THEN PRINT #2, "MOV [EDX], AX"
     IF vartype = tlong THEN PRINT #2, "MOV [EDX], EAX"
   ELSE
     IF vartype = tbyte THEN PRINT #2, "MOV [" + e2$ + "], AL"
     IF vartype = tinteger THEN PRINT #2, "MOV [" + e2$ + "], AX"
     IF vartype = tlong THEN PRINT #2, "MOV [" + e2$ + "], EAX"
   END IF
   IF vartype = tsingle THEN
     PRINT #2, "MOV [temp], EAX"
     PRINT #2, "FILD DWORD [temp]"
     PRINT #2, "FISTP DWORD [" + e2$ + "]"
   ELSEIF vartype = tdouble THEN
     PRINT #2, "MOV [temp], EAX"
     PRINT #2, "FILD DWORD [temp]"
     PRINT #2, "FISTP QWORD [" + e2$ + "]"
   ELSEIF vartype = textended THEN
     PRINT #2, "MOV [temp], EAX"
     PRINT #2, "FILD DWORD [temp]"
     PRINT #2, "FISTP TWORD [" + e2$ + "]"
   END IF
 ELSE
 IF NOT fixedvar = true THEN
   PRINT #2, "MOV EAX, " + e$
   'IF NOT i = 0 THEN PRINT #2, "___STACKEDIT1___": PRINT #2, "ADD EAX, " + STR$(mempos&)
   IF NOT mempos& = 0 THEN PRINT #2, "___STACKEDIT1___": PRINT #2, "ADD EAX, " + STR$(mempos&)
   gotvartype = vartype
 ELSE
   PRINT #2, "___STACKEDIT1___"
   PRINT #2, "MOV EAX, [" + e$ + "+" + STR$(mempos&) + "]"
   gotvartype = vartype
 END IF
 END IF
ELSE
' *-----------------------*
' *       Matrices        *
' *-----------------------*

  size$ = par$

  IF insidesub = true THEN
    IF varshared = true THEN
      arraytext$ = "Array" + LTRIM$(STR$(i))
    ELSE : arraytext$ = "ESI+" + LTRIM$(STR$(ABS(subextraarraydata(i)))) '"subArray" + LTRIM$(STR$(i))
    END IF
  ELSE
    arraytext$ = "Array" + LTRIM$(STR$(i))
  END IF

  IF current = 2 THEN PRINT #2, "PUSH EAX"

  IF size$ = "" THEN
    PRINT #2, "MOV EAX, 0"
  ELSE
    'Math.parser size$, intgr, 0
    IF varshared = true THEN i = -i
    GetDimensions size$, i
  END IF

  IF typeblock$ = "" THEN
    SELECT CASE memused(vartype)
      CASE 2: PRINT #2, "SHL EAX, 1"
      CASE 4: PRINT #2, "SHL EAX, 2"
      CASE 8: PRINT #2, "SHL EAX, 3"
      CASE ELSE: PRINT #2, "MOV EBX, " + STR$(memused(vartype)): PRINT #2, "MUL EBX"
    END SELECT
    gotvartype = vartype
  ELSE
    IF NOT size$ = "" THEN
      tmp2 = returntypesize&(typeblock$, i)
      PRINT #2, "MOV EBX, " + STR$(tmp2)
      PRINT #2, "MUL EBX"
    END IF
    
    tmp2 = gettypemempos&(typeblock$, typeobj$, objtype)
    IF tmp2 = -1 THEN show.error 13, a$ + "." + typeobj$
    vartype = objtype
    gotvartype = objtype
    IF NOT size1$ = "" THEN PRINT #2, "MUL EBX"
  END IF
  
  PRINT #2, "ADD EAX, [" + arraytext$ + "]"

  IF NOT typeblock$ = "" THEN IF NOT tmp2 = 0 THEN PRINT #2, "ADD EAX, " + STR$(tmp2)

IF leave = leavevalue THEN
  SELECT CASE vartype
    CASE tinteger: PRINT #2, "MOV EBX, 0": PRINT #2, "MOV BX, [EAX]"
    CASE tlong: PRINT #2, "MOV EBX, [EAX]"
    CASE tbyte: PRINT #2, "MOV EBX, 0": PRINT #2, "MOV BL, [EAX]"
    CASE tsingle: PRINT #2, "MOV EBX, [EAX]": PRINT #2, "MOV EAX, EBX"
    CASE tdouble
      PRINT #2, "MOV EDX, EAX"
      PRINT #2, "MOV EAX, [EDX]"
      PRINT #2, "MOV EBX, [EDX+4]"
    CASE textended
      PRINT #2, "MOV EDX, EAX"
      PRINT #2, "MOV EAX, [EDX]"
      PRINT #2, "MOV EBX, [EDX+4]"
      PRINT #2, "MOV CX, [EDX+8]"
    CASE ELSE: show.error 14, a$ + "." + typeobj$
  END SELECT
END IF

  IF current = 0 THEN
    PRINT #2, "MOV EAX, EBX"
  ELSEIF current = 2 THEN
    PRINT #2, "POP EAX"
  END IF

END IF

END SUB

FUNCTION getword$ (wordtype)

' Getword$, comparado con la version 0.31 the Gabasic, esta
' es 100 veces mejor

par$ = ""
parentesis = 0

DO WHILE NOT endloop = true
  char$ = getchar$
  IF NOT char$ = CHR$(32) AND NOT char$ = CHR$(9) THEN endloop = true
  IF char$ = lineeof OR char$ = "'" THEN getword$ = lineeof: wordtype = normal: EXIT FUNCTION
LOOP

endloop = false

IF char$ = "'" THEN getword$ = lineeof: EXIT FUNCTION

IF char$ = "," THEN wordtype = normal: getword$ = ",": EXIT FUNCTION

IF NOT asmscan = true THEN
IF char$ = CHR$(34) THEN
  text$ = ""
  endloop3 = 0
  DO WHILE NOT endloop3 = true
    char$ = getchar$
    IF char$ = CHR$(34) THEN EXIT DO
    text$ = text$ + char$
    IF char$ = lineeof THEN PRINT : show.error 1, ""
  LOOP

  ' getcharpos = getcharpos + 1
  getword$ = text$
  wordtype = stringtype
  EXIT FUNCTION
END IF

IF char$ = "-" OR char$ = "." THEN
  tmp$ = getchar$
  getcharpos = getcharpos - 1
  IF ASC(tmp$) >= 48 AND ASC(tmp$) <= 57 THEN
    IF char$ = "." THEN wordtype = float: GOTO label1
    GOTO label0
  END IF
END IF

IF ignorenumbertype = false THEN
IF ASC(char$) >= 48 AND ASC(char$) <= 57 THEN
label0:
  wordtype = intgr
label1:
  text$ = char$
  DO WHILE NOT endloop = true
    char$ = getchar$
    IF char$ = "." THEN wordtype = float
    IF char$ = "," THEN getcharpos = getcharpos - 1: getword$ = text$: GOTO checktype
    IF char$ = CHR$(9) OR char$ = CHR$(32) THEN getword$ = text$: GOTO checktype
    IF char$ = lineeof OR char$ = "'" THEN getword$ = text$: GOTO checktype
    text$ = text$ + char$
  LOOP
' * Por las dudas
' * Quiza no tenga un punto pero exceda los limites de un LONG
checktype:
  t$ = LCASE$(MID$(text$, LEN(text$), 1))
  IF t$ = "b" OR t$ = "h" THEN EXIT FUNCTION

  IF ignorefloaterror = true THEN
    ON LOCAL ERROR GOTO label02
  END IF

  tmp# = VAL(text$)
  IF tmp# < -2147483648# OR tmp# > 2147483647 THEN wordtype = float

  EXIT FUNCTION
label02:
  wordtype = float
  ON LOCAL ERROR GOTO 0
  EXIT FUNCTION
END IF
END IF

IF char$ = "<" OR char$ = ">" OR char$ = "=" THEN
  wordtype = condition
  tmp$ = char$
  char$ = getchar$
  IF char$ = "<" OR char$ = ">" OR char$ = "=" THEN
    t$ = tmp$ + char$
    IF t$ = "<<" OR t$ = ">>" THEN wordtype = normal
    getword$ = tmp$ + char$: EXIT FUNCTION
  END IF
  getword$ = tmp$
  EXIT FUNCTION
END IF

a$ = ""
IF char$ = "(" THEN
  wordtype = withpar
  DO WHILE NOT endloop = true
    char$ = getchar$

    IF char$ = CHR$(34) THEN
      a$ = a$ + char$
      endloop2 = false
      DO WHILE NOT endloop2 = true
        char$ = getchar$
        IF char$ = CHR$(34) THEN a$ = a$ + char$: EXIT DO
        a$ = a$ + char$
      LOOP
    END IF

    IF char$ = ")" AND parentesis = 0 THEN
      getword$ = ""
      par$ = a$: EXIT FUNCTION
    ELSEIF char$ = ")" THEN
      parentesis = parentesis - 1
    END IF

    IF char$ = "(" THEN parentesis = parentesis + 1
    
    IF char$ = lineeof THEN show.error 7, ""
    a$ = a$ + char$
  LOOP
END IF
END IF

text$ = char$
wordtype = normal
a$ = ""
DO WHILE NOT endloop = true
  char$ = getchar$
IF NOT asmscan = true THEN
  IF char$ = "(" THEN
    IF wordtype = withpar AND parentesis = 0 THEN a$ = a$ + ","
    wordtype = withpar
    DO WHILE NOT endloop = true
      char$ = getchar$

    IF char$ = CHR$(34) THEN
      a$ = a$ + char$
      endloop2 = false
      DO WHILE NOT endloop2 = true
        char$ = getchar$
        a$ = a$ + char$
        IF char$ = CHR$(34) THEN endloop2 = true: EXIT DO
        IF char$ = lineeof THEN show.error 1, ""
      LOOP
      GOTO label30
    END IF

      IF char$ = ")" AND parentesis = 0 THEN
        par$ = a$: EXIT DO
      ELSEIF char$ = ")" THEN
        parentesis = parentesis - 1
      END IF

      IF char$ = "(" THEN parentesis = parentesis + 1
      IF char$ = lineeof THEN show.error 7, ""
      a$ = a$ + char$
label30:
    LOOP
    GOTO label09
  END IF
END IF

  IF char$ = "," THEN getword$ = text$: getcharpos = getcharpos - 1: EXIT FUNCTION
  IF char$ = CHR$(9) OR char$ = CHR$(32) THEN getword$ = text$: EXIT FUNCTION
  IF char$ = lineeof OR char$ = "'" THEN getword$ = text$: EXIT FUNCTION
  text$ = text$ + char$

label09:
LOOP

END FUNCTION

SUB IMath.Parser (text$)
' Math Parser, para numeros enteros

Pushtext text$
printc "intgrMath: " + text$
current = 0

DO WHILE NOT endloop = true
  a$ = getword$(wordtype)
  usenot = false
  typeblock$ = ""
  IF a$ = lineeof THEN Poptext: directaddsub$ = "": EXIT SUB
  
  ' *---- PRIMERA LECTURA
  IF current = 0 THEN
    ' Para los bloques de TYPE
    IF UCASE$(a$) = "NOT" THEN a$ = getword$(wordtype): usenot = true
    IF wordtype = withpar THEN
      SELECT CASE existFUNCTION(a$, i)
        CASE tlong, tinteger, tbyte
        Pushtext par$
          call.sub a$, ubfunction
        Poptext
        GOTO label58
      END SELECT

      tmp = INSTR(a$, ".")

      IF tmp > 0 THEN
        sa$ = MID$(a$, 1, tmp - 1)
        typeobj$ = MID$(a$, tmp + 1, (LEN(a$) - tmp) + 1)
      ELSE
        sa$ = a$
      END IF
      
      IF NOT sexist(sa$, i, typeblock$, mempos&, varshared) = -1 THEN a$ = sa$: GOTO label10

      SELECT CASE UCASE$(a$)
      CASE "VARPTR", "SADD"
        aaa = kw.varptr
        IF aaa = tstring THEN
          PRINT #2, "MOV EAX, ECX"
        END IF
        GOTO label49
      CASE "LPTR": kw.lptr 0: GOTO label49
      CASE "CODEPTR": kw.codeptr: GOTO label49
      CASE "ASC"
        kw.asc par$
        PRINT #2, "MOV EAX, EBX"
        GOTO label49
      CASE "VAL"
        kw.val par$
        GOTO label49
      CASE "LEN"
        kw.len par$
        PRINT #2, "MOV EAX, EBX"
        GOTO label49
      END SELECT

      Math.parser par$, intgr, 0
      SELECT CASE UCASE$(a$)
        CASE "PEEK", "PEEKB": PRINT #2, "MOV EBX, 0": PRINT #2, "MOV BL, [EAX]": PRINT #2, "MOV EAX, EBX"
        CASE "PEEKW": PRINT #2, "MOV EBX, 0": PRINT #2, "MOV BX, [EAX]": PRINT #2, "MOV EAX, EBX"
        CASE "PEEKD":  PRINT #2, "MOV EBX, [EAX]": PRINT #2, "MOV EAX, EBX"
        CASE "CPUFLAGS": PRINT #2, "PUSHFD": PRINT #2, "POP EAX"
        CASE "LOF": PRINT #2, "CALL Lof"
        CASE "EOF": PRINT #2, "SHL EAX, 2"
                    PRINT #2, "MOV EBX, [EAX+fileeof]"
                    PRINT #2, "MOV EAX, EBX"
        CASE "ABS": PRINT #2, "CALL NEAR ABSeax"
        CASE "SGN": PRINT #2, "CALL NEAR SGNeax"
        CASE "SEEK": PRINT #2, "CALL NEAR Getfilepos"
        CASE "INT": 'Math.Parser par$, intgr, 0
        CASE "INPB", "INP": kw.inp tbyte, 1
        CASE "INPW": kw.inp tinteger, 1
        CASE "INPD": kw.inp tlong, 1
      END SELECT
label49:
    ELSEIF NOT wordtype = intgr AND NOT wordtype = float THEN
      IF NOT sexist(a$, i, typeblock$, mempos&, varshared) = -1 THEN GOTO label10

      IF Getconsttype(a$, value&, stringvalue$, floatvalue#) = intgr THEN
        PRINT #2, "MOV EAX, " + STR$(value&)
        GOTO label58
      END IF

      sa$ = UCASE$(a$)
      tmp = INSTR(a$, ".")
      IF tmp > 0 THEN typeobj$ = MID$(a$, tmp + 1, LEN(a$) - tmp): a$ = MID$(a$, 1, tmp - 1)

      IF sexist(a$, i, typeblock$, mempos&, varshared) = -1 THEN
        SELECT CASE existFUNCTION(sa$, i)
         CASE tlong, tinteger, tbyte
         Pushtext par$
          call.sub sa$, ubfunction
         Poptext
         GOTO label58
        END SELECT

        IF Autoaddvars = true THEN
        IF ASC(MID$(sa$, 1, 1)) >= 65 AND ASC(MID$(sa$, 1, 1)) <= 90 THEN autoaddvariable sa$: GOTO label10
        END IF
        show.error 8, a$
      END IF
    END IF

label10:
    IF NOT sexist(a$, i, typeblock$, mempos&, varshared) = -1 THEN
      Getvarvalue a$, current, typeobj$, leavevalue, gotvartype
    ELSE
      IF wordtype = intgr OR wordtype = float THEN PRINT #2, "MOV EAX, " + a$
    END IF
label58:
    current = 1
    IF usenot = true THEN PRINT #2, "NOT EAX"
    GOTO label05
  END IF

  ' *---- CARGA LA OPERACION
  IF current = 1 THEN
    IF NOT par$ = "" THEN getcharpos = getcharpos - LEN(par$) - 3
    lastc$ = a$
    current = 2
    GOTO label05
  END IF

  IF current = 2 THEN
    IF wordtype = withpar AND a$ = "" THEN
      reguse$ = "EBX"
      PRINT #2, "PUSH EAX"
      Math.parser par$, intgr, 0
      PRINT #2, "MOV EBX, EAX"
      PRINT #2, "POP EAX"
      GOTO label51
    END IF

    IF UCASE$(a$) = "NOT" THEN a$ = getword$(wordtype): usenot = true
    IF wordtype = withpar THEN
      SELECT CASE existFUNCTION(a$, i)
        CASE tlong, tinteger, tbyte
        Pushtext par$
          PRINT #2, "PUSH EAX"
          call.sub a$, ubfunction
          'PRINT #2, "MOV EAX, EBX"
          PRINT #2, "MOV EBX, EAX"
          PRINT #2, "POP EAX"
        Poptext
        reguse$ = "EBX"
        GOTO label51
      END SELECT

      tmp = INSTR(a$, ".")

      IF tmp > 0 THEN
        typeobj$ = MID$(a$, tmp + 1, (LEN(a$) - tmp) + 1)
        sa$ = MID$(a$, 1, tmp - 1)
      ELSE
        sa$ = a$
      END IF
      
      IF NOT sexist(sa$, i, typeblock$, mempos&, varshared) = -1 THEN a$ = sa$: GOTO label21

      SELECT CASE UCASE$(a$)
      CASE "VARPTR", "SADD"
        PRINT #2, "PUSH EAX"
        aaa = kw.varptr

        IF aaa = tstring THEN
          PRINT #2, "MOV EBX, ECX"
        ELSE
          PRINT #2, "MOV EBX, EAX"
        END IF
        PRINT #2, "POP EAX"
        reguse$ = "EBX"
        GOTO label50
      CASE "LOF"
        PRINT #2, "PUSH EAX"
        Math.parser par$, intgr, 0
        PRINT #2, "CALL Lof"
        PRINT #2, "MOV EBX, EAX": PRINT #2, "POP EAX"
        GOTO label50
      CASE "LPTR"
        kw.lptr 2
        GOTO label50
      CASE "CODEPTR"
        PRINT #2, "PUSH EAX"
        kw.codeptr
        PRINT #2, "MOV EBX, EAX"
        PRINT #2, "POP EAX"
        GOTO label50
      CASE "ASC"
        PRINT #2, "PUSH EAX"
        kw.asc par$
        PRINT #2, "POP EAX"
        GOTO label50
      CASE "VAL"
        PRINT #2, "PUSH EAX"
        kw.val par$
        PRINT #2, "MOV EBX, EAX"
        PRINT #2, "POP EAX"
        reguse$ = "EBX"
        GOTO label50
      CASE "SEEK"
        PRINT #2, "PUSH EAX"
        Math.parser par$, intgr, 0
        PRINT #2, "CALL NEAR Getfilepos"
        PRINT #2, "MOV EBX, EAX": PRINT #2, "POP EAX"
        GOTO label50
      CASE "LEN"
        PRINT #2, "PUSH EAX"
        kw.len par$
        PRINT #2, "POP EAX"
        GOTO label50
      END SELECT

      PRINT #2, "PUSH EAX"
      Math.parser par$, intgr, 0
      PRINT #2, "MOV EBX, EAX"
      PRINT #2, "POP EAX"
      reguse$ = "EBX"
      SELECT CASE UCASE$(a$)
        CASE "PEEK", "PEEKB": PRINT #2, "MOV EBX, 0": PRINT #2, "MOV BL, [EAX]"
        CASE "PEEKW": PRINT #2, "MOV EBX, 0": PRINT #2, "MOV BX, [EAX]"
        CASE "PEEKD":  PRINT #2, "MOV EBX, [EAX]"
        CASE "CPUFLAGS": PRINT #2, "PUSHFD": PRINT #2, "POP EBX"
        CASE "EOF": PRINT #2, "SHL EBX, 2"
                    PRINT #2, "MOV ECX, [EBX+fileeof]"
                    PRINT #2, "MOV EBX, ECX"
        CASE "ABS": PRINT #2, "CALL NEAR ABSebx"
        CASE "SGN": PRINT #2, "CALL NEAR SGNebx"
        CASE "INPB", "INP": kw.inp tbyte, 2
        CASE "INPW": kw.inp tinteger, 2
        CASE "INPD": kw.inp tlong, 2
        CASE "INT": 'PRINT #2, "PUSH EAX"
                    'Math.Parser par$, intgr, 0: PRINT #2, "MOV EBX, EAX"
                    'PRINT #2, "POP EAX"
      END SELECT
label50:
    ELSEIF wordtype = intgr THEN
      IF lastc$ = "*" OR UCASE$(lastc$) = "/" OR lastc$ = "\" OR UCASE$(lastc$) = "MOD" THEN
        PRINT #2, "MOV EBX, " + a$
        reguse$ = "EBX"
      ELSE
        reguse$ = a$
      END IF
    ELSE
      IF NOT wordtype = intgr AND NOT wordtype = float THEN
label21:
        IF NOT sexist(a$, i, typeblock$, mempos&, varshared) = -1 THEN GOTO label11
        IF Getconsttype(a$, value&, stringvalue$, floatvalue#) = intgr THEN
          PRINT #2, "MOV EBX, " + STR$(value&)
          GOTO label59
        END IF

        sa$ = UCASE$(a$)
        tmp = INSTR(a$, ".")
        IF tmp > 0 THEN typeobj$ = MID$(a$, tmp + 1, LEN(a$) - tmp): a$ = MID$(a$, 1, tmp - 1)
        IF sexist(a$, i, typeblock$, mempos&, varshared) = -1 THEN
        SELECT CASE existFUNCTION(sa$, i)
          CASE tlong, tinteger, tbyte
          Pushtext par$
            PRINT #2, "PUSH EAX"
            call.sub sa$, ubfunction
            'PRINT #2, "MOV EAX, EBX"
            PRINT #2, "MOV EBX, EAX"
            PRINT #2, "POP EAX"
          Poptext
          reguse$ = "EBX"
          GOTO label51
        END SELECT
        
        IF Autoaddvars = true THEN
          IF ASC(MID$(sa$, 1, 1)) >= 65 AND ASC(MID$(sa$, 1, 1)) <= 90 THEN autoaddvariable sa$: GOTO label11
        END IF
          show.error 15, typeobj$ + "." + a$
        END IF
      END IF
label11:
      IF lastc$ = "+" OR lastc$ = "-" THEN
        IF NOT usenot = true THEN
        directaddsub$ = "ads"
        IF fixedvar = true THEN GOTO label57
        Getvarvalue a$, current, typeobj$, leavevalue, gotvartype
        reguse$ = directaddsub$
        ELSE : GOTO label57
        END IF
      ELSE
label57: directaddsub$ = ""
        Getvarvalue a$, current, typeobj$, leavevalue, gotvartype
label59: reguse$ = "EBX"
        IF usenot = true THEN PRINT #2, "NOT EBX"
      END IF
    END IF
label51:
    SELECT CASE UCASE$(lastc$)
      CASE "/", "\": PRINT #2, "MOV EDX, 0": PRINT #2, "IDIV " + reguse$
      CASE "*": PRINT #2, "IMUL " + reguse$
      CASE "-": PRINT #2, "SUB EAX, " + reguse$
      CASE "+": PRINT #2, "ADD EAX, " + reguse$
      CASE "<<", "SHL": PRINT #2, "MOV ECX, " + reguse$: PRINT #2, "SHL EAX, CL"
      CASE ">>", "SHR": PRINT #2, "MOV ECX, " + reguse$: PRINT #2, "SHR EAX, CL"
      CASE "AND": PRINT #2, "AND EAX, " + reguse$
      CASE "OR": PRINT #2, "OR EAX, " + reguse$
      CASE "XOR": PRINT #2, "XOR EAX, " + reguse$
      CASE "ROR": PRINT #2, "ROR EAX, " + reguse$
      CASE "ROL": PRINT #2, "ROL EAX, " + reguse$
      CASE "MOD", "%": PRINT #2, "MOV EDX, 0": PRINT #2, "IDIV " + reguse$: PRINT #2, "MOV EAX, EDX"
    END SELECT

    current = 1
    GOTO label05
  END IF

label05:
directaddsub$ = ""
LOOP
EXIT SUB

END SUB

SUB Main

OPEN cleanbas$ FOR INPUT AS #1
OPEN codefile$ FOR OUTPUT AS #2
OPEN datafile$ FOR OUTPUT AS #3
OPEN optimizepushpop$ FOR OUTPUT AS #4
OPEN selectcasetmp$ FOR OUTPUT AS #5
OPEN subfile$ FOR OUTPUT AS #6
OPEN submemalloc$ FOR OUTPUT AS #7
OPEN constdef$ FOR BINARY AS #8
OPEN constdat$ FOR BINARY AS #9
OPEN floatoptimize$ FOR BINARY AS #10
IF NOT errfile$ = "" THEN
  OPEN errfile$ FOR OUTPUT AS #11
END IF

ifcond = true
filecounter = 0
LINE INPUT #1, incfile$(0)
FOR i = 0 TO 20
  incfilen(i) = 0
NEXT i

PRINT #2, "FINIT"

n = 0: Cur = 0

DO WHILE NOT EOF(1)
  IF n - Cur <= 0 THEN
    readline 1, codetext$
    Cur = 0
    IF asmsub = false THEN IF writebaslinetoasm = true THEN PRINT #2, ";; ** " + codetext$
    fullcodetext$ = codetext$
  ELSE
    Cur = Cur + 1
  END IF
  n = GetCommands(fullcodetext$, Cur)

  getcharpos = 0

  IF fullcodetext$ = "---- File add ----" THEN
    incfilen(filecounter) = incfilen(filecounter) - 1
    filecounter = filecounter + 1
    LINE INPUT #1, incfile$(filecounter)
    GOTO label12
  ELSEIF fullcodetext$ = "---- File end ----" THEN
    incfilen(filecounter) = incfilen(filecounter) - 1
    filecounter = filecounter - 1
    GOTO label12
  ELSEIF fullcodetext$ = "---- File sub add ----" THEN
    filecounter = filecounter + 1
    GOTO label12
  END IF

  word$ = getword$(wordtype)
  IF word$ = lineeof THEN GOTO label12
  IF RIGHT$(word$, 1) = ":" THEN wordtype = normal
  IF NOT wordtype = normal AND NOT wordtype = withpar THEN show.error 2, word$

' ------ COMPILE-TIME keywords ---------
  SELECT CASE UCASE$(word$)
    CASE "%%INCLUDE:", "%%INCLUDE": GOTO label12
    CASE "%%DESTOS:", "%%PLATFORM:":
      a$ = UCASE$(getword$(wordtype))
      IF a$ = "DOS32" OR a$ = "DOS" THEN platform = dos
      IF a$ = "WIN32" OR a$ = "WIN" THEN platform = win32
      GOTO label12
    CASE "%%IFC"
      IF ifcond = false THEN skipcif = skipcif + 1: GOTO label12
      PUSH ifcond
      PUSH cworkif
      cworkif = ccurif
      a$ = getword$(wordtype)
      IF LCASE$(a$) = "NOT" THEN negif = true: a$ = getword$(wordtype)
      t = Getconsttype(a$, value&, stringvalue$, floatvalue#)

      IF t = -1 THEN
        ifcond = negif
      ELSE
        ifcond = NOT negif
      END IF

      ccurif = ccurif + 1
      GOTO label12
    CASE "%%IF"
      IF ifcond = false THEN skipcif = skipcif + 1: GOTO label12
      PUSH ifcond
      PUSH cworkif
      cworkif = ccurif
      ifcond = processcif
      ccurif = ccurif + 1
      GOTO label12
    CASE "%%ELSE"
      IF NOT skipcif = 0 THEN GOTO label12
      ifcond = NOT ifcond: GOTO label12
    CASE "%%ENDIF"
      IF NOT skipcif = 0 THEN
        skipcif = skipcif - 1
        GOTO label12
      END IF
      POP cworkif
      POP ifcond
      GOTO label12
    CASE "%%SECSTACK": secstack = true: GOTO label12
    CASE ELSE: IF ifcond = false THEN GOTO label12
  END SELECT

'  ------------- RUN-TIME keywords -----------
  IF asmsub = true THEN
    IF UCASE$(word$) = "END" THEN
    a$ = getword$(wordtype)
    IF UCASE$(a$) = "ASM_SUB" OR UCASE$(a$) = "ASM_FUNCTION" THEN
        cursub = cursub + 1
        asmsub = false
        GOTO label12
    END IF
    END IF
    PRINT #2, fullcodetext$
    GOTO label12
  END IF

  SELECT CASE UCASE$(word$)
    CASE "%%ENDCOMP"
      a$ = getword$(wordtype)
      IF NOT a$ = "" THEN
        PRINT "ENDCOMP processed: "
        PRINT a$
      END IF
      GOTO endcomp
    CASE "%%ERRORENDCOMP": a$ = getword$(wordtype): fullcodetext$ = "": show.error 46, a$
    CASE "%%NOZEROVARS": nclearstackpc = true

    CASE "SEEK": kw.seek
    CASE "POKES":  kw.pokes
    CASE "OUT": kw.out tbyte
    CASE "OUTW": kw.out tinteger
    CASE "OUTD": kw.out tlong
    CASE "SETNEWOFFSET": kw.setnewoffset
    CASE "CONST": kw.const
    CASE "INT": kw.int 0
    CASE "INT16": kw.int16
    CASE "SETVECT": kw.setvect
    CASE "PUSH"
      t$ = MID$(codetext$, getcharpos, LEN(codetext$) - (getcharpos - 1))
      Math.parser t$, intgr, 0
      PRINT #2, "PUSH EAX"
    CASE "MEMFILLB", "MEMFILL": kw.memcopy tbyte, 2
    CASE "MEMFILLW": kw.memcopy tinteger, 2
    CASE "MEMFILLD": kw.memcopy tlong, 2

    CASE "MEMCOPYB", "MEMCOPY": kw.memcopy tbyte, 1
    CASE "MEMCOPYW": kw.memcopy tinteger, 1
    CASE "MEMCOPYD": kw.memcopy tlong, 1

    CASE "POKE", "POKEB": kw.poke tbyte
    CASE "POKEW": kw.poke tinteger
    CASE "POKED": kw.poke tlong
    CASE "_ASM"
      printc "; User ASM Routine"
      DO WHILE NOT endloop5 = true
       readline 1, codetext$
       fullcodetext$ = codetext$
       getcharpos = 0
       word$ = UCASE$(getword$(wordtype))
       IF word$ = "_END" AND UCASE$(getword$(wordtype)) = "ASM" THEN EXIT DO
       PRINT #2, codetext$
      LOOP
    CASE "SUB": IF cursub = 0 THEN Jmpendprog
                add.sub ubsub, 0
    CASE "ASM_SUB": IF cursub = 0 THEN Jmpendprog
        add.sub ubsub, asmmode
        asmsub = true
    CASE "ASM_FUNCTION": IF cursub = 0 THEN Jmpendprog
        add.sub ubfunction, asmmode
        asmsub = true
    CASE "FUNCTION":
      IF cursub = 0 THEN Jmpendprog
      add.sub ubfunction, 0
    CASE "DECLARE": kw.declare
    CASE "OPEN": kw.open
    CASE "CLOSE": kw.close
    CASE "GET": kw.filegetput fget
    CASE "PUT": kw.filegetput fput

    CASE "PRINT": kw.print
    CASE "COLOR": kw.color
    CASE "LOCATE": kw.locate
    CASE "CLS": PRINT #2, "CALL CLS"

    CASE "INC": kw.incdec add
    CASE "DEC": kw.incdec dec
    
    CASE "GOTO": kw.goto
    CASE "GOSUB": kw.gosub
    CASE "RET", "RETURN": PRINT #2, "RET"
    
    CASE "DO": kw.do
    CASE "LOOP": kw.loop

    CASE "IF": kw.if
    CASE "ELSEIF": kw.elseif
    CASE "ELSE": kw.else
    CASE "SELECT": kw.select
    CASE "CASE": kw.case

    CASE "FOR": kw.for
    CASE "NEXT": kw.next
    CASE "EXIT": kw.exit

    CASE "TYPE": Gettypestructure
    CASE "DIM": mem.DIM: arrayatfixedoffset = false
    CASE "REDIM": mem.REDIM: arrayatfixedoffset = false
    CASE "_SETSTRINGSIZE":
      n$ = getword$(wordtype)
      IF NOT wordtype = intgr THEN show.error 17, ""
      stringsize = VAL(n$)
    CASE "DEFINT": mem.DEF tinteger
    CASE "DEFLNG": mem.DEF tlong
    CASE "DEFSNG": mem.DEF tsingle
    CASE "DEFDBL": mem.DEF tdouble
    CASE "DEFEXT": mem.DEF textended
    CASE "DEFSTR": mem.DEF tstring
    CASE "DEFBYT": mem.DEF tbyte

    ' ------- Para prueba de Ultrabasic --------- "
'    CASE "TESTPARSER": printc "Testing Parser: " + par$: Math.parser par$, intgr, 0
'    CASE "TESTFPARSER": printc "Testing FMATH Parser: " + par$: Fmath.Parser par$, false, 0
'    CASE "TESTSUB": insidesub = true: printc "Now inside sub"
'    CASE "TESTSTRINGPARSER": printc "Testing STRIGN parser: " + par$: string.parser par$
'    CASE "TEST": PRINT #2, "CALL Testmsg"

    ' --------------------------------------------
    CASE "END":
      a$ = getword$(wordtype)
      IF UCASE$(a$) = "IF" THEN
        kw.endif
      ELSEIF UCASE$(a$) = "SELECT" THEN
        IF NOT workif = savedif THEN show.error 30, ""
        PRINT #5, "; SELECT CASE END"
        PRINT #2, ";----- SELECT CASE END -----"
        PRINT #2, "select" + STR2$(workselect) + "end:"
        POP workselect
        POP savedif
        POP curcase
      ELSEIF UCASE$(a$) = "SUB" OR UCASE$(a$) = "FUNCTION" THEN
        kw.endsub
      ELSE ' ----------------------------------------------------
      IF insidesub = true THEN
        PRINT #2, "CALL endsub" + STR2$(cursub)
        Jmpendprog
      ELSE
        Jmpendprog
      END IF
      END IF

    ' ------- Para agregar variables o llamar SUBS
    CASE ELSE:
    IF MID$(word$, LEN(word$), 1) = ":" THEN
      PRINT #2, "ubprog_" + LCASE$(word$)
    ELSE
      Checkothers word$
    END IF
  END SELECT
label12:
LOOP

endcomp:
Jmpendprog

CLOSE

BuildFiles
SecondPass

' SLEEP
IF NOT compilermode = distribute THEN
  Quickshow
ELSE
  PRINT "File created !"
END IF

IF NOT completedfile$ = "" THEN
  OPEN completedfile$ FOR OUTPUT AS #1
    PRINT #1, "COMPILED"
  CLOSE #1
END IF

END SUB

SUB Math.parser (text$, endtype, dontconvert)
Pushtext ""

DIM sarg$(30)
FOR i = 0 TO 30
  sarg$(i) = Arg$(i)
NEXT i

label48:
nt$ = text$
st$ = text$
Pushtext text$
  Precedence
  a$ = getword$(wordtype)
  IF wordtype = withpar AND a$ = "" THEN
    nt$ = par$ + " : " + MID$(codetext$, getcharpos + 1, LEN(codetext$) - getcharpos)
    Poptext
    text$ = nt$
    GOTO label48
  END IF
text$ = codetext$
Poptext
'text$ = st$
stext$ = text$
tmp = Scanline(text$, changepos)
text$ = stext$

IF tmp = intgr THEN
  IMath.Parser text$
  IF endtype = float THEN GOTO intgrleavefloat
  IF endtype = intgr THEN Poptext: GOSUB restargs: EXIT SUB
  IF endtype = skip THEN
    PRINT #2, "MOV [tmpvar], EAX"
    PRINT #2, "FILD DWORD [tmpvar]"
    EXIT SUB
  END IF
  GOTO leaveexact
ELSE
  IF changepos = 0 THEN
    Fmath.Parser text$, false, currentx
    IF endtype = intgr THEN GOTO floatleaveintgr
    IF endtype = float THEN GOTO floatleavefloat
    IF endtype = skip THEN Poptext: GOSUB restargs: EXIT SUB   'IF currentx >= 1 THEN PRINT #2, "FXCH": EXIT SUB
    GOTO leaveexact
  ELSE
    a1$ = MID$(text$, 1, changepos)
    a2$ = MID$(text$, changepos + 1, LEN(text$) - changepos)
    IMath.Parser a1$
    Fmath.Parser a2$, true, currentx
    IF endtype = intgr THEN GOTO floatleaveintgr
    IF endtype = float THEN GOTO floatleavefloat
    IF endtype = skip THEN Poptext: GOSUB restargs: EXIT SUB    ' IF currentx >= 1 THEN PRINT #2, "FXCH": EXIT SUB
    GOTO leaveexact
  END IF
END IF

intgrleavefloat:
  PRINT #2, "MOV [tmpvar], EAX"
  PRINT #2, "FILD DWORD [tmpvar]"
  IF dontconvert = false THEN PRINT #2, "FSTP TWORD [tmpfpuvar3]"
  Poptext
  GOSUB restargs
  EXIT SUB
floatleaveintgr:
  'IF currentx > 1 THEN PRINT #2, "FXCH"
  PRINT #2, "FISTP DWORD [tmpvar]"
  PRINT #2, "MOV EAX, [tmpvar]"
  Poptext
  GOSUB restargs
  EXIT SUB
floatleavefloat:
  'IF currentx > 1 THEN PRINT #2, "FXCH"
  IF dontconvert = false THEN PRINT #2, "FSTP TWORD [tmpfpuvar3]"
  Poptext
  GOSUB restargs
  EXIT SUB
' //----------------------------------
leaveexact:
  IF tmp = intgr THEN
    PRINT #2, "MOV [tmpvar], EAX"
    PRINT #2, "FILD DWORD [tmpvar]"
  'ELSE
    'IF currentx > 1 THEN PRINT #2, "FXCH"
  END IF

  SELECT CASE endtype
    CASE tsingle: PRINT #2, "FSTP DWORD [tmpvar]"
    CASE tdouble: PRINT #2, "FSTP QWORD [tmpfpuvar2]"
    CASE textended: PRINT #2, "FSTP TWORD [tmpfpuvar3]"
  END SELECT
Poptext
GOSUB restargs
EXIT SUB

restargs:
FOR i = 0 TO 30
  Arg$(i) = sarg$(i)
NEXT i
RETURN

END SUB

SUB mem.DEF (vartype)

a$ = getnword$
b$ = getnword$
C$ = getnword$

IF LEN(a$) = 3 THEN
  l1$ = MID$(a$, 1, 1)
  l2$ = MID$(a$, 3, 1)
ELSEIF LEN(a$) = 2 THEN
  l1$ = MID$(a$, 1, 1)
  l2$ = b$
ELSE
  l1$ = a$
  l2$ = C$
END IF

l1 = ASC(UCASE$(l1$))
l2 = ASC(UCASE$(l2$))

IF NOT l1 >= 65 AND NOT l1 <= 90 THEN show.error 11, ""
IF NOT l2 >= 65 AND NOT l2 <= 90 THEN show.error 11, ""

IF l1 > l2 THEN SWAP l1$, l2$
l1 = l1 - 65
l2 = l2 - 65

FOR i = l1 TO l2
  defletters(i) = vartype
NEXT i
END SUB

SUB mem.DIM

' *--- Primero controlamos si es SHARED
t = getcharpos
a$ = getword$(wordtype)

IF UCASE$(a$) = "SHARED" THEN
  varshared = true
  IF insidesub = true THEN show.error 9, ""
ELSE : getcharpos = t
END IF

' *--- Para mas de una declaracion
startdim:
arrayatfixedoffset = false
continue = false
dtypename$ = ""            ' Al comienzo

name$ = getword$(wordtype)
IF insidesub = true THEN
  IF NOT subexist(name$, i, varshared2, typeblock$, mempos&) = -1 THEN show.error 12, name$
ELSE
  IF NOT exist(name$, i, typeblock$, mempos&) = -1 THEN show.error 12, name$
END IF
printc codetext$
size$ = ""
IF wordtype = withpar THEN size$ = par$

t = getcharpos
as$ = getnword$
'*-----------------_________
'*       SI USA AS
'*-----------------_________
IF UCASE$(as$) = "AS" THEN
  type$ = getnword$: t = getcharpos: a$ = getnword$
  IF a$ = "," THEN
    continue = true
  ELSE
    IF UCASE$(a$) = "ATOFFSET" THEN
    arrayatfixedoffset = true: forfixedvarsize$ = par$
    a$ = getnword$
    IF a$ = "," THEN
      continue = true
    ELSE
      getcharpos = t
    END IF
    ELSE
    getcharpos = t
    END IF
  END IF

label04:
  SELECT CASE UCASE$(type$)
    CASE "INTEGER": Addvar name$, tinteger, varshared, size$
    CASE "LONG": Addvar name$, tlong, varshared, size$
    CASE "DOUBLE": Addvar name$, tdouble, varshared, size$
    CASE "SINGLE":  Addvar name$, tsingle, varshared, size$
    CASE "BYTE": Addvar name$, tbyte, varshared, size$
    CASE "STRING", "VLSTRING"
       n$ = getword$(wordtype)
       IF NOT n$ = "*" THEN show.error 5, ""
       n$ = getword$(wordtype)
       IF NOT wordtype = intgr THEN show.error 5, n$
       IF size$ = "" THEN
         IF UCASE$(type$) = "STRING" THEN Addstring name$, varshared, fixedlenght, n$
         IF UCASE$(type$) = "VLSTRING" THEN Addstring name$, varshared, varlenght, n$
       ELSE
         IF UCASE$(type$) = "STRING" THEN Addstringarray name$, size$, fixedlenght, varshared, n$
         IF UCASE$(type$) = "VLSTRING" THEN Addstringarray name$, size$, varlenght, varshared, n$
       END IF

       t = getcharpos: a$ = getnword$
       IF a$ = "," THEN
         continue = true
       ELSE : getcharpos = t
       END IF
    CASE "EXTENDED": Addvar name$, textended, varshared, size$
    CASE ELSE: dtypename$ = type$: Addvar name$, defined, varshared, size$
  END SELECT
ELSE
'*-----------------_________
'*       SI NO USA AS
'*-----------------_________

  IF as$ = "," THEN continue = true: GOTO label03
  getcharpos = t

  t = getcharpos
  a$ = getnword$

  IF a$ = "," THEN
    continue = true
  ELSE
    IF UCASE$(a$) = "ATOFFSET" THEN
    arrayatfixedoffset = true: forfixedvarsize$ = par$
    a$ = getnword$
    IF a$ = "," THEN
      continue = true
    ELSE
      getcharpos = t
    END IF
    ELSE
      getcharpos = t
    END IF
  END IF

label03:
  t$ = MID$(name$, LEN(name$), 1)

  SELECT CASE t$
    CASE "%": Addvar name$, tinteger, varshared, size$
    CASE "&": Addvar name$, tlong, varshared, size$
    CASE "#": Addvar name$, tdouble, varshared, size$
    CASE "!": Addvar name$, tsingle, varshared, size$
    CASE "$"
    IF size$ = "" THEN
      IF stringformat = varlenght THEN
        Addstring name$, varshared, varlenght, ""
      ELSE : Addvlenstring name$, varshared, vartype, ""
      END IF
    ELSE
      IF stringformat = rvarlenght AND vlenarraysav = false THEN show.error 25, name$
      IF stringformat = varlenght THEN
        ss = stringsize
        stringsize = 132
        Addstringarray name$, size$, varlenght, varshared, STR$(stringsize)
        stringsize = ss
      ELSE : Addvlenstring name$, varshared, arraytype, size$
      END IF
    END IF
    CASE "@": Addvar name$, textended, varshared, size$
    CASE ELSE: Addvar name$, extracttype(name$), varshared, size$
  END SELECT
END IF

IF continue = true THEN GOTO startdim

END SUB

SUB mem.REDIM

t = getcharpos
a$ = getword$(wordtype)

IF UCASE$(a$) = "SHARED" THEN
  varshared = true
  IF insidesub = true THEN show.error 9, ""
ELSE : getcharpos = t
END IF

IF UCASE$(a$) = "PRESERVE" THEN
  varpreserve = true
  IF insidesub = true THEN show.error 9, ""
ELSE : getcharpos = t
END IF

' *--- Para mas de una declaracion
'startdim:
'arrayatfixedoffset = false
'continue = false
dtypename$ = ""            ' Al comienzo

name$ = getword$(wordtype)
size$ = par$
IF insidesub = 0 THEN
  vartype = exist(a$, i, typeblock$, mempos&)
  IF vartype <> -1 THEN
    IF NOT lastfound = arraytype THEN show.error 18, name$

    GetDimensions size$, i

    PRINT #2, "mov si, [ArrayHandle" + LTRIM$(STR$(i)) + "]"
    PRINT #2, "mov di, [ArrayHandle" + LTRIM$(STR$(i)) + "+2]"
    PRINT #2, "Call NEAR ChangeBlockSize"
    PRINT #2, "MOV [Array" + LTRIM$(STR$(tmp)) + "], EAX"
    PRINT #2, "MOV [ArrayHandle" + LTRIM$(STR$(i)) + "], SI"
    PRINT #2, "MOV [ArrayHandle" + LTRIM$(STR$(i)) + "+2], DI"
  ELSE
    FOR i = 0 TO curstringarray - 1
      a$ = UCASE$(stringarray$(i))
      IF MID$(a$, 2, LEN(a$) - 1) = name$ THEN
        GetDimensionsString size$, i
        PRINT #2, "mov si, [StringHandle" + LTRIM$(STR$(i)) + "]"
        PRINT #2, "mov di, [StringHandle" + LTRIM$(STR$(i)) + "+2]"
        PRINT #2, "Call NEAR ChangeBlockSize"

        PRINT #2, "MOV [StringOffset" + LTRIM$(STR$(tmp)) + "], EAX"
        PRINT #2, "MOV [StringHandle" + LTRIM$(STR$(i)) + "], SI"
        PRINT #2, "MOV [StringHandle" + LTRIM$(STR$(i)) + "+2], DI"

      END IF
    NEXT

  END IF
ELSE
  vartype = subexist(a$, i, 0, typeblock$, mempos&)
  IF vartype <> -1 THEN
    IF NOT lastfound = arraytype THEN show.error 18, name$

    GetDimensions size$, i

    PRINT #2, "mov si, [ESI+" + LTRIM$(STR$(ABS(subextraarraydata(i) + 4))) + "]"
    PRINT #2, "mov di, [ESI+" + LTRIM$(STR$(ABS(subextraarraydata(i) + 6))) + "]"
    PRINT #2, "Call NEAR ChangeBlockSize"
    PRINT #2, "MOV [ESI+" + LTRIM$(STR$(ABS(subextraarraydata(i)))) + "], EAX"
    PRINT #2, "MOV [ESI+" + LTRIM$(STR$(ABS(subextraarraydata(i) + 4))) + "], SI"
    PRINT #2, "MOV [ESI+" + LTRIM$(STR$(ABS(subextraarraydata(i) + 6))) + "], DI"
  ELSE
    FOR i = 0 TO cursubstringarray - 1
      a$ = UCASE$(substringarray$(i))
      IF MID$(a$, 2, LEN(a$) - 1) = name$ THEN
        GetDimensionsString size$, i
        PRINT #2, "mov si, [ESI+" + LTRIM$(STR$(substringarraysextra(i) + 4)) + "]"
        PRINT #2, "mov di, [ESI+" + LTRIM$(STR$(substringarraysextra(i) + 6)) + "]"
        PRINT #2, "Call NEAR ChangeBlockSize"

        PRINT #2, "MOV [ESI+" + LTRIM$(STR$(substringarraysextra(i))) + "], EAX"
        PRINT #2, "MOV [ESI+" + LTRIM$(STR$(substringarraysextra(i) + 4)) + "], SI"
        PRINT #2, "MOV [ESI+" + LTRIM$(STR$(substringarraysextra(i) + 6)) + "], DI"

      END IF
    NEXT

  END IF
END IF
END SUB

FUNCTION memused (vartype)

SELECT CASE vartype
  CASE tbyte: memused = 1
  CASE tinteger: memused = 2
  CASE tlong, tsingle: memused = 4
  CASE tdouble: memused = 8
  CASE textended: memused = 10
END SELECT

END FUNCTION

SUB ontextwin
IF platform = win32 AND NOT maketextwindow = true THEN show.error 36, ""
END SUB

SUB POP (value)
sp = sp - 1
value = vstack(sp)
END SUB

SUB Popt (text$)

tsp = tsp - 1
text$ = tstack$(tsp)

END SUB

SUB printclr (text$)

getpos = 0
DO WHILE NOT endloop = true
  getpos = getpos + 1
  IF getpos > LEN(text$) THEN PRINT : EXIT SUB
  a$ = MID$(text$, getpos, 1)

  IF a$ = "&" THEN
    b$ = MID$(text$, getpos + 1, 2)
    COLOR VAL(b$)
    getpos = getpos + 2
  ELSE
    PRINT a$;
  END IF
LOOP

END SUB

SUB PUSH (value)
vstack(sp) = value
sp = sp + 1
END SUB

SUB Pusht (text$)
tstack$(tsp) = text$
tsp = tsp + 1
END SUB

SUB readline (number, t$)
LINE INPUT #number, t$
incfilen(filecounter) = incfilen(filecounter) + 1
END SUB

FUNCTION returntypesize& (name$, typenum)

FOR i = 0 TO curtype
  IF UCASE$(name$) = UCASE$(typename$(i)) THEN
    tfile$ = tmpdir$ + "\tf" + LTRIM$(STR$(i)) + ".typ"
    OPEN tfile$ FOR INPUT AS #100
    DO WHILE NOT EOF(100)
      INPUT #100, a$
    LOOP
    CLOSE #100
    returntypesize& = VAL(a$)
    typenum = i
    EXIT FUNCTION
  END IF
NEXT i

show.error 22, name$
END FUNCTION

FUNCTION Scanline (text$, changepos)

Scanline = intgr
Pushtext text$

DO WHILE NOT endloop = true
  lastpos = curpos
  curpos = getcharpos
  a$ = getword$(wordtype)
  IF a$ = lineeof THEN Poptext: EXIT FUNCTION
  
  SELECT CASE UCASE$(a$)
    CASE "/", "*", "-", "+": GOTO label19
    CASE "TIMER": GOTO floatend
  END SELECT

  IF NOT par$ = "" THEN
    IF a$ = "" THEN GOTO label40
    SELECT CASE UCASE$(a$)
      CASE "SIN", "COS", "TAN", "SQRT": GOTO floatend
    END SELECT

    IF NOT sexist(a$, i, typeblock$, mempos&, varshared) = -1 THEN
      'GOTO label19
      GOTO label18
    ELSE
      tmp = INSTR(a$, ".")
      IF tmp > 0 THEN sa$ = MID$(a$, 1, tmp - 1)

      IF NOT sexist(sa$, i, typeblock$, mempos&, varshared) = -1 THEN GOTO label22

      SELECT CASE UCASE$(a$)
        CASE "ABS", "SGN", "VAL": a$ = ""
        CASE "SEEK", "INT", "VARPTR", "SADD", "EOF", "LOF", "LPTR", "CODEPTR", "PEEK", "LEN", "ASC": GOTO label19
        CASE "PEEKW", "PEEKB", "PEEKD", "CPUFLAGS", "INP", "INPW", "INPD", "INPB": GOTO label19

        CASE "+", "-", "*", "/", "<<", ">>", "AND", "NOT", "OR", "XOR": a$ = ""
        CASE "ROR", "ROL", "MOD", "%": a$ = ""

        CASE ELSE
        SELECT CASE existFUNCTION(a$, i)
         CASE 0: show.error 18, a$
         CASE tlongsingle, tsingle, tdouble, textended: GOTO floatend
         CASE tlong, tinteger, tbyte:  GOTO label19
        END SELECT
      END SELECT
    END IF

label40:
    IF Scanline(par$, changepos) = float THEN GOTO floatend
    IF a$ = "" THEN GOTO label19
  END IF

  IF wordtype = float THEN GOTO floatend

label18:
  SELECT CASE sexist(a$, i, typeblock$, mempos&, varshared)
    CASE tsingle, tdouble, textended: GOTO floatend
    CASE tlong, tbyte, tinteger: GOTO label19
  END SELECT
label22:
  a = Getconsttype(a$, value&, stringvalue$, floatvalue#)
  IF a = intgr THEN GOTO label19
  IF a = float THEN GOTO floatend
  
  tmp = INSTR(a$, ".")
  
  sa$ = UCASE$(a$)

  a = -1
  IF tmp > 0 THEN
    typeobj$ = MID$(a$, tmp + 1, LEN(a$) - (tmp))
    a$ = MID$(a$, 1, tmp - 1)
    a = sexist(a$, i, typeblock$, mempos&, varshared)
  END IF

  IF NOT a = -1 THEN
    tmp2 = gettypemempos&(typeblock$, typeobj$, objtype)
    SELECT CASE objtype
      CASE tsingle, tdouble, textended: GOTO floatend
    END SELECT
  ELSE
    SELECT CASE existFUNCTION(sa$, i)
      CASE 0: GOTO label42
      CASE tlongsingle, tsingle, tdouble, textended: GOTO floatend
    END SELECT
    GOTO label19
label42:
    IF Autoaddvars = true THEN
      IF NOT par$ = "" THEN show.error 18, a$
      IF ASC(MID$(sa$, 1, 1)) >= 65 AND ASC(MID$(sa$, 1, 1)) <= 90 THEN autoaddvariable sa$: GOTO label18
    END IF
  END IF
  
label19:
LOOP

floatend:       ' Cuando se detecta algo de coma flotante
  Scanline = float
  changepos = lastpos
  Poptext
  EXIT FUNCTION

END FUNCTION

SUB SecondPass

' En esta parte se lee el codigo generado y se intenta optimizarlo
asmscan = true
curfop = 0
Clearstack
Cleartstack
curcase = 0
curselect = 0
workselect = 0

ubsubcounter = 0
DIM ubsub(30)

DIM reg$(6)
reg$(0) = "EAX"
reg$(1) = "EBX"
reg$(2) = "ECX"
reg$(3) = "EDX"
reg$(4) = "EDI"
reg$(5) = "ESI"
reg$(6) = "ESP"

OPEN asmfile$ FOR INPUT AS #1
OPEN outfile$ FOR OUTPUT AS #2
OPEN datafile$ FOR OUTPUT AS #3
OPEN optimizepushpop$ FOR INPUT AS #4
OPEN submemalloc$ FOR INPUT AS #7

OPEN constdef$ FOR BINARY AS #8
OPEN constdat$ FOR BINARY AS #9

OPEN floatoptimize$ FOR BINARY AS #10

IF platform = win32 THEN
FOR i = 0 TO globalsub - 1
  OPEN tmpdir$ + "\subd." + STR2$(i) FOR INPUT AS #108
    INPUT #108, type$

    INPUT #108, b$
    INPUT #108, a$

    IF type$ = "__FUNCTION" THEN INPUT #108, a$

    IF a$ = "_dll" THEN
      INPUT #108, a$
      INPUT #108, b$
      PRINT #2, "EXTERN " + b$
      PRINT #2, "IMPORT " + b$ + " " + a$
    END IF

    IF a$ = "_export" THEN
      INPUT #108, a$
      PRINT #2, "GLOBAL " + b$
      PRINT #2, "EXPORT " + b$ + " " + a$
    END IF

  CLOSE #108
NEXT i
END IF

DO WHILE NOT EOF(1)
  LINE INPUT #1, a$
           
  codetext$ = a$
  getcharpos = 0

  IF a$ = "___Pointer ubsub" THEN
    INPUT #1, name$
    t = 0
    OPEN subfile$ FOR INPUT AS #6
    DO WHILE NOT EOF(6)
      LINE INPUT #6, a$
      IF a$ = "___SUB" THEN
        LINE INPUT #6, a$
        LINE INPUT #6, a$
        IF UCASE$(a$) = UCASE$(name$) THEN EXIT DO
        t = t + 1
      END IF
    LOOP
    CLOSE #6
    PRINT #2, "MOV EAX, ub_sub" + STR2$(t)
    GOTO label43
  END IF

  IF a$ = "___Call ubsub" THEN
    INPUT #1, name$
    t = 0
    OPEN subfile$ FOR INPUT AS #6
    DO WHILE NOT EOF(6)
      LINE INPUT #6, a$
      IF a$ = "___SUB" THEN
        LINE INPUT #6, a$
        LINE INPUT #6, a$
        IF UCASE$(a$) = UCASE$(name$) THEN GOTO label52
        t = t + 1
      END IF
    LOOP
label52:
    CLOSE #6
    ubsub(ubsubcounter) = t
    ubsubcounter = ubsubcounter + 1
    GOTO label43
  END IF

  b$ = UCASE$(getword$(wordtype))
  SELECT CASE b$
    CASE "JC", "JE", "JNE", "JL", "JNL", "JLE", "JNLE": addnear = true
    CASE "JG", "JNG", "JMP", "CALL", "JGE", "JNGE": addnear = true
    CASE "JP", "JZ", "JNP", "JNZ", "JA", "JNA", "JB", "JNB": addnear = true
    CASE "JAE", "JNAE", "JBE", "JNBE": addnear = true
  END SELECT

  IF addnear = true THEN
  addnear = false
  op = getcharpos
  C$ = getword$(wordtype)
  IF NOT UCASE$(C$) = "NEAR" AND NOT UCASE$(C$) = "FAR" AND NOT UCASE$(C$) = "DWORD" THEN

  IF C$ = "[<_calling_and_ubasic_sub>]" THEN
    PRINT #2, "CALL NEAR ub_sub" + STR2$(ubsub(ubsubcounter - 1))
    ubsubcounter = ubsubcounter - 1
    GOTO label43
  ELSE
    t$ = MID$(codetext$, op, LEN(codetext$) - op + 1)
    PRINT #2, b$ + " NEAR " + t$
  END IF
  ELSE
    PRINT #2, a$
  END IF
  GOTO label43
  END IF
  getcharpos = 0

  IF a$ = ";ubsp1; Float save optimize" THEN
    tmpfdat = 0
    workf = curfop
    SEEK #10, 1
    DO WHILE NOT EOF(10)
      GET #10, , tmpfdat
      IF tmpfdat = workf THEN
        GET #10, , tmpfdat
        IF NOT tmpfdat = workf THEN PRINT #2, "PUSH DWORD [floatsave]": PRINT #2, "PUSH DWORD [floatsave+4]"
        EXIT DO
      END IF
    LOOP
    curfop = curfop + 1
    GOTO label43
  ELSEIF a$ = ";ubsp2; Float save optimize" THEN
    SEEK #10, 1
    DO WHILE NOT EOF(10)
      GET #10, , tmpfdat
      IF tmpfdat = workf THEN
        GET #10, , tmpfdat
        IF NOT tmpfdat = workf THEN PRINT #2, "POP DWORD [floatsave+4]": PRINT #2, "POP DWORD [floatsave]"
        EXIT DO
      END IF
    LOOP
    workf = workf - 1
    GOTO label43
  END IF

  IF a$ = "___STACKEDIT1___" THEN
    gpos = 1
    LINE INPUT #1, a$
    codetext$ = a$
    getcharpos = 0
    nl$ = ""
    DO WHILE NOT endloop = true
      b$ = getchar$
      IF b$ = lineeof THEN EXIT DO

      IF b$ = "-" THEN
        n$ = ""
        DO WHILE NOT endloop2 = true
          b$ = getchar$
          IF b$ = lineeof THEN b$ = "": EXIT DO
          IF NOT ASC(b$) >= 48 OR NOT ASC(b$) <= 57 THEN EXIT DO
          n$ = n$ + b$
        LOOP
        b$ = STR$(VAL(n$) + reqsubvarmem&) + b$
      END IF
      nl$ = nl$ + b$
    LOOP
    PRINT #2, nl$
    GOTO label43
  END IF

  IF a$ = "_SUB START_" THEN
    LINE INPUT #1, a$
    INPUT #7, reqsubvarmem&
    INPUT #7, reqsubstringmem&
    INPUT #7, SubStringOffset
    IF NOT reqsubvarmem& = 0 THEN
      PRINT #2, "SUB ESP, " + STR$(reqsubvarmem&)
      IF a$ = "_CLEAR STACK_" THEN
      PRINT #2, "XOR EAX, EAX"
      PRINT #2, "MOV ECX, " + STR$(reqsubvarmem&)
      PRINT #2, "MOV EDI, ESP"
      PRINT #2, "REP STOSB"
      PRINT #2, "MOV EDI, [varedi]"
      END IF
    END IF

    IF NOT reqsubstringmem& = 0 THEN
     PRINT #2, "; Allocate sub fixed lenght string block"
     PRINT #2, "MOV EAX, " + STR$(reqsubstringmem&)
     PRINT #2, "Call NEAR AllocBlock"
     'PRINT #2, "MOV [subfixedstringblockoffset], EAX"
     'PRINT #2, "MOV [subfixedstringblockhandle], SI"
     'PRINT #2, "MOV [subfixedstringblockhandle+2], DI"
     PRINT #2, "MOV [ESP +" + STR2$(SubStringOffset) + "], EAX"
     PRINT #2, "MOV [ESP +" + STR2$(SubStringOffset) + "+4], SI"
     PRINT #2, "MOV [ESP +" + STR2$(SubStringOffset) + "+6], DI"
     dPRINT 2, "MOV EBX, " + STR$(reqsubstringmem&)
     dPRINT 2, "CALL Clearblock"
    END IF

    GOTO label43
  ELSEIF a$ = "_END SUB_" THEN
    IF NOT reqsubvarmem& = 0 THEN PRINT #2, "ADD ESP, " + STR$(reqsubvarmem&)
    GOTO label43
  END IF

  IF a$ = ";ubsp1; Float save optimize" THEN

  ELSEIF a$ = ";ubsp2; Float save optimize" THEN

  END IF

  IF a$ = ";----- SELECT CASE START -----" THEN
    workselect = curselect
    getselect = 0

    OPEN selectcasetmp$ FOR INPUT AS #5
    DO WHILE NOT EOF(5)
      LINE INPUT #5, a$
      IF a$ = "; SELECT CASE START" THEN
        IF getselect = curselect THEN GOTO label44
        getselect = getselect + 1
      END IF
    LOOP
    show.error 31, ""
label44:
    INPUT #5, worktype
    LINE INPUT #5, savereg$
    IF savereg$ = "; SAVE cmpreg" THEN savereg = true

    sr1$ = ""
    sr2$ = ""
    sr3$ = ""
    sr4$ = ""
    IF savereg = true THEN
      IF worktype = intgr THEN
        sr2$ = "PUSH [selectcmp]"
        sr4$ = "POP [selectcmp]"
      ELSEIF worktype = float THEN
        sr1$ = "PUSH [selectcmp]"
        sr2$ = "PUSH [selectcmp+4]"
        sr3$ = "POP [selectcmp]"
        sr4$ = "POP [selectcmp+4]"
      ELSE
        sr2$ = "PUSH [selectcmp]"
        sr4$ = "POP [selectcmp]"
      END IF
    END IF

    PRINT #2, sr1$
    PRINT #2, sr2$
      asmscan = 0
      CND.SelectProcess worktype
      asmscan = true
    PRINT #2, sr3$
    PRINT #2, sr4$
    curselect = curselect + 1
    CLOSE #5
    GOTO label43
  END IF

  a2$ = getword$(wordtype)
  b$ = getword$(wordtype)
  C$ = getword$(wordtype)
  d$ = getword$(wordtype)

  IF UCASE$(a2$) = "MOV" OR UCASE$(a2$) = "ADD" OR UCASE$(a2$) = "SUB" THEN
    b$ = UCASE$(b$)
    IF C$ = "," AND d$ = "0" THEN
    FOR i = 0 TO 6
      IF b$ = reg$(i) THEN
      SELECT CASE UCASE$(a2$)
        CASE "MOV": PRINT #2, "XOR " + b$ + ", " + b$
      END SELECT
        GOTO label43
      END IF
    NEXT i
  END IF
  END IF

  PRINT #2, a$
label43:
LOOP
CLOSE

OPEN asmfile$ FOR OUTPUT AS #1
  Copyfile outfile$
  Copyfile datafile$
  Copyfile "ainclude\bss.asm"
CLOSE

OPEN outfile$ FOR OUTPUT AS #1
  Copyfile asmfile$
CLOSE
END SUB

FUNCTION sexist (name$, i, typeblock$, mempos&, varshared)

IF insidesub = true THEN
  sexist = subexist(name$, i, varshared, typeblock$, mempos&)
ELSE : sexist = exist(name$, i, typeblock$, mempos&)
END IF

END FUNCTION

'
' Guarda una cadena
' EAX = El offset del tmp a guardar
'
SUB store.string (name$, size$)

printc "Store string: " + name$

name$ = UCASE$(name$)

' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
'                    Fixed and Fake var lenght strings
' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
IF NOT size$ = "" THEN GOTO label55
FOR i = 0 TO curstring - 1
  a$ = UCASE$(stringsn$(i))
  IF MID$(a$, 2, LEN(a$) - 1) = name$ THEN
    a = ASC(MID$(a$, 1, 1))
    IF a >= 128 THEN
      a = a - 128
    ELSE : IF insidesub = true THEN GOTO label35
    END IF
    IF a = fixedlenght THEN
      IF i = curstring - 1 THEN
        size = curstringmem - strings(i)
         offset = strings(i)
label34: PRINT #2, "MOV EBX," + STR$(size)
         PRINT #2, "MOV ECX," + STR$(offset)
         PRINT #2, "ADD ECX, [fixedstringblockoffset]"
         PRINT #2, "MOV [push1], ECX"
         PRINT #2, "CALL NEAR clearstring"
         PRINT #2, "MOV ECX, [push1]"
         PRINT #2, "MOV EBX, [EAX]"
         PRINT #2, "ADD EAX, 4"
         PRINT #2, "CALL NEAR copydata2"
         EXIT SUB
      ELSE
        size = strings(i + 1) - strings(i)
        offset = strings(i)
        GOTO label34
      END IF
    ELSE ' Varlenght
      offset = strings(i)
      PRINT #2, "MOV ECX," + STR$(offset)
      PRINT #2, "ADD ECX, [fixedstringblockoffset]"
      PRINT #2, "MOV EBX, [EAX]"
      PRINT #2, "MOV [ECX], EBX"
      PRINT #2, "ADD EAX, 4"
      PRINT #2, "ADD ECX, 4"
      PRINT #2, "CALL NEAR copydata2"
    
    EXIT SUB
    END IF
  END IF
label35:
NEXT i

' *-*-*-* Sub

FOR i = 0 TO cursubstring - 1
  a$ = UCASE$(substringsn$(i))
  IF MID$(a$, 2, LEN(a$) - 1) = name$ THEN
    a = ASC(MID$(a$, 1, 1))
    IF a = fixedlenght THEN
      IF i = cursubstring - 1 THEN
        size = cursubstringmem - substrings(i)
         offset = substrings(i)
label54: PRINT #2, "MOV EBX," + STR$(size)
         PRINT #2, "MOV ECX," + STR$(offset)
         'PRINT #2, "ADD ECX, [subfixedstringblockoffset]"
         PRINT #2, "ADD ECX, [ESI + "; STR$(SubStringOffset) + "]"
         PRINT #2, "MOV [push1], ECX"
         PRINT #2, "CALL NEAR clearstring"
         PRINT #2, "MOV ECX, [push1]"
         PRINT #2, "MOV EBX, [EAX]"
         PRINT #2, "ADD EAX, 4"
         PRINT #2, "CALL NEAR copydata2"
         EXIT SUB
      ELSE
        size = substrings(i + 1) - substrings(i)
        offset = substrings(i)
        GOTO label54
      END IF
    ELSE ' Varlenght
      offset = substrings(i)
      IF a > 64 THEN
        PRINT #2, "MOV ECX," + " [ESI + " + STR$(offset) + "]"
        PRINT #2, "MOV EBX, [EAX]"
        PRINT #2, "MOV [ECX - 4], EBX"
        PRINT #2, "ADD EAX, 4"
      ELSE
        PRINT #2, "MOV ECX," + STR$(offset)
        PRINT #2, "ADD ECX, [ESI +" + STR$(SubStringOffset) + "]"
        PRINT #2, "MOV EBX, [EAX]"
        PRINT #2, "MOV [ECX], EBX"
        PRINT #2, "ADD EAX, 4"
        PRINT #2, "ADD ECX, 4"
      END IF
      PRINT #2, "CALL NEAR copydata2"
    EXIT SUB
    END IF
  END IF
NEXT i

' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
'                     Real variable lenth strings
' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

FOR i = 0 TO curvlenstring - 1
  a$ = UCASE$(vlenstring$(i))
  IF MID$(a$, 2, LEN(a$) - 1) = name$ THEN
    t1$ = "vlenstringoffset"
    t2$ = "vlenstringsize"
    t5$ = "vlenstringwork"
    t3$ = "vlenarrayoffset"
    t4$ = "vlenarrayhandle"
    t6$ = "vlenarraysize"
    t7$ = "vlenarraydatastart"

    a = ASC(MID$(a$, 1, 1))
    IF a >= 128 THEN
      a = a - 128
    ELSE : IF insidesub = true THEN GOTO label28
    END IF

    IF a = arraytype THEN
      a$ = LTRIM$(STR$(curstore))

      PRINT #2, "PUSH EAX"
      'Math.parser size$, intgr, 0
      GetDimensionsString size$, i
      PRINT #2, "SHL EAX, 3"
      PRINT #2, "ADD EAX, [" + t3$ + LTRIM$(STR$(i)) + "]"

      PRINT #2, "MOV EBX, 0"

      PRINT #2, "MOV ECX, [EAX]"      ' El Offset
      PRINT #2, "MOV [push2], ECX"    ' El Offset
      PRINT #2, "MOV BX, [EAX+4]"     ' El tama¤o
      PRINT #2, "MOV [push1], EBX"    ' El tama¤o
      PRINT #2, "PUSH EBX"
      PRINT #2, "MOV EDX, [" + t7$ + LTRIM$(STR$(i)) + "]"
      PRINT #2, "MOV [push5], EDX"

      PRINT #2, "MOV EDX, [" + t6$ + LTRIM$(STR$(i)) + "]"
      PRINT #2, "MOV EAX, [" + t3$ + LTRIM$(STR$(i)) + "]"

      PRINT #2, "CALL Getmaxarrayoffset"
      PRINT #2, "POP EAX"
      PRINT #2, ""
      PRINT #2, "CMP EAX, [push1]"
      
      curstore = curstore + 1
      EXIT SUB
    ELSE           ' NO ARRAY TYPE
      a$ = LTRIM$(STR$(curstore))
      b$ = LTRIM$(STR$(i))
      PRINT #2, "PUSH EAX"
      PRINT #2, "MOV EDX, [EAX]"
      PRINT #2, "CALL NEAR vlenGetMaxOffset"

      PRINT #2, "CMP DWORD [" + t5$ + b$ + "], 0"
      PRINT #2, "JE findoffset" + a$

      PRINT #2, "MOV ECX, [" + t2$ + b$ + "]"
      PRINT #2, "CMP EDX, ECX"
      PRINT #2, "JG vlengreater" + a$
      PRINT #2, "JL vlenless" + a$
      PRINT #2, "JMP skipstore" + a$

      PRINT #2, "vlengreater" + a$ + ":"
      PRINT #2, "SUB EDX, ECX"
      PRINT #2, "MOV EAX, [" + t1$ + b$ + "]"
      PRINT #2, "ADD EAX, [" + t2$ + b$ + "]"
      PRINT #2, "ADD EBX, [" + t1$ + b$ + "]"
      PRINT #2, "CALL NEAR vlenupdateright"
      PRINT #2, "CALL NEAR Moveright"
      PRINT #2, "JMP skipstore" + a$

      PRINT #2, "vlenless" + a$ + ":"
      PRINT #2, "SUB ECX, EDX"
      PRINT #2, "MOV EAX, [" + t1$ + b$ + "]"
      PRINT #2, "ADD EAX, [" + t2$ + b$ + "]"
      PRINT #2, "ADD EBX, [" + t1$ + b$ + "]"
      PRINT #2, "CALL NEAR vlenupdateleft"
      PRINT #2, "CALL NEAR Moveleft"
      PRINT #2, "JMP skipstore" + a$

      PRINT #2, "findoffset" + a$ + ":"
      PRINT #2, "ADD [" + t1$ + b$ + "], EBX"
      PRINT #2, "MOV DWORD [" + t5$ + b$ + "], 1"
      
      PRINT #2, "skipstore" + a$ + ":"
      PRINT #2, "POP EAX"
      PRINT #2, "MOV ECX, [" + t1$ + b$ + "]"
      PRINT #2, "MOV EBX, [EAX]"
      PRINT #2, "MOV [" + t2$ + b$ + "], EBX"
      PRINT #2, "ADD EAX, 4"
      PRINT #2, "Call copydata2"
      curstore = curstore + 1
      EXIT SUB
    END IF
  END IF
label28:
NEXT i

' *-*-*-*-*-*-*-* SUB


' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
'                           Fixed variable arrays
' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
label55:
IF NOT size$ = "" THEN
FOR i = 0 TO curstringarray - 1
  a$ = UCASE$(stringarray$(i))
  IF MID$(a$, 2, LEN(a$) - 1) = name$ THEN
    a = ASC(MID$(a$, 1, 1))
    IF a >= 128 THEN
      a = a - 128
    ELSE : IF insidesub = true THEN GOTO label29
    END IF

    PRINT #2, "PUSH EAX"
    'Math.parser size$, intgr, 0
    GetDimensionsString size$, i
    PRINT #2, "MOV EBX, " + STR$(stringarrays(i))
    PRINT #2, "MUL EBX"
    PRINT #2, "ADD EAX, [StringOffset" + LTRIM$(STR$(i)) + "]"

    IF a = varlenght THEN
      PRINT #2, "MOV ECX, EAX"
      PRINT #2, "POP EAX"
      PRINT #2, "MOV EBX, [EAX]"
      PRINT #2, "MOV [ECX], EBX"
      PRINT #2, "ADD ECX, 4"
      PRINT #2, "ADD EAX, 4"
      PRINT #2, "CALL NEAR copydata2"
    ELSE
      PRINT #2, "MOV ECX, EAX"
      PRINT #2, "POP EAX"
      PRINT #2, "MOV EBX, " + STR$(stringarrays(i))
      PRINT #2, "ADD EAX, 4"
      PRINT #2, "CALL NEAR copydata2"
    END IF
    
    EXIT SUB
  END IF

label29:
NEXT i

IF insidesub = true THEN
FOR i = 0 TO cursubstringarray - 1
  a$ = UCASE$(substringarray$(i))
  IF MID$(a$, 2, LEN(a$) - 1) = name$ THEN
    a = ASC(MID$(a$, 1, 1))
    PRINT #2, "PUSH EAX"
    'Math.parser size$, intgr, 0
    GetDimensionsString size$, i
    PRINT #2, "MOV EBX, " + STR$(substringarrays(i))
    PRINT #2, "MUL EBX"
    PRINT #2, "ADD EAX, [ESI+" + LTRIM$(STR$(substringarraysextra(i))) + "]"

    IF a = varlenght THEN
      PRINT #2, "MOV ECX, EAX"
      PRINT #2, "POP EAX"
      PRINT #2, "MOV EBX, [EAX]"
      PRINT #2, "MOV [ECX], EBX"
      PRINT #2, "ADD ECX, 4"
      PRINT #2, "ADD EAX, 4"
      PRINT #2, "CALL NEAR copydata2"
    ELSE
      PRINT #2, "MOV ECX, EAX"
      PRINT #2, "POP EAX"
      PRINT #2, "MOV EBX, " + STR$(substringarrays(i))
      PRINT #2, "ADD EAX, 4"
      PRINT #2, "CALL NEAR copydata2"
    END IF

    EXIT SUB
  END IF
NEXT i
END IF
END IF

' *-*-*-*-*-*-*-* SUB


' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
'                      Strings on type structure
' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
tmp = INSTR(name$, ".")

IF tmp >= 1 THEN
  obj$ = MID$(name$, tmp + 1, LEN(name$) - tmp)
  name$ = MID$(name$, 1, tmp - 1)

FOR i = 0 TO curarray - 1
  a$ = UCASE$(array$(i))
  a = INSTR(a$, " ")
  arrayname$ = MID$(a$, 2, tmp - 1)
  typestruct$ = MID$(a$, tmp + 2, LEN(a$) - (tmp + 2))
  IF arrayname$ = name$ THEN
    a& = gettypemempos&(typestruct$, obj$, objtype)
    IF a& = -1 THEN show.error 22, typestruct$
    IF NOT objtype = tstring THEN show.error 23, obj$

    b& = returntypesize&(typestruct$, 0)

    IF size$ = "" THEN
      PRINT #2, "MOV ECX, [Array" + LTRIM$(STR$(i)) + "]"
      PRINT #2, "MOV EBX, " + STR$(nexttypepos - a&)
      PRINT #2, "ADD ECX, " + STR$(a&)
      PRINT #2, "MOV [push3], ECX"
      PRINT #2, "CALL NEAR clearstring"
      PRINT #2, "MOV ECX, [push3]"
      PRINT #2, "MOV EBX, [EAX]"
      PRINT #2, "ADD EAX, 4"
      PRINT #2, "CALL NEAR copydata2"
    ELSE
      PRINT #2, "PUSH EAX"
      'Math.parser size$, intgr, 0
      GetDimensions size$, i
      PRINT #2, "MOV EBX, " + STR$(b&)
      PRINT #2, "MUL EBX"
      PRINT #2, "MOV ECX, [Array" + LTRIM$(STR$(i)) + "]"
      PRINT #2, "ADD EAX, " + STR$(a&)
      PRINT #2, "MOV EBX, " + STR$(nexttypepos - a&)
      PRINT #2, "ADD ECX, EAX"
      PRINT #2, "POP EAX"
      PRINT #2, "ADD EAX, 4"
      PRINT #2, "CALL NEAR clearstring"
      PRINT #2, "CALL NEAR copydata2"
    END IF
    
    EXIT SUB
  END IF
NEXT i

' *-*-*-*-*-*-*-* SUB

FOR i = 0 TO cursubarray - 1
  a$ = UCASE$(subarray$(i))
  a = INSTR(a$, " ")
  arrayname$ = MID$(a$, 2, tmp - 1)
  typestruct$ = MID$(a$, tmp + 2, LEN(a$) - (tmp + 2))
  IF arrayname$ = name$ THEN
    a& = gettypemempos&(typestruct$, obj$, objtype)
    IF a& = -1 THEN show.error 22, typestruct$
    IF NOT objtype = tstring THEN show.error 23, obj$

    b& = returntypesize&(typestruct$, 0)

    IF size$ = "" THEN
      PRINT #2, "MOV EBX, [ESI+" + LTRIM$(STR$(ABS(subextraarraydata(i)))) + "]"
      PRINT #2, "MOV ECX, " + STR$(nexttypepos - a&)
      PRINT #2, "ADD EBX, " + STR$(a&)
      PRINT #2, "ADD EAX, 4"
      PRINT #2, "CALL NEAR clearstring"
      PRINT #2, "CALL NEAR copydata2"
    ELSE
      PRINT #2, "PUSH EAX"
      'Math.parser size$, intgr, 0
      GetDimensions size$, i
      PRINT #2, "MOV EBX, " + STR$(b&)
      PRINT #2, "MUL EBX"
      PRINT #2, "MOV EBX, [ESI+" + LTRIM$(STR$(ABS(subextraarraydata(i)))) + "]"
      PRINT #2, "ADD EAX, " + STR$(a&)
      PRINT #2, "MOV ECX, " + STR$(nexttypepos - a&)
      PRINT #2, "ADD EBX, EAX"
      PRINT #2, "POP EAX"
      PRINT #2, "ADD EAX, 4"
      PRINT #2, "CALL NEAR clearstring"
      PRINT #2, "CALL NEAR copydata2"
    END IF

    EXIT SUB
  END IF
NEXT i

END IF

END SUB

FUNCTION STR2$ (value)
STR2$ = LTRIM$(RTRIM$(STR$(value)))
END FUNCTION

'  PARSER DE STRINGS
'
'  El mayor logro de Ultrabasic
'
SUB string.parser (text$)
printc "String Parser: " + text$
Pushtext text$

PRINT #2, "INC DWORD [curtmpblock]"
PRINT #2, "MOV EAX, [curtmpblock]"
PRINT #2, "SHL EAX, " + STR$(tmpstringsize)
PRINT #2, "ADD EAX, [tmpblockoffset]"
PRINT #2, "MOV DWORD [EAX], 0"

currxent = 0
DO WHILE NOT endloop = true
  a$ = getword$(wordtype)
  
  IF a$ = lineeof THEN
    PRINT #2, "MOV EBX, [EAX]"
    PRINT #2, "MOV byte [EAX+EBX+4], 0"  ' Porque casi siempre se necesitan
    Poptext                              ' cadenas terminadas en null.
    EXIT SUB
  END IF

IF current = 0 OR current = 2 THEN
  IF wordtype = intgr OR wordtype = float THEN show.error 21, a$
  IF wordtype = stringtype THEN
    IF a$ = "" THEN GOTO label31'show.error 19, ""
    cleana$ = fixstring$(a$)
    PRINT #3, "Inmd" + LTRIM$(STR$(curinmd)) + " DB '" + cleana$ + "'"
    PRINT #2, "MOV ECX, Inmd" + LTRIM$(STR$(curinmd))
    PRINT #2, "MOV EBX, " + STR$(LEN(a$))
    PRINT #2, "CALL NEAR copytostring"
    curinmd = curinmd + 1
    current = 1
    GOTO label31
  END IF
  
  SELECT CASE UCASE$(a$)
    CASE "INKEY$": PRINT #2, "CALL INKEY$": GOTO label31
  END SELECT

  IF NOT UCASE$(avoidfunc$) = UCASE$(a$) THEN
  IF existFUNCTION(a$, i) = tstring THEN
    PRINT #2, "PUSH EAX"
    Pushtext par$
      call.sub a$, ubfunction
    Poptext
    PRINT #2, "MOV EBX, [EAX]"
    PRINT #2, "MOV ECX, EAX"
    PRINT #2, "ADD ECX, 4"
    PRINT #2, "POP EAX"
    PRINT #2, "CALL NEAR copytostring"
    dectmp
    current = 1
    GOTO label31
  END IF
  END IF

  IF NOT par$ = "" THEN
    b$ = par$
  SELECT CASE UCASE$(a$)
     CASE "UCASE$": kw.lucase par$, 1: jmp = true
     CASE "LCASE$": kw.lucase par$, 2: jmp = true
     CASE "STRING$": kw.string par$: jmp = true
     CASE "SPACE$": kw.string par$ + ", 32": jmp = true
     CASE "MID$": kw.mid: jmp = true
     CASE "LTRIM$": kw.trim 1: jmp = true
     CASE "RTRIM$": kw.trim 2: jmp = true
     CASE "CHR$"
       PRINT #2, "PUSH EAX"
       Math.parser par$, intgr, 0
       PRINT #2, "MOV ECX, EAX"
       PRINT #2, "POP EAX"
       PRINT #2, "INC DWORD [EAX]"
       PRINT #2, "MOV EBX, [EAX]"
       PRINT #2, "MOV byte [EAX+EBX+3], CL"
       jmp = true
     CASE "STR$"
     IF Scanline(b$, changepos) = float THEN
       PRINT #2, "PUSH EAX"
       Math.parser b$, tdouble, 0
       'PRINT #2, "PUSH EAX"
       PRINT #2, "MOV EBX, tmpfpuvar2"

       PRINT #2, "POP EAX"
       
       PRINT #2, "MOV EDX, EAX"
       PRINT #2, "ADD EDX, [EAX]"
       PRINT #2, "ADD EDX, 4"
       IF insidesub = true THEN PRINT #2, "PUSH ESI"
       PRINT #2, "PUSH EAX"
       PRINT #2, "CALL double_2_asc"
       PRINT #2, "MOV EBX, EAX"
       PRINT #2, "MOV EDI, [varedi]"
       PRINT #2, "POP EAX"
       IF insidesub = true THEN PRINT #2, "POP ESI"
       PRINT #2, "ADD [EAX], EBX"
     ELSE
       PRINT #2, "PUSH EAX"
       Math.parser b$, intgr, 0
       PRINT #2, "MOV EBX, EAX"
       PRINT #2, "POP EAX"
       PRINT #2, "PUSH EAX"
       PRINT #2, "CALL STR$"
       PRINT #2, "POP EAX"
     END IF
     jmp = true
  END SELECT
  IF jmp = true THEN current = 1: GOTO label31
  END IF

  IF Getconsttype(a$, value&, stringvalue$, floatvalue#) = stringtype THEN
    value = value&
    PRINT #2, "MOV ECX, Conststring" + STR2$(value)
    PRINT #2, "MOV EBX, " + STR$(LEN(stringvalue$))
    PRINT #2, "CALL NEAR copytostring"
    current = 1
    GOTO label31
  END IF

  IF NOT Stringexist(a$, leavemem, i, isarray, par$) = -1 THEN
    PRINT #2, "CALL NEAR copytostring"
  ELSE : show.error 15, a$
  END IF

  current = 1
  GOTO label31
ELSE
  IF NOT a$ = "+" THEN show.error 20, a$
  current = 2
END IF

label31:
LOOP

END SUB

FUNCTION Stringexist (name$, leave, i, isarray, size$)
' out:  EBX - Offset
'       ECX - Tama¤o

printc "String search and maybe leave in MEM: " + name$
Stringexist = -1
name$ = UCASE$(name$)

' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
'                    Fixed and Fake var lenght strings
' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
IF NOT size$ = "" THEN GOTO label56

FOR i = 0 TO curstring - 1
  a$ = UCASE$(stringsn$(i))
  IF MID$(a$, 2, LEN(a$) - 1) = name$ THEN
    a = ASC(MID$(a$, 1, 1))
    IF a >= 128 THEN
      a = a - 128
    ELSE : IF insidesub = true THEN GOTO label26
    END IF
    IF a = fixedlenght THEN
      IF i = curstring - 1 THEN
        size = curstringmem - strings(i)
         offset = strings(i)

label25: IF leave = leavemem THEN
          PRINT #2, "MOV EBX," + STR$(size)
          PRINT #2, "MOV ECX," + STR$(offset)
          PRINT #2, "ADD ECX, [fixedstringblockoffset]"
        END IF
        Stringexist = a
        EXIT FUNCTION
      ELSE
        size = strings(i + 1) - strings(i)
        offset = strings(i)
        GOTO label25
      END IF
    ELSE ' Varlenght
      offset = strings(i)
    IF leave = leavemem THEN
      PRINT #2, "MOV ECX," + STR$(offset)
      PRINT #2, "ADD ECX, [fixedstringblockoffset]"
      PRINT #2, "MOV EBX, [ECX]"
      PRINT #2, "ADD ECX, 4"
    END IF
      Stringexist = a
      EXIT FUNCTION
    END IF
  END IF
label26:
NEXT i

' *-*-*-* Sub

IF insidesub = true THEN
FOR i = 0 TO cursubstring - 1
  a$ = UCASE$(substringsn$(i))
  IF MID$(a$, 2, LEN(a$) - 1) = name$ THEN
    a = ASC(MID$(a$, 1, 1))
    IF a = fixedlenght THEN
      IF i = cursubstring - 1 THEN
        size = cursubstringmem - substrings(i)
         offset = substrings(i)

label53: IF leave = leavemem THEN
          PRINT #2, "MOV EBX," + STR$(size)
          PRINT #2, "MOV ECX," + STR$(offset)
          'PRINT #2, "ADD ECX, [subfixedstringblockoffset]"
          PRINT #2, "ADD ECX, [ESI +" + STR2$(SubStringOffset) + "]"
        END IF
        Stringexist = a
        EXIT FUNCTION
      ELSE
        size = substrings(i + 1) - substrings(i)
        offset = substrings(i)
        GOTO label53
      END IF
    ELSE ' Varlenght
      offset = substrings(i)
    IF leave = leavemem THEN
      IF a > 64 THEN
        PRINT #2, "MOV ECX," + "[ESI + " + STR$(offset) + "]"
        PRINT #2, "MOV EBX, [ECX - 4]"
      ELSE
        PRINT #2, "MOV ECX," + STR$(offset)
        'PRINT #2, "ADD ECX, [subfixedstringblockoffset]"
        PRINT #2, "ADD ECX, [ESI +" + STR2$(SubStringOffset) + "]"
        PRINT #2, "MOV EBX, [ECX]"
        PRINT #2, "ADD ECX, 4"
      END IF
      
    END IF
      Stringexist = a
      EXIT FUNCTION
    END IF
  END IF
NEXT i
END IF
' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
'                     Real variable lenth strings
' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

FOR i = 0 TO curvlenstring - 1
  a$ = UCASE$(vlenstring$(i))
  IF MID$(a$, 2, LEN(a$) - 1) = name$ THEN
    a$ = LTRIM$(STR$(i))
    t1$ = "vlenstringoffset"
    t2$ = "vlenstringsize"
    t3$ = "vlenarrayoffset"
    a = ASC(MID$(a$, 1, 1))
    IF a >= 128 THEN
      a = a - 128
    ELSE : IF insidesub = true THEN GOTO label37
    END IF
    
    IF a = arraytype THEN
    IF leave = leavemem THEN
      PRINT #2, "PUSH EAX"
      'Math.parser size$, intgr, 0
      GetDimensionsString size$, i
      PRINT #2, "SHL EAX, 3"
      PRINT #2, "ADD EAX, [" + t3$ + a$ + "]"
      PRINT #2, "MOV EBX, [EAX]"
      PRINT #2, "MOV ECX, 0"
      PRINT #2, "MOV CX, [EAX+4]"
      PRINT #2, "POP EAX"
    END IF
      Stringexist = a
      EXIT FUNCTION
    ELSE
    IF leave = leavemem THEN
      PRINT #2, "MOV EBX, [" + t2$ + a$ + "]"
      PRINT #2, "MOV ECX, [" + t1$ + a$ + "]"
    END IF
      Stringexist = a
      EXIT FUNCTION
    END IF
  END IF
label37:
NEXT i

' *-*-*-*-*-*-*-* SUB


' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
'                           Fixed variable arrays
' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
label56:

IF NOT size$ = "" THEN
FOR i = 0 TO curstringarray - 1
  a$ = UCASE$(stringarray$(i))
  IF MID$(a$, 2, LEN(a$) - 1) = name$ THEN
    a = ASC(MID$(a$, 1, 1))
    IF a >= 128 THEN
      a = a - 128
    ELSE : IF insidesub = true THEN GOTO label38
    END IF

  IF leave = leavemem THEN
    PRINT #2, "PUSH EAX"
    'Math.parser size$, intgr, 0
    GetDimensionsString size$, i
    PRINT #2, "MOV EBX, " + STR$(stringarrays(i))
    PRINT #2, "MUL EBX"
    PRINT #2, "ADD EAX, [StringOffset" + LTRIM$(STR$(i)) + "]"
  
    IF a = varlenght THEN
      PRINT #2, "MOV ECX, EAX"
      PRINT #2, "MOV EBX, [EAX]"
      PRINT #2, "ADD ECX, 4"
    ELSE
      PRINT #2, "MOV ECX, EAX"
      PRINT #2, "MOV EBX, " + STR$(stringarrays(i))
    END IF
  END IF

    PRINT #2, "POP EAX"

    Stringexist = a
    EXIT FUNCTION
  END IF

label38:
NEXT i

IF insidesub = true THEN
FOR i = 0 TO cursubstringarray - 1
  a$ = UCASE$(substringarray$(i))
  IF MID$(a$, 2, LEN(a$) - 1) = name$ THEN
    a = ASC(MID$(a$, 1, 1))

  IF leave = leavemem THEN
    PRINT #2, "PUSH EAX"
    'Math.parser size$, intgr, 0
    GetDimensionsString size$, i
    PRINT #2, "MOV EBX, " + STR$(substringarrays(i))
    PRINT #2, "MUL EBX"
    'PRINT #2, "ADD EAX, [SubStringOffset" + LTRIM$(STR$(i)) + "]"
    PRINT #2, "ADD EAX, [ESI+" + LTRIM$(STR$(substringarraysextra(i))) + "]"

    IF a = varlenght THEN
      PRINT #2, "MOV ECX, EAX"
      PRINT #2, "MOV EBX, [EAX]"
      PRINT #2, "ADD ECX, 4"
    ELSE
      PRINT #2, "MOV ECX, EAX"
      PRINT #2, "MOV EBX, " + STR$(substringarrays(i))
    END IF
  END IF

    PRINT #2, "POP EAX"

    Stringexist = a
    EXIT FUNCTION
  END IF

NEXT i
END IF
END IF

' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
'                      Strings on type structure
' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
tmp = INSTR(name$, ".")

IF tmp >= 1 THEN
  obj$ = MID$(name$, tmp + 1, LEN(name$) - tmp)
  name$ = MID$(name$, 1, tmp - 1)
  
FOR i = 0 TO curarray - 1
  a$ = UCASE$(array$(i))
  a = INSTR(a$, " ")
  arrayname$ = MID$(a$, 2, tmp - 1)
  typestruct$ = MID$(a$, tmp + 2, LEN(a$) - (tmp + 2))
  IF arrayname$ = name$ THEN
    a& = gettypemempos&(typestruct$, obj$, objtype)
    IF leave = leavemem THEN
      IF a& = -1 THEN show.error 22, typestruct$
      IF NOT objtype = tstring THEN show.error 23, obj$
    ELSE
      IF a& = -1 THEN Stringexist = -1: EXIT FUNCTION
      IF NOT objtype = tstring THEN Stringexist = -1: EXIT FUNCTION
    END IF

    b& = returntypesize&(typestruct$, 0)

    IF leave = leavemem THEN
      IF size$ = "" THEN
        PRINT #2, "MOV EBX, [Array" + LTRIM$(STR$(i)) + "]"
        PRINT #2, "MOV ECX, " + STR$(nexttypepos - a&)
        PRINT #2, "ADD EBX, " + STR$(a&)
        PRINT #2, "XCHG ECX, EBX"
      ELSE
        PRINT #2, "PUSH EAX"
        'Math.parser size$, intgr, 0
        GetDimensions size$, i
        PRINT #2, "MOV EBX, " + STR$(b&)
        PRINT #2, "MUL EBX"
        PRINT #2, "MOV EBX, [Array" + LTRIM$(STR$(i)) + "]"
        PRINT #2, "ADD EAX, " + STR$(a&)
        PRINT #2, "MOV ECX, " + STR$(nexttypepos - a&)
        PRINT #2, "ADD EBX, EAX"
        PRINT #2, "XCHG ECX, EBX"
        PRINT #2, "POP EAX"
      END IF
    END IF

    Stringexist = tstring
    EXIT FUNCTION
  END IF
NEXT i

'SUBS

FOR i = 0 TO cursubarray - 1
  a$ = UCASE$(subarray$(i))
  a = INSTR(a$, " ")
  arrayname$ = MID$(a$, 2, tmp - 1)
  typestruct$ = MID$(a$, tmp + 2, LEN(a$) - (tmp + 2))
  IF arrayname$ = name$ THEN
    a& = gettypemempos&(typestruct$, obj$, objtype)
    IF leave = leavemem THEN
      IF a& = -1 THEN show.error 22, typestruct$
      IF NOT objtype = tstring THEN show.error 23, obj$
    ELSE
      IF a& = -1 THEN Stringexist = -1: EXIT FUNCTION
      IF NOT objtype = tstring THEN Stringexist = -1: EXIT FUNCTION
    END IF

    b& = returntypesize&(typestruct$, 0)

    IF leave = leavemem THEN
      IF size$ = "" THEN
        PRINT #2, "MOV EBX, [ESI+" + LTRIM$(STR$(ABS(subextraarraydata(i)))) + "]"
        PRINT #2, "MOV ECX, " + STR$(nexttypepos - a&)
        PRINT #2, "ADD EBX, " + STR$(a&)
        PRINT #2, "XCHG ECX, EBX"
      ELSE
        PRINT #2, "PUSH EAX"
        'Math.parser size$, intgr, 0
        GetDimensions size$, i
        PRINT #2, "MOV EBX, " + STR$(b&)
        PRINT #2, "MUL EBX"
        PRINT #2, "MOV EBX, [ESI+" + LTRIM$(STR$(ABS(subextraarraydata(i)))) + "]"
        PRINT #2, "ADD EAX, " + STR$(a&)
        PRINT #2, "MOV ECX, " + STR$(nexttypepos - a&)
        PRINT #2, "ADD EBX, EAX"
        PRINT #2, "XCHG ECX, EBX"
        PRINT #2, "POP EAX"
      END IF
    END IF

    Stringexist = tstring
    EXIT FUNCTION
  END IF
NEXT i


END IF

END FUNCTION

FUNCTION subexist (name$, i, varshared, typeblock$, mempos&)
varshared = false
lastfound = 0
fixedvar = 0
IF curvar >= 1 THEN

FOR i = 0 TO curvar - 1
  IF UCASE$(MID$(variable$(i), 2, LEN(variable$(i)) - 1)) = UCASE$(name$) THEN
    tmp = ASC(MID$(variable$(i), 1, 1))
    IF tmp >= 128 THEN
      tmp = tmp - 128
      IF tmp > 64 THEN tmp = tmp - 64: fixedvar = true
      varshared = true
      mempos& = variables(i)
      subexist = tmp
      EXIT FUNCTION
    END IF
  END IF
NEXT i
END IF

IF curarray >= 1 THEN
FOR i = 0 TO curarray - 1
  typeblock$ = ""
  tmp = INSTR(array$(i), " ")
  IF NOT tmp = 0 THEN
    t$ = MID$(array$(i), 1, tmp - 1)
    typeblock$ = MID$(array$(i), tmp + 1, LEN(array$(i)) - (tmp + 1))
GOTO label13
  END IF

  t$ = array$(i)
label13:

  IF UCASE$(MID$(t$, 2, LEN(t$) - 1)) = UCASE$(name$) THEN
    tmp = ASC(MID$(t$, 1, 1))
    IF tmp >= 128 THEN
      tmp = tmp - 128
      varshared = true
      lastfound = arraytype
      subexist = tmp
      EXIT FUNCTION
    END IF
  END IF
NEXT i
END IF

' -----------------------------------
' -             SUB VARS            -
' -----------------------------------

IF cursubvar >= 1 THEN

FOR i = 0 TO cursubvar - 1
  IF UCASE$(MID$(subvariable$(i), 2, LEN(subvariable$(i)) - 1)) = UCASE$(name$) THEN
    tmp = ASC(MID$(subvariable$(i), 1, 1))
    IF tmp > 64 THEN tmp = tmp - 64: fixedvar = true
    mempos& = subvariables(i)
    subexist = tmp
    EXIT FUNCTION
  END IF
NEXT i
END IF

IF cursubarray >= 1 THEN
FOR i = 0 TO cursubarray - 1
  typeblock$ = ""
  tmp = INSTR(subarray$(i), " ")
  IF NOT tmp = 0 THEN
    t$ = MID$(subarray$(i), 1, tmp - 1)
    typeblock$ = MID$(subarray$(i), tmp + 1, LEN(subarray$(i)) - (tmp + 1))
GOTO label14
  END IF

  t$ = subarray$(i)
label14:

  IF UCASE$(MID$(t$, 2, LEN(t$) - 1)) = UCASE$(name$) THEN
    tmp = ASC(MID$(t$, 1, 1))
    lastfound = arraytype
    subexist = tmp
    EXIT FUNCTION
  END IF
NEXT i
END IF

subexist = -1

END FUNCTION

