DECLARE SUB GetDimensions (size$, a%)
DECLARE SUB CallObjects (Args%, type$, Object$)
DECLARE SUB GetObjects (Args%, type$)
DEFINT A-Z
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.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$)

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)

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

' ****---- 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

' ****---- Para DO/LOOP ----****
CONST stringop = 1, mathop = 2
CONST varlenght = 1, fixedlenght = 2, rvarlenght = 3
DIM SHARED curdo, workdo

REDIM SHARED typename$(1)
REDIM SHARED vlenstring$(1)
REDIM SHARED subvlenstring$(1)
REDIM SHARED sub$(1)
REDIM SHARED subvariable$(1)
REDIM SHARED subvariables(1) AS LONG

REDIM SHARED array$(1)
REDIM SHARED subarray$(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)

SUB add.sub (mode, asm)
subpars = 0
SubStringOffset = -1
printc codetext$
name$ = getword$(wordtype)
Object$ = ""

IF INSTR(name$, "::") THEN

  FOR i = 0 TO curtype
    IF UCASE$(LEFT$(name$ + " ", INSTR(name$, "::") - 1)) = UCASE$(typename$(i)) THEN

      Object$ = LEFT$(name$ + " ", INSTR(name$, "::") - 1)

      'name$ = RTRIM$(MID$(name$ + "  ", INSTR(name$, "::") + 2))
      EXIT FOR
    END IF
  NEXT
END IF

funcname$ = ""
functiontype = 0
PRINT #6, "___SUB"
PRINT #6, "__UB"
PRINT #6, name$
PRINT #6, cursub

IF par$ = "" AND NOT wordtype = withpar THEN a$ = getword$(wordtype)

Pushtext par$

PRINT #2, "ub_sub" + STR2$(cursub) + ":"

insidesub = true
cursubstringarray = 0: cursubstring = 0: cursubstringmem = 0: cursubvar = 0
cursubarray = 0: cursubvarmem = 0: cursubvlenstring = 0

IF asm = 0 THEN
IF mode = ubfunction THEN
  IF Object$ <> "" THEN
    funcname$ = Object$ + "<-" + MID$(name$, INSTR(name$, "::") + 2)
  ELSE
    funcname$ = name$
  END IF
  SELECT CASE extracttype(name$)
    'CASE tlong, tinteger, tsingle, tdouble, tbyte, textended: Addvariable name$, extracttype(name$), 0
    'CASE tstring: Addstring name$, false, varlenght, "": avoidfunc$ = name$
    CASE tlong, tinteger, tsingle, tdouble, tbyte, textended: Addvariable funcname$, extracttype(name$), 0
    CASE tstring: Addstring funcname$, false, varlenght, "": avoidfunc$ = name$
  END SELECT
  functiontype = extracttype(name$)
  'funcname$ = name$
END IF
END IF
Args = getarg(0, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)
Poptext
IF UCASE$(a$) = "EXPORT" THEN PRINT #2, name$ + ":"
a$ = getword$(wordtype)
IF UCASE$(a$) = "EXPORT" THEN PRINT #2, name$ + ":"


IF asm = 0 THEN
PRINT #2, "_SUB START_"
IF nclearstackpc = true THEN
  PRINT #2, "_DONT CLEAR STACK_"
  nclearstackpc = false
ELSE
  PRINT #2, "_CLEAR STACK_"
END IF
PRINT #2, "MOV ESI, ESP"
END IF

IF Object$ <> "" THEN
'  args = args + 1
'  arg$(args) = Object$
  GetObjects Args, Object$
  arg1$ = Arg$(1)
END IF

IF Args >= 1 AND NOT arg1$ = "" THEN
FOR i = 1 TO Args
name$ = clrspc$(Arg$(i))

IF UCASE$(LEFT$(name$, 6)) = "BYREF " THEN name$ = MID$(name$, 7): svar = 64 ELSE svar = 0
tmp = INSTR(name$, "(")
IF tmp <> 0 THEN    'Check if is an array
  IF MID$(name$, tmp + 1, 1) <> ")" THEN Dims = VAL(MID$(name$, tmp + 1)) ELSE Dims = 0

  name$ = LEFT$(name$, tmp - 1)
  svar = 75
END IF

IF NOT INSTR(UCASE$(name$), " AS ") = 0 THEN
  t$ = RTRIM$(LTRIM$(UCASE$(MID$(name$, INSTR(UCASE$(name$), " AS ") + 4))))
  name$ = LEFT$(name$, INSTR(UCASE$(name$), " AS ") - 1)
  SELECT CASE t$
    CASE "INTEGER": var = tinteger
    CASE "LONG": var = tlong
    CASE "DOUBLE": var = tdouble
    CASE "SINGLE":  var = tsingle
    CASE "BYTE":  var = tbyte
    CASE "STRING", "VLSTRING": var = tstring
    CASE "EXTENDED": var = textended
    CASE ELSE: var = 11: svar = 64
  END SELECT
ELSE
  t$ = MID$(name$, LEN(name$), 1)


  SELECT CASE t$
    CASE "%": var = tinteger
    CASE "&": var = tlong
    CASE "#": var = tdouble
    CASE "!": var = tsingle
    CASE "@": var = textended
    CASE "$": var = tstring: st = st + 1
    CASE "0":
    IF MID$(name$, LEN(name$) - 1, 1) = "$" THEN
      var = tnullstring
      st = st + 1
    ELSE : var = extracttype(name$)
    END IF
    CASE ELSE: var = extracttype(name$)
  END SELECT
END IF

var = var + svar
IF asm = 0 THEN
SELECT CASE var
  CASE tstring, tnullstring:
    IF stringformat = varlenght AND svar = 0 THEN
      'PRINT name$: SLEEP
      Addstring name$, false, varlenght, ""
      PRINT #2, "___STACKEDIT1___"
      PRINT #2, "MOV EAX, [ESI+" + STR$(-4 - subpars) + "]"
      store.string name$, ""
      subpars = subpars + 4
    END IF
  CASE tstring + 64, tnullstring + 64:
    subpars = subpars + 4
    Addstring name$, false, varlenght + 64, ""
      
    svar = 0
    
  CASE tsingle
    'PRINT #2, "MOV EDX, [ESI" + STR$(-4 - subpars) + "]"
    'PRINT #2, "MOV EAX, [EDX]"
    'PRINT #2, "MOV [ESI+" + STR$(cursubvarmem) + "], EAX"
    'Addvariable name$, tsingle, 0
    Addcustomvar name$, -4 - subpars, tsingle
    subpars = subpars + 4
  CASE tlong:
    Addcustomvar name$, -4 - subpars, tlong
    ' PRINT -4 - subpars
    subpars = subpars + 4
  CASE tinteger
    Addcustomvar name$, -4 - subpars, tinteger
    subpars = subpars + 2
  CASE tdouble
    'PRINT #2, "MOV EDX, [ESI" + STR$(-4 - subpars) + "]"
    'PRINT #2, "MOV EAX, [EDX]"
    'PRINT #2, "MOV EBX, [EDX+4]"
    'PRINT #2, "MOV [ESI+" + STR$(cursubvarmem) + "], EAX"
    'PRINT #2, "MOV [ESI+" + STR$(cursubvarmem) + "+4], EBX"
    'Addvariable name$, tdouble, 0
    Addcustomvar name$, -4 - subpars, tdouble
    subpars = subpars + 8
  CASE textended
    'PRINT #2, "MOV EDX, [ESI" + STR$(-4 - subpars) + "]"
    'PRINT #2, "MOV EAX, [EDX]"
    'PRINT #2, "MOV EBX, [EDX+4]"
    'PRINT #2, "MOV CX, [EDX+8]"
    'PRINT #2, "MOV [ESI+" + STR$(cursubvarmem) + "], EAX"
    'PRINT #2, "MOV [ESI+" + STR$(cursubvarmem) + "+4], EBX"
    'PRINT #2, "MOV [ESI+" + STR$(cursubvarmem) + "+8], CX"
    'Addvariable name$, textended, 0
    Addcustomvar name$, -4 - subpars, textended
    subpars = subpars + 10
  CASE textended + 64, tdouble + 64, tinteger + 64, tlong + 64, tsingle + 64
    Addcustomvar name$, -4 - subpars, var
    ' PRINT -4 - subpars
    subpars = subpars + 4
  CASE 75    ' User-defined TYPE
    subarray$(cursubarray) = CHR$(0) + name$ + " " + t$ + CHR$(0)
    subextraarraydata(cursubarray) = -cursubvarmem
    cursubarray = cursubarray + 1
    PRINT #2, "___STACKEDIT1___"
    'PRINT #2, "MOV EAX, [ESI+" + STR$(-4 - subpars) + "]"
    PRINT #2, "MOV EAX, [ESI+" + STR$(-4 - subpars) + "]"
    PRINT #2, "MOV [ESI+" + STR2$(-cursubvarmem); "], EAX"
    subpars = subpars + 4
    cursubvarmem = cursubvarmem + 4
  CASE textended + 75, tdouble + 75, tinteger + 75, tlong + 75, tsingle + 75 ' Non-String Arrays
    subarray$(cursubarray) = CHR$(var - 75) + name$
    subextraarraydata(cursubarray) = -cursubvarmem
    cursubarray = cursubarray + 1
    PRINT #2, "___STACKEDIT1___"
    'PRINT #2, "MOV EAX, [ESI+" + STR$(-4 - subpars) + "]"
    PRINT #2, "MOV EAX, [ESI+" + STR$(-4 - subpars) + "]"
    PRINT #2, "MOV [ESI+" + STR2$(-cursubvarmem); "], EAX"
    subpars = subpars + 4
    cursubvarmem = cursubvarmem + 4
  CASE tstring + 75, tnullstring + 75    ' String Arrays
    substringarray$(cursubstringarray) = CHR$(1) + name$
    substringarrays(cursubstringarray) = 136'stringsize
    substringarraysextra(cursubstringarray) = -cursubvarmem
    cursubstringarray = cursubstringarray + 1
    PRINT #2, "___STACKEDIT1___"
    PRINT #2, "MOV EAX, [ESI+" + STR$(-4 - subpars) + "]"
    PRINT #2, "SUB EAX, 4"
    PRINT #2, "MOV [ESI+" + STR2$(-cursubvarmem); "], EAX"
    subpars = subpars + 4
    cursubvarmem = cursubvarmem + 4

END SELECT

'IF svar THEN subvariable$(cursubvar - 1) = CHR$(var + 64) + MID$(subvariable$(cursubvar - 1), 2)
END IF

PRINT #6, "_Par"
PRINT #6, var
NEXT i
END IF

FOR i = st TO 1 STEP -1
  dectmp
NEXT i

END SUB

SUB addfile (a$)

IF UCASE$(a$) = "%%INCLUDE:" OR UCASE$(a$) = "%%INCLUDE" THEN
  file$ = getword$(wordtype)
  IF NOT wordtype = stringtype THEN show.error 23, file$
  IF DIR$(file$) = "" THEN show.error 45, file$
  filecounter = filecounter + 1
  OPEN file$ FOR INPUT AS #filecounter
    PRINT #2, "---- File add ----"
    PRINT #2, file$
    closefile = true
    DO WHILE NOT EOF(filecounter)
      LINE INPUT #filecounter, codetext$
      fullcodetext$ = codetext$
      st$ = codetext$
      getcharpos = 0
      a$ = getword$(wordtype)
      IF UCASE$(a$) = "SUB" OR UCASE$(a$) = "FUNCTION" THEN
        incfile$(globalbasinc) = st$
        incfilen(globalbasinc) = filecounter
        globalbasinc = globalbasinc + 1
        closefile = false
        EXIT DO
      END IF
      addfile a$

      PRINT #2, st$
    LOOP
  IF closefile THEN CLOSE #filecounter
  filecounter = filecounter - 1
  PRINT #2, "---- File end ----"
END IF

END SUB

SUB BuildFiles

OPEN asmfile$ FOR OUTPUT AS #1
IF curvarmem <= 20 THEN curvarmem = 200
Copyfile "ainclude\code"
  PRINT #1, "Jmp afterub"
  PRINT #1, "DB 'This program was made using Ultrabasic " + version$ + " by Gabriel Fernandez', 0"
  PRINT #1, "afterub:"
  IF platform = win32 THEN PRINT #1, "MOV EBX, textscreen": PRINT #1, "MOV [textscreenoffset], EBX"
  IF platform = win32 AND maketextwindow = true THEN PRINT #1, "CALL Createtextwindow"
' *----  Para crear el bloque de las variables ----*
  PRINT #1, "MOV EAX, " + STR$(curvarmem)
  PRINT #1, "Call NEAR AllocBlock"
  PRINT #1, "MOV [varedi], eax"
  PRINT #1, "MOV [varblockhandle], SI"
  PRINT #1, "MOV [varblockhandle+2], DI"

IF NOT curstringmem = 0 THEN
  PRINT #1, "; Allocate fixed lenght string block"
  PRINT #1, "MOV EAX, " + STR$(curstringmem)
  PRINT #1, "Call NEAR AllocBlock"
  PRINT #1, "MOV [fixedstringblockoffset], EAX"
  PRINT #1, "MOV [fixedstringblockhandle], SI"
  PRINT #1, "MOV [fixedstringblockhandle+2], DI"
  dPRINT 1, "MOV EBX, " + STR$(curstringmem)
  dPRINT 1, "CALL Clearblock"
END IF

' *----  Para crear el bloque de las cadenas ----*
  PRINT #1, "; Allocate string block(tmp)"

  PRINT #1, "MOV EAX, " + STR$(getshift&(tmpstringsize))
  PRINT #1, "SHL EAX, 3"
  PRINT #1, "Call NEAR AllocBlock"
  PRINT #1, "MOV [tmpblockoffset], EAX"
  PRINT #1, "MOV [tmpblockhandle], SI"
  PRINT #1, "MOV [tmpblockhandle+2], DI"

  PRINT #1, "; Allocate variable lenght string block"
  PRINT #1, "MOV EAX, " + STR$(stringblocksize)
  PRINT #1, "Call NEAR AllocBlock"
  PRINT #1, "MOV [stringblockoffset], EAX"
  PRINT #1, "MOV [stringblockhandle], SI"
  PRINT #1, "MOV [stringblockhandle+2], DI"

  t1$ = "vlenstringoffset"
  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
      PRINT #1, "MOV [" + t1$ + LTRIM$(STR$(i)) + "], EAX"
    END IF
  NEXT i

  dPRINT 1, "MOV EBX, " + STR$(stringblocksize)
  dPRINT 1, "CALL Clearblock"

  PRINT #1, "; *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*"
  PRINT #1, ";                  Here starts the program (ULTRABASIC)"
  PRINT #1, "; *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*"
  PRINT #1, "MOV EDI, [varedi]"
Copyfile codefile$
  PRINT #1, "; *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*"
  PRINT #1, ";                  Here ends the program (ULTRABASIC)"
  PRINT #1, "; *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*"
  PRINT #1, "EndProgram:"
  PRINT #1, "; *-*-*-*-*-*-*-*-*-*-*-*- Free Var block *-*-*-*-*-*-*-*-*-*-*-*-"
  PRINT #1, "CMP DWORD [varblockhandle], 0"
  PRINT #1, "JE NEAR Skipvarblock"

IF platform = dos THEN
  PRINT #1, "MOV SI, [varblockhandle]"
  PRINT #1, "MOV DI, [varblockhandle+2]"
ELSE
  PRINT #1, "MOV EBX, [varblockhandle]"
  PRINT #1, "MOV EAX, [varedi]"
END IF

  PRINT #1, "Call NEAR FreeBlock"
  PRINT #1, "Skipvarblock:"
IF NOT curstringmem = 0 THEN
  PRINT #1, "; Free fixed lenght string block"
  PRINT #1, "CMP DWORD [fixedstringblockhandle], 0"
  PRINT #1, "JE NEAR Skipfixedstringblock"

IF platform = dos THEN
  PRINT #1, "MOV SI, [fixedstringblockhandle]"
  PRINT #1, "MOV DI, [fixedstringblockhandle+2]"
ELSE
  PRINT #1, "MOV EBX, [fixedstringblockhandle]"
END IF

  PRINT #1, "Call NEAR FreeBlock"
  PRINT #1, "Skipfixedstringblock:"
END IF

  PRINT #1, "; *-*-*-*-*-*-*-*-*-*-*-*- Free String block *-*-*-*-*-*-*-*-*-*-*-*-"
  PRINT #1, "CMP DWORD [tmpblockhandle], 0"
  PRINT #1, "JE NEAR Skiptmpblock"

IF platform = dos THEN
  PRINT #1, "MOV SI, [tmpblockhandle]"
  PRINT #1, "MOV DI, [tmpblockhandle+2]"
ELSE
  PRINT #1, "MOV EBX, [tmpblockhandle]"
END IF

  PRINT #1, "Call NEAR FreeBlock"
  PRINT #1, "Skiptmpblock:"
  PRINT #1, "; *-*-*-*-*-*-*-*-*-*-*-*- Free Vlen String block *-*-*-*-*-*-*-*-*-*-*-*-"
  PRINT #1, "CMP DWORD [stringblockhandle], 0"
  PRINT #1, "JE NEAR Skipstringblock"
IF platform = dos THEN
  PRINT #1, "MOV SI, [stringblockhandle]"
  PRINT #1, "MOV DI, [stringblockhandle+2]"
ELSE
  PRINT #1, "MOV EBX, [stringblockhandle]"
END IF
  PRINT #1, "Call NEAR FreeBlock"
  PRINT #1, "Skipstringblock:"

' -/ Para liberar las matrices
  FOR i = 0 TO curarray - 1
    IF extraarraydata(i) = CHR$(0) THEN
    PRINT #1, "CMP DWORD [ArrayHandle" + LTRIM$(STR$(i)) + "], 0"
    PRINT #1, "JE NEAR SkipAfree" + LTRIM$(STR$(i))

IF platform = dos THEN
    PRINT #1, "MOV SI, [ArrayHandle" + LTRIM$(STR$(i)) + "]"
    PRINT #1, "MOV DI, [ArrayHandle" + LTRIM$(STR$(i)) + "+2]"
ELSE
    PRINT #1, "MOV EBX, [ArrayHandle" + LTRIM$(STR$(i)) + "]"
END IF

    PRINT #1, "Call NEAR FreeBlock"
    PRINT #1, "SkipAfree" + LTRIM$(STR$(i)) + ":"
    END IF
  NEXT i

  FOR i = 0 TO curstringarray - 1
    PRINT #1, "CMP DWORD [StringHandle" + LTRIM$(STR$(i)) + "], 0"
    PRINT #1, "JE NEAR SkipSAfree" + LTRIM$(STR$(i))

IF platform = dos THEN
    PRINT #1, "MOV SI, [StringHandle" + LTRIM$(STR$(i)) + "]"
    PRINT #1, "MOV DI, [StringHandle" + LTRIM$(STR$(i)) + "+2]"
ELSE
    PRINT #1, "MOV EBX, [StringHandle" + LTRIM$(STR$(i)) + "]"
END IF

    PRINT #1, "Call NEAR FreeBlock"
    PRINT #1, "SkipSAfree" + LTRIM$(STR$(i)) + ":"
  NEXT i

  FOR i = 0 TO curvlenstring - 1
    a$ = MID$(vlenstring$(i), 1, 1)
    a = ASC(a$)
    IF a >= 128 THEN a = a - 128
    IF a = arraytype THEN
    PRINT #1, "CMP DWORD [vlenarrayoffset" + LTRIM$(STR$(i)) + "], 0"
    PRINT #1, "JE NEAR SkipvlenSAfree" + LTRIM$(STR$(i))
IF platform = dos THEN
    PRINT #1, "MOV SI, [vlenarrayoffset" + LTRIM$(STR$(i)) + "]"
    PRINT #1, "MOV DI, [vlenarrayoffset" + LTRIM$(STR$(i)) + "+2]"
ELSE
    PRINT #1, "MOV EBX, [vlenarrayhandle" + LTRIM$(STR$(i)) + "]"
END IF

    PRINT #1, "Call NEAR FreeBlock"
    PRINT #1, "SkipvlenSAfree" + LTRIM$(STR$(i)) + ":"
    END IF
  NEXT i

' -/
IF platform = dos THEN
  PRINT #1, "mov ah, 02"
  PRINT #1, "mov ebx, 0"
  PRINT #1, "CMP word [texty], 25"
  PRINT #1, "JNGE skiptyinc"
  PRINT #1, "mov word [texty], 24"
  PRINT #1, "skiptyinc:"
  PRINT #1, "mov dl, [textx]"
  PRINT #1, "mov dh, [texty]"
  PRINT #1, "INT 10h"
  PRINT #1, "MOV ah, 1"
  PRINT #1, "mov bx, 0"
  PRINT #1, "MOV cx, [cursorshape]"
  PRINT #1, "INT 10h"
  PRINT #1, "MOV EAX, 4C00h"
  PRINT #1, "INT 21h"
ELSE
  PRINT #1, "CALL [ExitProcess]"
END IF
BuildMaxOffset 0
Copyfile "ainclude\mem"
Copyfile "ainclude\string"
Copyfile "ainclude\math"
Copyfile "ainclude\file"
Copyfile "ainclude\text"
Copyfile "ainclude\textwin"
Copyfile "ainclude\error"
Copyfile "ainclude\fmath"
Copyfile "ainclude\keyboard.asm"
Copyfile "ainclude\timer"

IF platform = dos THEN
  PRINT #1, "[section .data]"
ELSE : PRINT #1, "SECTION DATA USE32 CLASS=DATA"
END IF

PRINT #1, "Align 4"
PRINT #1, "ubasic2 DB 'Ultrabasic', 0"
Copyfile "ainclude\data"

Copyfile datafile$
' PRINT datafile$: SLEEP
Copyfile "ainclude\dataw"

IF platform = win32 THEN PRINT #1, "[section .bss]": PRINT #1, "textscreen RESB 4000"
'Copyfile "ainclude\bss.asm"
CLOSE #1

END SUB

SUB call.sub (name$, calltype)
'functiontype = 0
DIM tmpargs(30)

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

IF calltype = ubsub THEN
  a = existSUB(name$, i)
ELSE
  a = existFUNCTION(name$, i)
END IF

Args = getarg(1, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)

IF Object$ <> "" THEN
'  Args = Args + 1
'  arg$(Args) = Object$
  ' SPLIT INDEX OF ARRAY FROM SUB/FUNCTIONS PARS
  IF calltype <> ubsub THEN
    IF insidesub <> 0 THEN R = cursubarray ELSE R = curarray
    FOR III = 0 TO R
      IF insidesub = 0 THEN
        IF Object$ = UCASE$(MID$(LEFT$(array$(III), INSTR(array$(III), " ") - 1), 2)) THEN
          FOR aa = 1 TO ObjArrayDim(III)
            Object$ = Object$ + "(" + (Arg$(1)) + ")"
            FOR II = 1 TO Args
              Arg$(II) = Arg$(II + 1)
            NEXT
            Args = Args - 1
          NEXT
          EXIT FOR
        END IF
      ELSE
        IF Object$ = UCASE$(MID$(LEFT$(subarray$(III), INSTR(subarray$(III), " ") - 1), 2)) THEN
          FOR a = 1 TO SubObjArrayDim(III)
            Object$ = Object$ + "(" + (Arg$(1)) + ")"
            FOR II = 1 TO Args
              Arg$(II) = Arg$(II + 1)
            NEXT
            Args = Args - 1
          NEXT
          EXIT FOR
        END IF
      END IF
    NEXT
  ELSE
   IF P$ <> "" THEN
     Object$ = Object$ + "(" + P$ + ")"
   END IF

  END IF

  CallObjects Args, typeblock$, Object$
  arg1$ = Arg$(1)
END IF


OPEN tmpdir$ + "\subd." + STR2$(i) FOR INPUT AS #108
  INPUT #108, type$
  IF type$ = "__FUNCTION" THEN
    INPUT #108, a$
    INPUT #108, a$
    INPUT #108, a$
  ELSE
    INPUT #108, a$
    INPUT #108, a$
  END IF

  IF a$ = "_dll" THEN
    INPUT #108, a$
    INPUT #108, call$
    call$ = "[" + call$ + "]"
  ELSE
    IF a$ = "_export" THEN INPUT #108, a$
    PRINT #2, "___Call ubsub"
    PRINT #2, sname$
    call$ = "[<_calling_and_ubasic_sub>]"
    ubsubtype = 1
  END IF

'  IF NOT ubsubtype = 1 THEN PRINT #2, "PUSH EDI"
  IF insidesub THEN PRINT #2, "PUSH ESI"
  IF Secstack = true THEN PRINT #2, "MOV [tmp], ESP": IF insidesub THEN PRINT #2, "MOV [tmp+4], ESI"

  IF a$ = "No args" THEN
    rett = true
    GOSUB saveforregs
    PRINT #2, "CALL " + call$
    IF Secstack = true THEN PRINT #2, "MOV ESP, [tmp]": Secstack = false: IF insidesub THEN PRINT #2, "MOV ESI, [tmp+4]"
    GOSUB loadforregs
    IF insidesub THEN PRINT #2, "POP ESI"
    'PRINT #2, "POP EDI"
    CLOSE #108
    IF oname$ <> "" THEN name$ = oname$
    EXIT SUB
  END IF

saveforregs:
IF ubsubtype THEN
IF insidesub = true THEN
  IF forcounter > 0 THEN
  workfor2 = workfor
  FOR i = forcounter - 1 TO 0 STEP -1
   IF fortype = intgr THEN
    PRINT #2, "PUSH DWORD [FOR" + STR2$(workfor2) + "STEP]"
    PRINT #2, "PUSH DWORD [FOR" + STR2$(workfor2) + "END]"
   ELSE
    PRINT #2, "PUSH DWORD [FOR" + STR2$(workfor2) + "STEP]"
    PRINT #2, "PUSH DWORD [FOR" + STR2$(workfor2) + "END]"
    PRINT #2, "PUSH DWORD [FOR" + STR2$(workfor2) + "STEP+4]"
    PRINT #2, "PUSH DWORD [FOR" + STR2$(workfor2) + "END+4]"
   END IF
   workfor2 = workfor2 - 1
  NEXT i
  END IF
END IF
END IF
IF rett = true THEN RETURN

  DO WHILE NOT endloop = true
    IF a$ = "_End" THEN EXIT DO
    IF a$ = "_Par" THEN
      INPUT #108, var
      tmpargs(curarg) = var
      curarg = curarg + 1
    END IF
    INPUT #108, a$
  LOOP
CLOSE #108

FOR i = curarg TO 0 STEP -1
  'IF LEFT$(arg$(i + 1), 1) = "@" THEN arg$(i + 1) = "VARPTR(" + arg$(i + 1) + ")"
  IF tmpargs(i) >= 64 THEN Arg$(i + 1) = "VARPTR(" + Arg$(i + 1) + ")": tmpargs(i) = tlong'tmpargs(i) - 64

  'ELSE
   SELECT CASE tmpargs(i)
    CASE tlong: Math.parser Arg$(i + 1), intgr, 0: PRINT #2, "PUSH EAX"
    CASE tinteger: Math.parser Arg$(i + 1), intgr, 0: PRINT #2, "PUSH AX"
    CASE tlongsingle: Math.parser Arg$(i + 1), tsingle, 0: PRINT #2, "MOV EAX, [tmpvar]": PRINT #2, "PUSH EAX"

    CASE tsingle: Math.parser Arg$(i + 1), tsingle, 0: PRINT #2, "PUSH DWORD [tmpvar]"
    CASE tdouble: Math.parser Arg$(i + 1), tdouble, 0: PRINT #2, "PUSH DWORD [tmpfpuvar2]"
    CASE textended: Math.parser Arg$(i + 1), textended, 0: PRINT #2, "PUSH DWORD [tmpfpuvar3]"

    CASE tnullstring:
      string.parser Arg$(i + 1)
      dt = dt + 1
      PRINT #2, "ADD EAX, 4"
      PRINT #2, "PUSH EAX"
    CASE tstring:
      string.parser Arg$(i + 1)
      dt = dt + 1
      PRINT #2, "PUSH EAX"
   END SELECT
  'END IF
NEXT i

PRINT #2, "CALL " + call$
IF Secstack = true THEN PRINT #2, "MOV ESP, [tmp]": Secstack = false: IF insidesub THEN PRINT #2, "MOV ESI, [tmp+4]"
' IF NOT ubsubtype = 1 THEN PRINT #2, "POP EDI"

loadforregs:
IF ubsubtype THEN
IF insidesub = true THEN
  IF forcounter > 0 THEN
  workfor2 = (workfor - forcounter) + 1
  FOR i = forcounter - 1 TO 0 STEP -1
   IF fortype = intgr THEN
    PRINT #2, "POP DWORD [FOR" + STR2$(workfor2) + "END]"
    PRINT #2, "POP DWORD [FOR" + STR2$(workfor2) + "STEP]"
   ELSE
    PRINT #2, "POP DWORD [FOR" + STR2$(workfor2) + "END+4]"
    PRINT #2, "POP DWORD [FOR" + STR2$(workfor2) + "STEP+4]"
    PRINT #2, "POP DWORD [FOR" + STR2$(workfor2) + "END]"
    PRINT #2, "POP DWORD [FOR" + STR2$(workfor2) + "STEP]"
   END IF
   workfor2 = workfor2 + 1
  NEXT i
  END IF
END IF
END IF
IF rett = true THEN RETURN

IF insidesub THEN PRINT #2, "POP ESI"

IF dt > 0 THEN
FOR i = dt TO 1 STEP -1
  dectmp
NEXT i
END IF

END SUB

SUB Checkargs (callargs, kargs)
IF NOT callargs = kargs THEN show.error 37, ""
END SUB

SUB Checkothers (name$)
spar$ = par$
sfsname$ = name$
tmp = existSUB(name$, i)
IF NOT subfound = true THEN
  nword$ = getword$(wordtype)
  IF NOT nword$ = "=" THEN show.error 16, name$
  
  a = sexist(name$, i, typeblock$, mempos&, varshared)
  IF NOT a = -1 THEN GOTO mlabel20
  
  sa$ = UCASE$(name$)
  tmp = INSTR(name$, ".")
  IF tmp > 0 THEN
     typeobj$ = MID$(name$, tmp + 1, LEN(name$) - (tmp))
     name$ = MID$(name$, 1, tmp - 1)
     size$ = spar$
  END IF
  stypeobj$ = typeobj$
  IF sexist(name$, i, typeblock$, mempos&, varshared) = -1 THEN
    name$ = sa$
    GOSUB forstrings
    IF ASC(MID$(sa$, 1, 1)) >= 65 AND ASC(MID$(sa$, 1, 1)) <= 90 THEN autoaddvariable sa$
  END IF

mlabel20:
  a$ = MID$(codetext$, getcharpos, LEN(codetext$) - (getcharpos - 1))
  a = sexist(name$, i, typeblock$, mempos&, varshared)
  
  SELECT CASE a
    CASE tbyte
    IF spar$ = "" THEN
      Math.parser a$, intgr, 0
      Getvarvalue name$, 1, typeobj$, leavemem2, gotvartype
    ELSE
      Math.parser a$, intgr, 0
      PRINT #2, "PUSH EAX"
      par$ = spar$
      Getvarvalue name$, 1, typeobj$, leavemem2, gotvartype
      PRINT #2, "POP EBX"
      PRINT #2, "MOV [EAX], BL"
    END IF
    EXIT SUB

    CASE tinteger
    IF spar$ = "" THEN
      Math.parser a$, intgr, 0
      Getvarvalue name$, 1, typeobj$, leavemem2, gotvartype
    ELSE
      Math.parser a$, intgr, 0
      PRINT #2, "PUSH EAX"
      par$ = spar$
      Getvarvalue name$, 1, typeobj$, leavemem2, gotvartype
      PRINT #2, "POP EBX"
      PRINT #2, "MOV [EAX], BX"
    END IF
    EXIT SUB

    CASE tlong
    IF spar$ = "" THEN
      Math.parser a$, intgr, 0
      Getvarvalue name$, 1, typeobj$, leavemem2, gotvartype
    ELSE
      Math.parser a$, intgr, 0
      PRINT #2, "PUSH EAX"
      par$ = spar$
      Getvarvalue name$, 1, typeobj$, leavemem2, gotvartype
      PRINT #2, "POP EBX"
      PRINT #2, "MOV [EAX], EBX"
    END IF
    EXIT SUB

    CASE tsingle
      par$ = spar$
      Getvarvalue name$, 1, typeobj$, leavemem, gotvartype
      PRINT #2, "PUSH EAX"
      Math.parser a$, skip, 0
      PRINT #2, "POP EAX"
      PRINT #2, "FSTP DWORD [EAX]"
    EXIT SUB
    CASE tdouble
      par$ = spar$
      Getvarvalue name$, 1, typeobj$, leavemem, gotvartype
      PRINT #2, "PUSH EAX"
      Math.parser a$, skip, 0
      PRINT #2, "POP EAX"
      PRINT #2, "FSTP QWORD [EAX]"
    EXIT SUB
    CASE textended
      par$ = spar$
      Getvarvalue name$, 1, typeobj$, leavemem, gotvartype
      PRINT #2, "PUSH EAX"
      Math.parser a$, skip, 0
      PRINT #2, "POP EAX"
      PRINT #2, "FSTP TWORD [EAX]"
    EXIT SUB

    CASE 0      ' ---------------- STRUCTURAS TYPE ---------------
      typesize& = returntypesize&(typeblock$, i2)
      GOTO mlabel62
addtypedat:
      IF NOT size$ = "" THEN
        'Math.parser size$, intgr, 0
        GetDimensions size$, i
        PRINT #2, "MOV EBX, " + STR$(typesize&)
        PRINT #2, "MUL EBX"
        PRINT #2, "ADD EAX, [Array" + STR2$(i) + "]"
      ELSE : PRINT #2, "MOV EAX, [Array" + STR2$(i) + "]"
      END IF
      PRINT #2, "PUSH EAX"
RETURN
mlabel62:
      objpos& = gettypemempos&(typeblock$, typeobj$, objtype)
      IF objtype = tstring THEN
        string.parser a$
        store.string sfsname$, size$
        dectmp
        EXIT SUB
      END IF

      GOSUB addtypedat
      SELECT CASE objtype
        CASE tbyte
          Math.parser a$, intgr, 0
          PRINT #2, "POP EBX"
          PRINT #2, "MOV [EBX+" + STR$(objpos&) + "], AL"
        CASE tinteger
          Math.parser a$, intgr, 0
          PRINT #2, "POP EBX"
          PRINT #2, "MOV [EBX+" + STR$(objpos&) + "], AX"
        CASE tlong
          Math.parser a$, intgr, 0
          PRINT #2, "POP EBX"
          PRINT #2, "MOV [EBX+" + STR$(objpos&) + "], EAX"
        CASE tsingle
          Math.parser a$, skip, 0
          PRINT #2, "POP EBX"
          PRINT #2, "FSTP DWORD [EBX+" + STR$(objpos&) + "]"
        CASE tdouble
          Math.parser a$, skip, 0
          PRINT #2, "POP EBX"
          PRINT #2, "FSTP QWORD [EBX+" + STR$(objpos&) + "]"
        CASE textended
          Math.parser a$, skip, 0
          PRINT #2, "POP EBX"
          PRINT #2, "FSTP TWORD [EBX+" + STR$(objpos&) + "]"
        END SELECT
  END SELECT
EXIT SUB
' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
'                     Para cadenas
' *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
forstrings:
IF a = -1 THEN
mlabel39:
IF NOT Stringexist(name$, 0, 0, 0, par$) = -1 THEN
  t$ = MID$(codetext$, getcharpos, LEN(codetext$) - (getcharpos - 1))
  string.parser t$
  store.string name$, spar$
  dectmp
  EXIT SUB
ELSE
  IF MID$(name$, LEN(name$), 1) = "$" THEN
    IF stringformat = varlenght THEN
      Addstring name$, varshared, varlenght, ""
    ELSE : Addvlenstring name$, varshared, vartype, ""
    END IF
    GOTO mlabel39
  END IF
END IF
END IF
RETURN

ELSE
  call.sub name$, ubsub
END IF

END SUB

SUB cleanbasfile

filecounter = 3

OPEN basfile$ FOR INPUT AS #1
OPEN cleanbas$ FOR OUTPUT AS #2
  PRINT #2, basfile$
  DO WHILE NOT EOF(1)
    LINE INPUT #1, codetext$
    fullcodetext$ = codetext$
    st$ = codetext$
    getcharpos = 0
    a$ = getword$(wordtype)

    addfile a$
    PRINT #2, st$
  LOOP

IF globalbasinc > 0 THEN
FOR i = 0 TO globalbasinc - 1
  PRINT #2, "---- File sub add ----"
  PRINT #2, incfile$(i)
  DO WHILE NOT EOF(incfilen(i))
    LINE INPUT #incfilen(i), a$
    PRINT #2, a$
  LOOP
NEXT i
END IF

CLOSE
END SUB

FUNCTION ClearFilenum$ (text$)
IF MID$(text$, 1, 1) = "#" THEN ClearFilenum$ = MID$(text$, 2, LEN(text$) - 1): EXIT FUNCTION
ClearFilenum$ = text$
END FUNCTION

FUNCTION clrspc$ (texttoclear$)
clrspc$ = LTRIM$(RTRIM$(texttoclear$))
END FUNCTION

SUB CMath.parser (value#)

DIM opval AS DOUBLE

value# = 0
c = 0
DO WHILE NOT endloop = true
  a$ = getword$(w)

  IF a$ = lineeof THEN EXIT SUB
  IF UCASE$(a$) = "NOT" THEN usenot = true: a$ = getword$(w)

IF c = 0 OR c = 2 THEN
  IF w = float OR w = intgr THEN
    IF c = 2 THEN opval = VAL(a$): GOTO label5
    value# = VAL(a$)
    c = 1
    GOTO label4
  END IF

  a = Getconsttype(a$, value&, stringvalue$, floatvalue#)
  IF a = float THEN opval = floatvalue#
  IF a = intgr THEN opval = value&
  IF a = -1 THEN show.error 15, a$
  IF a = stringtype THEN show.error 42, a$

  IF c = 2 THEN GOTO label5
  value# = opval
  c = 1
  GOTO label4
END IF

IF c = 1 THEN
  op$ = UCASE$(a$)
  c = 2
  GOTO label4
END IF

label5:
IF usenot = true THEN opval = NOT opval
SELECT CASE op$
  CASE "*": value# = value# * opval
  CASE "/": value# = value# / opval
  CASE "-": value# = value# - opval
  CASE "+": value# = value# + opval
  CASE "^": value# = value# ^ opval
  CASE "MOD": value# = value# MOD opval
  CASE "\": value# = value# \ opval
  CASE "AND": value# = value# AND opval
  CASE "XOR": value# = value# XOR opval
  CASE "OR": value# = value# OR opval
  CASE ELSE: show.error 42, op$
END SELECT
usenot = false
c = 1
label4:
LOOP

END SUB

SUB CND.IF (elsenum)

DIM cond$(40)
DIM un(40)
DIM unnot(40)

strg = false

printc codetext$

checkfornot = 3
DO WHILE NOT endloop = true
  f$ = e$
  e$ = d$
  d$ = c$
  c$ = b$
  b$ = a$
  a$ = getchar$
  t$ = t$ + c$

  IF a$ = CHR$(34) THEN
    IF strg = true THEN
      strg = false
    ELSE
      strg = true
      checkfornot = 0
    END IF
  END IF

  IF strg = true THEN GOTO label41

  IF f$ = CHR$(9) OR f$ = CHR$(32) THEN
  IF UCASE$(e$ + d$ + c$ + b$) = "THEN" THEN
  IF a$ = CHR$(9) OR a$ = CHR$(32) OR a$ = lineeof THEN
    cond$(curcond) = clrspc$(MID$(t$, 1, LEN(t$) - 4))
    unnot(curcond) = curunnot
    maxcond = curcond
    EXIT DO
  END IF
  END IF
  END IF

  IF a$ = lineeof THEN show.error 26, ""
  
  IF checkfornot >= 0 THEN
  IF UCASE$(c$ + b$ + a$) = "NOT" THEN
    t$ = ""
    c$ = "": b$ = "": a$ = ""
    curunnot = true
  END IF
  END IF

  IF NOT a$ = CHR$(32) AND NOT a$ = CHR$(9) THEN
    IF checkfornot > 0 THEN checkfornot = checkfornot - 1
  END IF

  IF c$ = CHR$(32) OR c$ = CHR$(9) THEN
  IF a$ = CHR$(32) OR a$ = CHR$(9) THEN
    IF b$ = "&" THEN
      cond$(curcond) = clrspc$(t$)
      un(curcond + 1) = condand
      unnot(curcond) = curunnot
      curunnot = false
      curcond = curcond + 1
      checkfornot = 4
      t$ = "": c$ = "": b$ = ""
    ELSEIF b$ = "|" THEN
      maxor = maxor + 1
      cond$(curcond) = clrspc$(t$)
      un(curcond + 1) = condor
      unnot(curcond) = curunnot
      curunnot = false
      curcond = curcond + 1
      checkfornot = 4
      t$ = "": c$ = "": b$ = ""
    END IF
  END IF
  END IF
label41:
LOOP

curor = 0
FOR i = 0 TO maxcond
 getconditions cond$(i), a$, b$, cond$
 IF b$ = "" THEN b$ = "0": cond$ = "<>"
 useor = un(i)
 cnot = unnot(i)

 IF useor = condor THEN
   PRINT #2, "JMP IF" + STR2$(workif) + "code" + STR2$(elsenum)
   PRINT #2, "OR" + STR2$(workif) + "label" + STR2$(curor) + ":"
   curor = curor + 1
 END IF

 a = getoptype(a$)
 b = getoptype(b$)
 
 IF NOT a = b THEN show.error 27, ""

   IF NOT maxor = 0 THEN
   IF curor < maxor THEN
     jmplabel$ = "OR" + STR2$(workif) + "label" + STR2$(curor)
   ELSE
     jmplabel$ = "ELSE" + STR2$(workif) + "label" + STR2$(elsenum)
   END IF
   ELSE : jmplabel$ = "ELSE" + STR2$(workif) + "label" + STR2$(elsenum)
   END IF
 
 IF a = mathop THEN
   c = Scanline(a$, changepos)
   d = Scanline(b$, changepos)
   IF c = float OR d = float THEN     ' FLOAT
     printc cond$(i)
     Math.parser a$, skip, 0
     IF fpuworkmethod = textended THEN
       PRINT #2, "FSTP TWORD [tmpfpuvar4]"
     ELSE : PRINT #2, "FSTP QWORD [tmpfpuvar4]"
     END IF
     Math.parser b$, skip, 0

     IF fpuworkmethod = textended THEN
       PRINT #2, "FLD TWORD [tmpfpuvar4]"
     ELSE : PRINT #2, "FLD QWORD [tmpfpuvar4]"
     END IF
     
     PRINT #2, "FCOMPP"
     PRINT #2, "FSTSW AX"
     PRINT #2, "SAHF"

   SELECT CASE cond$
     CASE "=", "=="
       IF cnot = false THEN
         PRINT #2, "JNE " + jmplabel$
       ELSE : PRINT #2, "JE " + jmplabel$
       END IF
     CASE ">"
       IF cnot = false THEN
         PRINT #2, "JNA " + jmplabel$
       ELSE : PRINT #2, "JA " + jmplabel$
       END IF
     CASE "<"
       IF cnot = false THEN
         PRINT #2, "JNB " + jmplabel$
       ELSE : PRINT #2, "JB " + jmplabel$
       END IF
     CASE "=>", ">="
       IF cnot = false THEN
         PRINT #2, "JNAE " + jmplabel$
       ELSE : PRINT #2, "JAE " + jmplabel$
       END IF
     CASE "=<", "<="
       IF cnot = false THEN
         PRINT #2, "JNBE " + jmplabel$
       ELSE : PRINT #2, "JBE " + jmplabel$
       END IF
     CASE "<>", "><"
       IF cnot = false THEN
         PRINT #2, "JE " + jmplabel$
       ELSE : PRINT #2, "JNE " + jmplabel$
       END IF
     END SELECT
   ELSE                               ' INTEGER
     printc cond$(i)
     Math.parser a$, intgr, 0
     PRINT #2, "PUSH EAX"
     Math.parser b$, intgr, 0
     PRINT #2, "POP EBX"
     PRINT #2, "CMP EBX, EAX"

   SELECT CASE cond$
     CASE "=", "=="
       IF cnot = false THEN
         PRINT #2, "JNE " + jmplabel$
       ELSE : PRINT #2, "JE " + jmplabel$
       END IF
     CASE ">"
       IF cnot = false THEN
         PRINT #2, "JNG " + jmplabel$
       ELSE : PRINT #2, "JG " + jmplabel$
       END IF
     CASE "<"
       IF cnot = false THEN
         PRINT #2, "JNL " + jmplabel$
       ELSE : PRINT #2, "JL " + jmplabel$
       END IF
     CASE "=>", ">="
       IF cnot = false THEN
         PRINT #2, "JNGE " + jmplabel$
       ELSE : PRINT #2, "JGE " + jmplabel$
       END IF
     CASE "=<", "<="
       IF cnot = false THEN
         PRINT #2, "JNLE " + jmplabel$
       ELSE : PRINT #2, "JLE " + jmplabel$
       END IF
     CASE "<>", "><"
       IF cnot = false THEN
         PRINT #2, "JE " + jmplabel$
       ELSE : PRINT #2, "JNE " + jmplabel$
       END IF
     END SELECT

   END IF
 ELSE    ' STRING
   printc cond$(i)
   
   string.parser a$
   string.parser b$

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

   PRINT #2, "MOV EBX, [curtmpblock]"
   PRINT #2, "SHL EBX, " + STR$(tmpstringsize)
   PRINT #2, "ADD EBX, [tmpblockoffset]"
   dectmp
   dectmp
   PRINT #2, "CALL CmpStrings"
   PRINT #2, "CMP EAX, 1"

   IF cnot = false THEN
     PRINT #2, "JNE " + jmplabel$
   ELSE
     PRINT #2, "JE " + jmplabel$
   END IF
 END IF

NEXT i

PRINT #2, "IF" + STR2$(workif) + "code" + STR2$(elsenum) + ":"

END SUB

SUB CND.Select

PRINT #5, "; SELECT CASE START"

cond$ = MID$(codetext$, getcharpos, LEN(codetext$) - getcharpos + 1)
optype = getoptype(cond$)

IF optype = mathop THEN
  IF Scanline(cond$, changepos) = float THEN  ' -------------- FLOAT POINT
    Math.parser cond$, skip, 0
    IF fpuworkmethod = textended THEN PRINT #2, "FSTP TWORD [selectcmp]"
    IF fpuworkmethod = tdouble THEN PRINT #2, "FSTP QWORD [selectcmp]"
    PRINT #5, float
  ELSE                                        ' -------------- INTEGER MATH
    Math.parser cond$, intgr, 0
    PRINT #2, "MOV [selectcmp], EAX"
    PRINT #5, intgr
  END IF
ELSE      ' -------------- STRINGS
  string.parser cond$
  PRINT #5, stringtype
  PRINT #2, "MOV [selectcmp], EAX"
END IF

PRINT #2, ";----- SELECT CASE START -----"

END SUB

SUB CND.SelectProcess (worktype)

curcase = 0
DO WHILE NOT endloop = true
  fullcond$ = clrspc$(GetNextcase$)
  IF fullcond$ = "END" THEN
    IF worktype = stringtype THEN dectmp
    EXIT SUB
  END IF
  
  Pushtext fullcond$
    cond$ = Getscond$(CMP$, end$)
    endloop2 = 0
    DO WHILE NOT endloop2 = true

      IF UCASE$(cond$) = "ELSE" THEN
        PRINT #2, "JMP NEAR select" + STR2$(workselect) + "case" + STR2$(curcase)
        GOTO label47
      END IF

      IF worktype = intgr THEN             ' *-------- INTEGER --------*
      SELECT CASE CMP$
        CASE "=<", "<="
          Math.parser cond$, intgr, 0
          PRINT #2, "CMP [selectcmp], EAX"
          PRINT #2, "JLE NEAR select" + STR2$(workselect) + "case" + STR2$(curcase)
        CASE "=>", ">="
          Math.parser cond$, intgr, 0
          PRINT #2, "CMP [selectcmp], EAX"
          PRINT #2, "JGE NEAR select" + STR2$(workselect) + "case" + STR2$(curcase)
        CASE ">"
          Math.parser cond$, intgr, 0
          PRINT #2, "CMP [selectcmp], EAX"
          PRINT #2, "JG NEAR select" + STR2$(workselect) + "case" + STR2$(curcase)
        CASE "<"
          Math.parser cond$, intgr, 0
          PRINT #2, "CMP [selectcmp], EAX"
          PRINT #2, "JL NEAR select" + STR2$(workselect) + "case" + STR2$(curcase)
        CASE ""
          Math.parser cond$, intgr, 0
          PRINT #2, "CMP [selectcmp], EAX"
          PRINT #2, "JE NEAR select" + STR2$(workselect) + "case" + STR2$(curcase)
      END SELECT

      ELSEIF worktype = float THEN         ' *-------- FLOAT ----------*

      IF fpuworkmethod = textended THEN
        cmpcmd1$ = "FLD TWORD [selectcmp]"
        cmpcmd2$ = "FCOMPP st1, st0"
      ELSE
        cmpcmd1$ = ""
        cmpcmd2$ = "FCOMP QWORD [selectcmp]"
      END IF

      SELECT CASE CMP$
        CASE "=<", "<="
          Math.parser cond$, skip, 0
          PRINT #2, cmpcmd1$
          PRINT #2, cmpcmd2$
          PRINT #2, "FSTSW AX"
          PRINT #2, "SAHF"
          PRINT #2, "JNBE NEAR select" + STR2$(workselect) + "case" + STR2$(curcase)
        CASE "=>", ">="
          Math.parser cond$, skip, 0
          PRINT #2, cmpcmd1$
          PRINT #2, cmpcmd2$
          PRINT #2, "FSTSW AX"
          PRINT #2, "SAHF"
          PRINT #2, "JNAE NEAR select" + STR2$(workselect) + "case" + STR2$(curcase)
        CASE ">"
          Math.parser cond$, skip, 0
          PRINT #2, cmpcmd1$
          PRINT #2, cmpcmd2$
          PRINT #2, "FSTSW AX"
          PRINT #2, "SAHF"
          PRINT #2, "JNA NEAR select" + STR2$(workselect) + "case" + STR2$(curcase)
        CASE "<"
          Math.parser cond$, skip, 0
          PRINT #2, cmpcmd1$
          PRINT #2, cmpcmd2$
          PRINT #2, "FSTSW AX"
          PRINT #2, "SAHF"
          PRINT #2, "JNB NEAR select" + STR2$(workselect) + "case" + STR2$(curcase)
        CASE ""
          Math.parser cond$, skip, 0
          PRINT #2, cmpcmd1$
          PRINT #2, cmpcmd2$
          PRINT #2, "FSTSW AX"
          PRINT #2, "SAHF"
          PRINT #2, "JE NEAR select" + STR2$(workselect) + "case" + STR2$(curcase)
      END SELECT

      ELSEIF worktype = stringtype THEN    ' *-------- STRING ---------*
        string.parser cond$
        PRINT #2, "MOV EAX, [curtmpblock]"
        PRINT #2, "DEC EAX"
        PRINT #2, "SHL EAX, " + STR$(tmpstringsize)
        PRINT #2, "ADD EAX, [tmpblockoffset]"

        PRINT #2, "MOV EBX, [curtmpblock]"
        PRINT #2, "SHL EBX, " + STR$(tmpstringsize)
        PRINT #2, "ADD EBX, [tmpblockoffset]"
        dectmp

        PRINT #2, "CALL CmpStrings"
        PRINT #2, "CMP EAX, 1"
        PRINT #2, "JE NEAR select" + STR2$(workselect) + "case" + STR2$(curcase)
      END IF
label47:
      IF end$ = "END" THEN EXIT DO
      cond$ = Getscond$(CMP$, end$)
    LOOP
  Poptext
  curcase = curcase + 1
LOOP

END SUB

SUB CString.parser (stringt$)
stringt$ = ""

c = 0
DO WHILE NOT endloop = true
  a$ = getword$(w)

  IF a$ = lineeof THEN EXIT SUB

IF c = 0 OR c = 2 THEN
  IF w = stringtype THEN
    operand$ = a$
    IF c = 2 THEN GOTO label7
    stringt$ = a$
    c = 1
    GOTO label6
  END IF

  a = Getconsttype(a$, value&, stringvalue$, floatvalue#)
  IF a = stringtype THEN operand$ = stringvalue$
  IF a = intgr OR a = float THEN show.error 42, a$
  IF a = -1 THEN show.error 15, a$
  
  IF c = 2 THEN GOTO label7
  stringt$ = operand$
  c = 1
  GOTO label6
END IF

IF c = 1 THEN
  op$ = a$
  c = 2
  GOTO label6
END IF

label7:
IF op$ = "+" THEN
  stringt$ = stringt$ + operand$
ELSE
  show.error 42, op$
END IF
c = 1

label6:
LOOP
END SUB

FUNCTION fixstring$ (text$)
Pushtext text$
DO WHILE NOT endloop = true
  a$ = getchar$
  IF a$ = lineeof THEN EXIT DO

  IF a$ = "'" THEN
    cleana$ = cleana$ + "', 39, '"
  ELSE
    cleana$ = cleana$ + a$
  END IF
LOOP
Poptext

fixstring$ = cleana$
END FUNCTION

SUB getcommandline
getcharpos = 0
ignorenumbertype = true

DO WHILE NOT endloop = true
  a$ = getword$(wordtype)

  IF a$ = lineeof THEN EXIT DO

  SELECT CASE LCASE$(a$)
    CASE "-help": GOTO showcommands
    CASE "-makefile"
      loadmakefile getword$(wordtype)
      EXIT SUB
    CASE "-autoaddvars"
      b$ = LCASE$(getword$(wordtype))
      IF b$ = "true" THEN
        Autoaddvars = true
      ELSEIF b$ = "false" THEN
        Autoaddvars = false
      ELSE : GOTO showcommandsbad
      END IF
    CASE "-emptyifline"
      b$ = LCASE$(getword$(wordtype))
      IF b$ = "true" THEN
        emptyifline = true
      ELSEIF b$ = "false" THEN
        emptyifline = false
      ELSE : GOTO showcommandsbad
      END IF

    CASE "-fpuworkmethod"
      b$ = LCASE$(getword$(wordtype))
      IF b$ = "extended" THEN
        fpuworkmethod = textended
      ELSEIF b$ = "double" THEN
        fpuworkmethod = tdouble
      ELSE : GOTO showcommandsbad
      END IF

    CASE "-tempstringsize"
      b$ = getword$(wordtype)
      IF NOT wordtype = intgr THEN GOTO showcommandsbad
      tmpstringsize = VAL(b$)
    CASE "-stringsize"
      b$ = getword$(wordtype)
      IF NOT wordtype = intgr THEN GOTO showcommandsbad
      stringsize = VAL(b$)

    CASE "-stringblocksize"
      b$ = getword$(wordtype)
      IF NOT wordtype = intgr THEN GOTO showcommandsbad
      stringblocksize = VAL(b$) + 10

    CASE "-stringformat"
      b$ = LCASE$(getword$(wordtype))
      IF b$ = "realvarlenght" THEN
        stringformat = rvarlenght
      ELSEIF b$ = "fakedvarlenght" THEN
        stringformat = varlenght
      ELSEIF b$ = "fixedlenght" THEN
        stringformat = fixedlenght
      ELSE : GOTO showcommandsbad
      END IF

    CASE "-ignorestep"
      b$ = LCASE$(getword$(wordtype))
      IF b$ = "true" THEN
        ignorestep = true
      ELSEIF b$ = "false" THEN
        ignorestep = false
      ELSE : GOTO showcommandsbad
      END IF

    CASE "-platform"
      b$ = LCASE$(getword$(wordtype))
      IF b$ = "win32" THEN
        platform = win32
      ELSEIF b$ = "dos" THEN
        platform = dos
      ELSE : GOTO showcommandsbad
      END IF

    CASE "-maketextwindow"
      b$ = LCASE$(getword$(wordtype))
      IF b$ = "true" THEN
        maketextwindow = true
      ELSEIF b$ = "false" THEN
        maketextwindow = false
      ELSE : GOTO showcommandsbad
      END IF

    CASE "-basfile"
      b$ = getword$(wordtype)
      IF b$ = lineeof THEN GOTO showcommandsbad
      basfile$ = b$
    CASE "-outfile"
      b$ = getword$(wordtype)
      IF b$ = lineeof THEN GOTO showcommandsbad
      outfile$ = b$
  END SELECT
LOOP
ignorenumbertype = 0

IF basfile$ = "" OR outfile$ = "" THEN CLS : GOTO showcommands

PRINT "----- Ultrabasic " + version$
PRINT "Gabriel Fernandez 2001"
PRINT
PRINT "Compiling...."
EXIT SUB

showcommandsbad:
  CLS
  PRINT "Bad command " + a$ + " " + b$
showcommands:
  COLOR 15
  PRINT "----- Ultrabasic " + version$
  PRINT "Gabriel Fernandez 2001"
  PRINT
  PRINT "Usage:"
  COLOR 7
  printclr "  &15Ubasic &07[-help] [-autoaddvars &15true/false&07] [-emptyifline &15true/false&07] "
  printclr "         [-fpuworkmethod &15extended/double&07] [-tempstringsize &15INTn&07] "
  printclr "         [-stringblocksize &15INTn&07] [-ignorestep &15true/false&07] [-stringsize &15INTn&07] "
  printclr "         [-stringformat &15realvarlenght/fakedvarlenght/fixedlenght&07] "
  printclr "         [-platform &15Win32/DOS&07]"
  printclr "         [-maketextwindow &15true/false&07] -basfile &15file&07 -outfile &15file&07"

  PRINT "Example:"
  PRINT "  Ubasic -fpuworkmethod double -platform win32 -stringformat fakedvarlenght "
  PRINT "         -basfile test.bas -outfile test.asm"
  PRINT

  PRINT "Press ESC to quit, other key to read commands descriptions..."
  SLEEP
  IF INKEY$ = CHR$(27) THEN END
  printclr "&15Commands:"
  printclr "&15Help:&07 Display this"
  printclr "&15Autoaddvars:&07 When a variable is not found, if this is true, it will be"
  PRINT "automatically added. Default: TRUE"
  printclr "&15Emptyifline:&07 This allows(if true) to use a if line like this:"
  PRINT "IF myvar THEN, which compare myvar if it is not 0. Default: TRUE"
  printclr "&15Fpuworkmethod:&07 How the Fpu operations should work, using extended or double"
  PRINT "value. I think Double values are faster than extended. Default: DOUBLE"
  printclr "&15Tempstringsize:&07 This is the size of the string temp block. The size is given"
  PRINT "on SHIFT values. Like 1 = 2, 2 = 4, 3 = 8, 4 = 6... Default: 15"
  printclr "&15Stringblocksize:&07 This is the size of the Real variable lenght strings. "
  PRINT "Default: 65545"
  printclr "&15IgnoreStep:&07 If this is false, everytime the STEP of a for instruction dont use"
  PRINT "a fixed value, a warning will be shown. Default: FALSE"
  printclr "&15Stringsize:&07 Standard size for the Faked variable lenght strings. Default: 500"
  printclr "&15Stringformat:&07 Standard string format. Realvarlenght is not recommended because"
  PRINT "it is slow and increase exe size(like 20 bytes per string operation)."
  PRINT "Fixedlenght/Fakedvarlenght are recommended because are a lot faster and don't"
  PRINT "increase exe size. Default: Realvarlenght (because is more compatible)"
  printclr "&15Platform:&07 This is for which OS the exe will be compiled. Win32 = WINDOWS !"
  PRINT "Default: DOS"
  printclr "&15Maketextwindow:&07 If destination OS = win32, enable this to use Print, CLS, ...."
  PRINT "instructions(This create a window to output the screen data). Default: True"
  printclr "&15Basfile:&07 Basfile to compile(must be specified)"
  printclr "&15Outfile:&07 Out asm file(must be specified)"

END

END SUB

FUNCTION Getconsttype (name$, value&, stringvalue$, floatvalue#)

tmp1 = SEEK(8)
tmp2 = SEEK(9)
Getconsttype = -1

SELECT CASE UCASE$(name$)
  CASE "DESTOS", "PLATFORM": Getconsttype = intgr: value& = platform: EXIT FUNCTION
  CASE "DOS32", "DOS": Getconsttype = intgr: value& = dos: EXIT FUNCTION
  CASE "WIN32", "WIN": Getconsttype = intgr: value& = win32: EXIT FUNCTION
END SELECT

IF constcounter = 0 THEN EXIT FUNCTION

FOR i = 0 TO constcounter - 1
  a$ = SPACE$(40)
  GET #8, (i * 48) + 1, a$
  a$ = RTRIM$(a$)

  IF UCASE$(name$) = UCASE$(a$) THEN
    GET #8, , consttype
    GET #8, , extradat
    GET #8, , posc&
    SELECT CASE consttype
      CASE intgr: GET #9, posc&, value&: Getconsttype = intgr
      CASE float: GET #9, posc&, floatvalue#: value& = extradat: Getconsttype = float
      CASE stringtype
        IF i = constcounter - 1 THEN
          tmpsize = LOF(9) - posc&
        ELSE
          GET #8, ((i + 1) * 48) + 1 + 44, tmpposc&
          tmpsize = tmpposc& - posc&
        END IF
        stringvalue$ = SPACE$(tmpsize)
        GET #9, posc&, stringvalue$: Getconsttype = stringtype
    END SELECT
    SEEK 8, tmp1
    SEEK 9, tmp2
    EXIT FUNCTION
  END IF
NEXT i
SEEK 8, tmp1
SEEK 9, tmp2
END FUNCTION

SUB kw.asc (text$)

string.parser text$
dectmp
PRINT #2, "MOV EBX, 0"
PRINT #2, "MOV BL, [EAX+4]"

END SUB

SUB kw.case

IF workselect = -1 THEN show.error 33, ""
PRINT #5, fullcodetext$
PRINT #2, "JMP select" + STR2$(workselect) + "end"
PRINT #2, ";----- CASE -----"
PRINT #2, "select" + STR2$(workselect) + "case" + STR2$(curcase) + ":"
curcase = curcase + 1

END SUB

SUB kw.close
spos = getcharpos
a$ = getword$(wordtype)

IF a$ = lineeof THEN
  PRINT #2, "Call CloseAll"
ELSE
  filenum$ = LTRIM$(MID$(codetext$, spos, LEN(codetext$) - spos + 1))
  filenum$ = ClearFilenum$(filenum$)
  Math.parser filenum$, intgr, 0
  PRINT #2, "CALL CloseFile"
END IF
END SUB

SUB kw.cls
PRINT #2, "CALL CLS"
END SUB

SUB kw.color

a = getarg(0, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)
IF NOT a >= 1 THEN show.error 37, ""

IF a = 1 THEN
  Math.parser arg1$, intgr, 0
  PRINT #2, "MOV [temp], eax"
  PRINT #2, "MOV AL, [screencolor]"
  PRINT #2, "SHR AL, 4"
  PRINT #2, "AND AL, 15"

  PRINT #2, "MOV bx, [temp]"
  PRINT #2, "SHL al, 4"
  PRINT #2, "ADD al, bl"
  PRINT #2, "MOV [screencolor], al"
ELSE
  Math.parser arg1$, intgr, 0
  PRINT #2, "MOV [temp], al"
  Math.parser arg2$, intgr, 0
  PRINT #2, "MOV bx, [temp]"
  PRINT #2, "SHL al, 4"
  PRINT #2, "ADD al, bl"
  PRINT #2, "MOV [screencolor], al"
END IF

END SUB

SUB kw.const

DIM intvalue AS LONG
tmpval = 0

Args = getarg(mode, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)
FOR i = 1 TO Args
  Pushtext Arg$(i)
    name$ = getword$(wordtype)
    t$ = getword$(wordtype)
    IF NOT t$ = "=" THEN show.error 40, "="
    t$ = MID$(codetext$, getcharpos, LEN(codetext$) - (getcharpos - 1))
    IF NOT Getconsttype(name$, value&, stringvalue$, floatvalue#) = -1 THEN show.error 12, name$

    IF LEN(name$) > 40 THEN show.error 41, name$
    IF LEN(name$) < 40 THEN sname$ = name$ + SPACE$(40 - LEN(name$))
    
    PUT #8, , sname$
    ctype = Scanconstline(t$)
    PUT #8, , ctype
    posc& = SEEK(9)
    SELECT CASE ctype
      CASE float
        CMath.parser value#
        PUT #8, , cfloatcounter
        PUT #8, , posc&
        PUT #9, , value#
        a$ = STR$(value#)
        IF NOT INSTR(a$, ".") > 0 THEN a$ = a$ + ".0"
        PRINT #3, "Constfloatval" + STR2$(cfloatcounter) + " DQ " + a$
        cfloatcounter = cfloatcounter + 1
      CASE intgr
        CMath.parser value#
        intvalue = INT(value#)
        PUT #8, , tmpval
        PUT #8, , posc&
        PUT #9, , intvalue
      CASE stringtype
        CString.parser stringt$
        lenght = LEN(stringt$)
        PUT #8, , cstringcounter
        PUT #8, , posc&
        PUT #9, , stringt$
        PRINT #3, "Conststring" + STR2$(cstringcounter) + " DB '" + stringt$ + "'"
        cstringcounter = cstringcounter + 1
    END SELECT

  Poptext
  constcounter = constcounter + 1
NEXT i

END SUB

SUB kw.declare

type$ = UCASE$(getword$(wordtype))

REDIM PRESERVE sub$(globalsub + 1)

IF NOT type$ = "SUB" AND NOT type$ = "FUNCTION" THEN show.error 39, ""

name$ = getword$(wordtype)

IF INSTR(name$, "::") THEN

  FOR i = 0 TO curtype
    IF UCASE$(LEFT$(name$ + " ", INSTR(name$, "::") - 1)) = UCASE$(typename$(i)) THEN

      Object$ = LEFT$(name$ + " ", INSTR(name$, "::") - 1)

      'name$ = RTRIM$(MID$(name$ + "  ", INSTR(name$, "::") + 2))
      EXIT FOR
    END IF
  NEXT
END IF



IF par$ = "" THEN a$ = getword$(wordtype)

Pushtext par$
Args = getarg(1, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)
Poptext

IF Object$ <> "" THEN
'  args = args + 1
'  arg$(args) = Object$
  GetObjects Args, Object$
  arg1$ = Arg$(1)
END IF



OPEN tmpdir$ + "\subd." + STR2$(globalsub) FOR OUTPUT AS #108

IF type$ = "SUB" THEN PRINT #108, "__SUB"

IF type$ = "FUNCTION" THEN
PRINT #108, "__FUNCTION"
t$ = MID$(name$, LEN(name$), 1)

SELECT CASE t$
  CASE "%": var = tinteger
  CASE "&"
    IF MID$(name$, LEN(name$) - 1, 1) = "!" THEN
      var = tlongsingle
    ELSE
      var = tlong
    END IF
  CASE "#": var = tdouble
  CASE "!": var = tsingle
  CASE "@": var = textended
  CASE "$": var = tstring
  CASE "0":
  IF MID$(name$, LEN(name$) - 1, 1) = "$" THEN
    var = tnullstring
  ELSE : var = extracttype(name$)
  END IF
  CASE ELSE: var = extracttype(name$)
END SELECT


PRINT #108, var
END IF

PRINT #108, name$
sub$(globalsub) = name$

IF a$ = "" THEN a$ = getword$(wordtype)
IF UCASE$(a$) = "USEDLL" THEN
  PRINT #108, "_dll"
  PRINT #108, par$
  a$ = getword$(wordtype)
  PRINT #108, a$
END IF

IF UCASE$(a$) = "EXPORT" THEN
  PRINT #108, "_export"
  a$ = getword$(wordtype)
  PRINT #108, a$
END IF


IF Args = 1 AND Arg$(1) = "" THEN PRINT #108, "No args": globalsub = globalsub + 1: CLOSE #108: EXIT SUB

FOR i = 1 TO Args
name$ = clrspc$(Arg$(i))
IF UCASE$(LEFT$(name$, 6)) = "BYREF " THEN svar = 64: name$ = MID$(name$, 7)
IF RIGHT$(name$, 2) = "()" THEN svar = 64: name$ = LEFT$(name$, LEN(name$) - 2)

IF NOT INSTR(UCASE$(name$), " AS ") = 0 THEN
  t$ = RTRIM$(LTRIM$(UCASE$(MID$(name$, INSTR(UCASE$(name$), " AS ") + 4))))
  name$ = LEFT$(name$, INSTR(UCASE$(name$), " AS ") - 1)
  SELECT CASE t$
    CASE "INTEGER": var = tinteger
    CASE "LONG": var = tlong
    CASE "DOUBLE": var = tdouble
    CASE "SINGLE":  var = tsingle
    CASE "BYTE":  var = tbyte
    CASE "STRING", "VLSTRING": var = tstring
    CASE "EXTENDED": var = textended
    CASE ELSE: var = tlong: svar = 64
  END SELECT
ELSE
  t$ = MID$(name$, LEN(name$), 1)
  SELECT CASE t$
    CASE "%": var = tinteger
    CASE "&"
      IF MID$(name$, LEN(name$) - 1, 1) = "!" THEN
        var = tlongsingle
      ELSE
        var = tlong
      END IF
    CASE "#": var = tdouble
    CASE "!": var = tsingle
    CASE "@": var = textended
    CASE "$": var = tstring
    CASE "0":
    IF MID$(name$, LEN(name$) - 1, 1) = "$" THEN
      var = tnullstring
    ELSE : var = extracttype(name$)
    END IF
    CASE ELSE
      IF LEFT$(name$, 1) = ")" THEN var = 0 ELSE var = extracttype(name$)
  END SELECT
END IF
var = var + svar
svar = 0


PRINT #108, "_Par"
PRINT #108, var

NEXT i

PRINT #108, "_End"
CLOSE #108

globalsub = globalsub + 1
END SUB

SUB kw.do

PUSH workdo
workdo = curdo
a$ = UCASE$(getword$(wordtype))
PRINT #2, "dolabel" + STR2$(workdo) + ":"

IF a$ = "WHILE" OR a$ = "UNTIL" THEN

IF a$ = "WHILE" THEN dotype = 1
IF a$ = "UNTIL" THEN dotype = 2
DIM cond$(40)
DIM un(40)
DIM unnot(40)

strg = false

printc codetext$

checkfornot = 3
a$ = ""
DO WHILE NOT endloop = true
  f$ = e$
  e$ = d$
  d$ = c$
  c$ = b$
  b$ = a$
  a$ = getchar$
  t$ = t$ + c$

  IF a$ = CHR$(34) THEN
    IF strg = true THEN
      strg = false
    ELSE
      strg = true
      checkfornot = 0
    END IF
  END IF

  IF strg = true THEN GOTO label49

  IF a$ = lineeof THEN
    cond$(curcond) = clrspc$(t$ + b$)
    unnot(curcond) = curunnot
    maxcond = curcond
    EXIT DO
  END IF

  IF checkfornot >= 0 THEN
  IF UCASE$(c$ + b$ + a$) = "NOT" THEN
    t$ = ""
    c$ = "": b$ = "": a$ = ""
    curunnot = true
  END IF
  END IF

  IF NOT a$ = CHR$(32) AND NOT a$ = CHR$(9) THEN
    IF checkfornot > 0 THEN checkfornot = checkfornot - 1
  END IF

  IF c$ = CHR$(32) OR c$ = CHR$(9) THEN
  IF a$ = CHR$(32) OR a$ = CHR$(9) THEN
    IF b$ = "&" THEN
      cond$(curcond) = clrspc$(t$)
      un(curcond + 1) = condand
      unnot(curcond) = curunnot
      curunnot = false
      curcond = curcond + 1
      checkfornot = 4
      t$ = "": c$ = "": b$ = ""
    ELSEIF b$ = "|" THEN
      maxor = maxor + 1
      cond$(curcond) = clrspc$(t$)
      un(curcond + 1) = condor
      unnot(curcond) = curunnot
      curunnot = false
      curcond = curcond + 1
      checkfornot = 4
      t$ = "": c$ = "": b$ = ""
    END IF
  END IF
  END IF
label49:
LOOP

curor = 0
FOR i = 0 TO maxcond
 getconditions cond$(i), a$, b$, cond$
 IF b$ = "" THEN b$ = "0": cond$ = "<>"
 useor = un(i)
 cnot = unnot(i)

 IF useor = condor THEN
   IF dotype = 1 THEN PRINT #2, "JMP DO" + STR2$(workdo) + "code"
   IF dotype = 2 THEN PRINT #2, "JMP DO" + STR2$(workdo) + "end"
   PRINT #2, "doOR" + STR2$(workdo) + "label" + STR2$(curor) + ":"
   curor = curor + 1
 END IF

 a = getoptype(a$)
 b = getoptype(b$)

 IF NOT a = b THEN show.error 27, ""

   IF dotype = 2 THEN
   IF NOT maxor = 0 THEN
    IF curor < maxor THEN
     jmplabel$ = "doOR" + STR2$(workdo) + "label" + STR2$(curor)
    ELSE
     jmplabel$ = "DO" + STR2$(workdo) + "code"
    END IF
   ELSE : jmplabel$ = "DO" + STR2$(workdo) + "code"
   END IF
   ELSE
   IF NOT maxor = 0 THEN
    IF curor < maxor THEN
     jmplabel$ = "doOR" + STR2$(workdo) + "label" + STR2$(curor)
    ELSE
     jmplabel$ = "DO" + STR2$(workdo) + "end"
    END IF
   ELSE : jmplabel$ = "DO" + STR2$(workdo) + "end"
   END IF

   END IF
 
 IF a = mathop THEN
   c = Scanline(a$, changepos)
   d = Scanline(b$, changepos)
   IF c = float OR d = float THEN     ' FLOAT
     printc cond$(i)
     Math.parser a$, skip, 0
     IF fpuworkmethod = textended THEN
       PRINT #2, "FSTP TWORD [tmpfpuvar4]"
     ELSE : PRINT #2, "FSTP QWORD [tmpfpuvar4]"
     END IF
     Math.parser b$, skip, 0

     IF fpuworkmethod = textended THEN
       PRINT #2, "FLD TWORD [tmpfpuvar4]"
     ELSE : PRINT #2, "FLD QWORD [tmpfpuvar4]"
     END IF

     PRINT #2, "FCOMPP"
     PRINT #2, "FSTSW AX"
     PRINT #2, "SAHF"

   SELECT CASE cond$
     CASE "=", "=="
       IF cnot = false THEN
         PRINT #2, "JNE " + jmplabel$
       ELSE : PRINT #2, "JE " + jmplabel$
       END IF
     CASE ">"
       IF cnot = false THEN
         PRINT #2, "JNA " + jmplabel$
       ELSE : PRINT #2, "JA " + jmplabel$
       END IF
     CASE "<"
       IF cnot = false THEN
         PRINT #2, "JNB " + jmplabel$
       ELSE : PRINT #2, "JB " + jmplabel$
       END IF
     CASE "=>", ">="
       IF cnot = false THEN
         PRINT #2, "JNAE " + jmplabel$
       ELSE : PRINT #2, "JAE " + jmplabel$
       END IF
     CASE "=<", "<="
       IF cnot = false THEN
         PRINT #2, "JNBE " + jmplabel$
       ELSE : PRINT #2, "JBE " + jmplabel$
       END IF
     CASE "<>", "><"
       IF cnot = false THEN
         PRINT #2, "JE " + jmplabel$
       ELSE : PRINT #2, "JNE " + jmplabel$
       END IF
     END SELECT
   ELSE                               ' INTEGER
     printc cond$(i)
     Math.parser a$, intgr, 0
     PRINT #2, "PUSH EAX"
     Math.parser b$, intgr, 0
     PRINT #2, "POP EBX"
     PRINT #2, "CMP EBX, EAX"

   SELECT CASE cond$
     CASE "=", "=="
       IF cnot = false THEN
         PRINT #2, "JNE " + jmplabel$
       ELSE : PRINT #2, "JE " + jmplabel$
       END IF
     CASE ">"
       IF cnot = false THEN
         PRINT #2, "JNG " + jmplabel$
       ELSE : PRINT #2, "JG " + jmplabel$
       END IF
     CASE "<"
       IF cnot = false THEN
         PRINT #2, "JNL " + jmplabel$
       ELSE : PRINT #2, "JL " + jmplabel$
       END IF
     CASE "=>", ">="
       IF cnot = false THEN
         PRINT #2, "JNGE " + jmplabel$
       ELSE : PRINT #2, "JGE " + jmplabel$
       END IF
     CASE "=<", "<="
       IF cnot = false THEN
         PRINT #2, "JNLE " + jmplabel$
       ELSE : PRINT #2, "JLE " + jmplabel$
       END IF
     CASE "<>", "><"
       IF cnot = false THEN
         PRINT #2, "JE " + jmplabel$
       ELSE : PRINT #2, "JNE " + jmplabel$
       END IF
     END SELECT

   END IF
 ELSE    ' STRING
   printc cond$(i)

   string.parser a$
   string.parser b$

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

   PRINT #2, "MOV EBX, [curtmpblock]"
   PRINT #2, "SHL EBX, " + STR$(tmpstringsize)
   PRINT #2, "ADD EBX, [tmpblockoffset]"
   dectmp
   dectmp
   PRINT #2, "CALL CmpStrings"
   PRINT #2, "CMP EAX, 1"

   IF cnot = false THEN
     PRINT #2, "JNE " + jmplabel$
   ELSE
     PRINT #2, "JE " + jmplabel$
   END IF
 END IF

NEXT i

END IF

IF dotype = 2 THEN PRINT #2, "JMP DO" + STR2$(workdo) + "end"
PRINT #2, "DO" + STR2$(workdo) + "code:"
curdo = curdo + 1
END SUB

SUB kw.else

PRINT #2, "JMP ENDIF" + STR2$(workif)
PRINT #2, "ELSE" + STR2$(workif) + "label" + STR2$(curelse) + ":"

curelse = curelse + 1

END SUB

SUB kw.elseif

PRINT #2, "JMP ENDIF" + STR2$(workif)
PRINT #2, "ELSE" + STR2$(workif) + "label" + STR2$(curelse) + ":"

curelse = curelse + 1
CND.IF curelse

END SUB

SUB kw.endif

PRINT #2, "ELSE" + STR2$(workif) + "label" + STR2$(curelse) + ":"
PRINT #2, "ENDIF" + STR2$(workif) + ":"

POP curelse
POP workif

END SUB

SUB kw.endsub

IF SubStringOffset < 0 THEN SubStringOffset = 0
PRINT #7, cursubvarmem
PRINT #7, cursubstringmem
PRINT #7, SubStringOffset
tmp = cursubstringmem

REDIM substringsn$(1)
REDIM substrings(1) AS LONG

PRINT #2, "endsub" + STR2$(cursub) + ":"
IF functiontype = tstring THEN
  string.parser funcname$
  PRINT #2, "MOV [funceax], EAX"
END IF
cursubstringmem = 0
cursubstring = 0

IF NOT tmp = 0 THEN
  'PRINT #2, "CMP DWORD [subfixedstringblockhandle], 0"
  PRINT #2, "CMP DWORD [ESI +" + STR2$(SubStringOffset) + "+4], 0"
  PRINT #2, "JE NEAR Skipfixedstringblock" + STR2$(cursub)

IF platform = dos THEN
  'PRINT #2, "MOV SI, [subfixedstringblockhandle]"
  'PRINT #2, "MOV DI, [subfixedstringblockhandle+2]"
  PRINT #2, "MOV SI, [ESI +" + STR2$(SubStringOffset) + "+4]"
  PRINT #2, "MOV DI, [ESI +" + STR2$(SubStringOffset) + "+6]"
ELSE
  PRINT #2, "MOV EBX, [ESI +" + STR2$(SubStringOffset) + "+4]"
END IF

PRINT #2, "Call NEAR FreeBlock"
PRINT #2, "Skipfixedstringblock" + STR2$(cursub) + ":"
IF platform = dos AND functiontype <> 0 THEN PRINT #2, "MOV ESI, ESP"

  Popedi = true
END IF

' ----------- Liberar Matrices numericas

FOR i = 0 TO cursubarray - 1
IF subextraarraydata(i) > 0 THEN
  'PRINT #2, "CMP DWORD [subArrayHandle" + LTRIM$(STR$(i)) + "], 0"
  PRINT #2, "CMP DWORD [ESI +" + LTRIM$(STR$(subextraarraydata(i) + 4)) + "], 0"
  PRINT #2, "JE NEAR sub" + STR2$(cursub) + "SkipAfree" + LTRIM$(STR$(i))

IF platform = dos THEN
  'PRINT #2, "MOV SI, [subArrayHandle" + LTRIM$(STR$(i)) + "]"
  'PRINT #2, "MOV DI, [subArrayHandle" + LTRIM$(STR$(i)) + "+2]"
  PRINT #2, "MOV SI, [ESI+" + LTRIM$(STR$(subextraarraydata(i))) + "+4]"
  PRINT #2, "MOV DI, [ESI+" + LTRIM$(STR$(subextraarraydata(i))) + "+6]"
ELSE
  'PRINT #2, "MOV EBX, [ESI+" + LTRIM$(STR$(subextraarraydata(i))) + "+4]"
END IF

  PRINT #2, "Call NEAR FreeBlock"
  PRINT #2, "sub" + STR2$(cursub) + "SkipAfree" + LTRIM$(STR$(i)) + ":"
  IF platform = dos AND functiontype <> 0 THEN PRINT #2, "MOV ESI, ESP"
  Popedi = true
END IF
NEXT i

REDIM subextraarraydata(1)' AS STRING * 1
REDIM subarray$(1)
cursubarray = 0

' ----------- Liberar Matrices de Cadenas

FOR i = 0 TO cursubstringarray - 1
  PRINT #2, "CMP DWORD [ESI+" + LTRIM$(STR$(substringarraysextra(i) + 4)) + "], 0"
  PRINT #2, "JE NEAR Skipsub" + STR2$(cursub) + "SAfree" + LTRIM$(STR$(i))

IF platform = dos THEN
  'PRINT #2, "MOV SI, [SubStringHandle" + LTRIM$(STR$(i)) + "]"
  'PRINT #2, "MOV DI, [SubStringHandle" + LTRIM$(STR$(i)) + "+2]"
  PRINT #2, "MOV SI, [ESI+" + LTRIM$(STR$(substringarraysextra(i) + 4)) + "]"
  PRINT #2, "MOV DI, [ESI+" + LTRIM$(STR$(substringarraysextra(i) + 6)) + "]"
ELSE
  'PRINT #2, "MOV EBX, [SubStringHandle" + LTRIM$(STR$(i)) + "]"
  PRINT #2, "MOV EBX, [ESI+" + LTRIM$(STR$(substringarraysextra(i) + 4)) + "]"
END IF

  PRINT #2, "Call NEAR FreeBlock"
  PRINT #2, "Skipsub" + STR2$(cursub) + "SAfree" + LTRIM$(STR$(i)) + ":"
  IF platform = dos AND functiontype <> 0 THEN PRINT #2, "MOV ESI, ESP"
  Popedi = true
NEXT i

REDIM substringarray$(1)
REDIM substringarrays(1) AS LONG
cursubstringarray = 0

IF Popedi = true THEN PRINT #2, "MOV EDI, [varedi]"

SELECT CASE functiontype
  CASE tinteger, tbyte, tlong: Getvarvalue funcname$, 0, "", leavevalue, gotvartype
  CASE textended, tdouble, tsingle: Getvarvalue funcname$, 0, "", leavemem, gotvartype': BEEP
END SELECT

PRINT #2, "_END SUB_"

IF functiontype = tstring THEN PRINT #2, "MOV EAX, [funceax]"

IF subpars = 0 THEN
   PRINT #2, "RET"
ELSE : PRINT #2, "RETN " + STR2$(subpars)
END IF

cursubvarmem = 0
cursubvar = 0
REDIM subvariable$(1)
REDIM subvariables(1) AS LONG
avoidfunc$ = ""
cursub = cursub + 1
END SUB

SUB kw.exit
a$ = UCASE$(getword$(wordtype))
IF a$ = "FOR" THEN
  PRINT #2, "JMP forend" + STR2$(workfor)
ELSEIF a$ = "DO" THEN
  PRINT #2, "JMP DO" + STR2$(workdo) + "end"
ELSEIF a$ = "SUB" OR a$ = "FUNCTION" THEN
  PRINT #2, "JMP endsub" + STR2$(cursub)
ELSE : show.error 34, ""
END IF
END SUB

SUB kw.filegetput (mode)
printc "****** READ/WRITE DATA FROM FILE (GET/PUT) ******"

Args = getarg(0, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)

arg1$ = ClearFilenum$(LTRIM$(arg1$))
arg2$ = clrspc$(arg2$)

IF NOT Args >= 3 THEN show.error 37, ""

Math.parser arg1$, intgr, 0
PRINT #2, "MOV [filetmp], EAX"

IF NOT arg2$ = "" THEN
  Math.parser arg2$, intgr, 0
  PRINT #2, "MOV EBX, EAX"
  PRINT #2, "MOV EAX, [filetmp]"
  PRINT #2, "CALL Setfilepos"
END IF

IF mode = fget THEN call$ = "CALL FileGet"
IF mode = fput THEN call$ = "CALL FilePut"

IF Args = 3 THEN       ' ------ Sin especificar el tama¤o
  par$ = arg3$
  SELECT CASE kw.varptr
     CASE tbyte: PRINT #2, "MOV ECX, 1": PRINT #2, "MOV EBX, EAX"
     CASE tinteger: PRINT #2, "MOV ECX, 2": PRINT #2, "MOV EBX, EAX"
     CASE tlong: PRINT #2, "MOV ECX, 4": PRINT #2, "MOV EBX, EAX"
     CASE tsingle: PRINT #2, "MOV ECX, 4": PRINT #2, "MOV EBX, EAX"
     CASE tdouble: PRINT #2, "MOV ECX, 8": PRINT #2, "MOV EBX, EAX"
     CASE textended: PRINT #2, "MOV ECX, 10": PRINT #2, "MOV EBX, EAX"
     CASE tstring: PRINT #2, "XCHG ECX, EBX"
  END SELECT

  PRINT #2, "MOV EAX, [filetmp]"
  PRINT #2, call$
ELSE
  Math.parser arg4$, intgr, 0
  PRINT #2, "PUSH EAX"
  Math.parser arg3$, intgr, 0
  PRINT #2, "MOV ECX, EAX"
  PRINT #2, "POP EBX"
  PRINT #2, "MOV EAX, [filetmp]"
  PRINT #2, call$
END IF

END SUB

SUB kw.for
  loop.for
END SUB

SUB kw.fval (text$)
string.parser text$
dectmp
IF insidesub THEN PRINT #2, "PUSH ESI"
PRINT #2, "MOV EBX, EAX"
PRINT #2, "CALL NEAR FVal"
PRINT #2, "MOV EDI, [varedi]"
IF insidesub THEN PRINT #2, "POP ESI"

END SUB

SUB kw.gosub
  a$ = getword$(wordtype)
  IF wordtype = intgr THEN wordtype = normal
  IF a$ = lineeof OR NOT wordtype = normal THEN show.error 29, ""
  PRINT #2, "CALL ubprog_" + LCASE$(a$)
END SUB

SUB kw.goto
   a$ = getword$(wordtype)
   IF wordtype = intgr THEN wordtype = normal
   IF a$ = lineeof OR NOT wordtype = normal THEN show.error 29, ""
   PRINT #2, "JMP ubprog_" + LCASE$(a$)
END SUB

SUB kw.if

PUSH workif
PUSH curelse

curelse = 0
workif = curif

CND.IF curelse

curif = curif + 1
END SUB

SUB kw.incdec (mode)
  name$ = getword$(wordtype)
  a = sexist(name$, i, typeblock$, mempos&, varshared)
  IF a = -1 THEN show.error 15, name$

  SELECT CASE a
    CASE tbyte, tinteger, tlong
    IF spar$ = "" THEN
      Getvarvalue name$, 1, typeobj$, leavevalue, gotvartype
      IF mode = dec THEN PRINT #2, "DEC EAX"
      IF mode = add THEN PRINT #2, "INC EAX"
      Getvarvalue name$, 1, typeobj$, leavemem2, gotvartype
    END IF
    EXIT SUB
    CASE tsingle, tdouble, textended
      par$ = spar$
      Getvarvalue name$, 1, typeobj$, leavemem, gotvartype

      PRINT #2, "FLD QWORD [incdecval]"

      IF gotvartype = tsingle THEN
        PRINT #2, "FLD DWORD [EAX]"
      ELSEIF gotvartype = tdouble THEN
        PRINT #2, "FLD QWORD [EAX]"
      ELSE : PRINT #2, "FLD TWORD [EAX]"
      END IF

      IF mode = dec THEN PRINT #2, "FSUB st1"
      IF mode = add THEN PRINT #2, "FADD st1"

      IF gotvartype = tsingle THEN
        PRINT #2, "FSTP DWORD [EAX]"
      ELSEIF gotvartype = tdouble THEN
        PRINT #2, "FSTP QWORD [EAX]"
      ELSE : PRINT #2, "FSTP TWORD [EAX]"
      END IF

      PRINT #2, "FFREE st0"
    EXIT SUB
  END SELECT

END SUB

SUB kw.inp (size, curop)

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

Math.parser par$, intgr, 0

SELECT CASE size
  CASE tbyte: PRINT #2, "MOV AL, DX"
  CASE tinteger: PRINT #2, "MOV AX, DX"
  CASE tlong: PRINT #2, "MOV EAX, DX"
END SELECT

IF curop = 2 THEN
  PRINT #2, "MOV EBX, EAX"
  PRINT #2, "POP EAX"
END IF

END SUB

SUB kw.int (extended)
Dosfunction

n = getarg(0, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)
IF arg1$ = "" OR arg2$ = "" THEN show.error 37, ""

IF insidesub THEN PRINT #2, "PUSH ESI"

Math.parser arg1$, intgr, 0
PRINT #2, "MOV BL, AL"
PRINT #2, "MOV EAX, 0204h"
PRINT #2, "INT 31h"
PRINT #2, "MOV [intoffset+4], CX"
PRINT #2, "MOV [intoffset], EDX"
Math.parser arg2$, intgr, 0

PRINT #2, "MOV EBX, [EAX]"
PRINT #2, "MOV ECX, [EAX+8]"
PRINT #2, "MOV EDX, [EAX+12]"
IF extended THEN
  PRINT #2, "MOV ESI, [EAX+16]"
  PRINT #2, "MOV EDI, [EAX+20]"
END IF

PRINT #2, "PUSH EBX"
PRINT #2, "MOV EBX, [EAX+4]"
PRINT #2, "POP EAX"

PRINT #2, "PUSHFD"
PRINT #2, "CLI"
PRINT #2, "CALL DWORD FAR [intoffset]"

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

SUB kw.int16
Dosfunction

n = getarg(0, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)
IF arg1$ = "" OR arg2$ = "" THEN show.error 37, ""

IF insidesub THEN PRINT #2, "PUSH ESI"

Math.parser arg1$, intgr, 0
PRINT #2, "PUSH EAX"
Math.parser arg2$, intgr, 0
PRINT #2, "POP EBX"
PRINT #2, "MOV EDI, EAX"
PRINT #2, "MOV AX, 0300h"
PRINT #2, "MOV BH, 0"
PRINT #2, "MOV ECX, 0"
PRINT #2, "INT 31h"

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

SUB kw.len (text$)

string.parser text$
dectmp

END SUB

SUB kw.locate

a = getarg(0, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)
IF NOT a = 2 THEN show.error 37, ""

Math.parser arg1$, intgr, 0
PRINT #2, "MOV [texty], ax"
Math.parser arg2$, intgr, 0
PRINT #2, "MOV [textx], ax"

END SUB

SUB kw.loop

a$ = UCASE$(getword$(wordtype))

IF a$ = "WHILE" OR a$ = "UNTIL" THEN

IF a$ = "WHILE" THEN dotype = 1
IF a$ = "UNTIL" THEN dotype = 2
DIM cond$(40)
DIM un(40)
DIM unnot(40)

strg = false

printc codetext$

checkfornot = 3
a$ = ""
DO WHILE NOT endloop = true
  f$ = e$
  e$ = d$
  d$ = c$
  c$ = b$
  b$ = a$
  a$ = getchar$
  t$ = t$ + c$

  IF a$ = CHR$(34) THEN
    IF strg = true THEN
      strg = false
    ELSE
      strg = true
      checkfornot = 0
    END IF
  END IF

  IF strg = true THEN GOTO label50

  IF a$ = lineeof THEN
    cond$(curcond) = clrspc$(t$ + b$)
    unnot(curcond) = curunnot
    maxcond = curcond
    EXIT DO
  END IF

  IF checkfornot >= 0 THEN
  IF UCASE$(c$ + b$ + a$) = "NOT" THEN
    t$ = ""
    c$ = "": b$ = "": a$ = ""
    curunnot = true
  END IF
  END IF

  IF NOT a$ = CHR$(32) AND NOT a$ = CHR$(9) THEN
    IF checkfornot > 0 THEN checkfornot = checkfornot - 1
  END IF

  IF c$ = CHR$(32) OR c$ = CHR$(9) THEN
  IF a$ = CHR$(32) OR a$ = CHR$(9) THEN
    IF b$ = "&" THEN
      cond$(curcond) = clrspc$(t$)
      un(curcond + 1) = condand
      unnot(curcond) = curunnot
      curunnot = false
      curcond = curcond + 1
      checkfornot = 4
      t$ = "": c$ = "": b$ = ""
    ELSEIF b$ = "|" THEN
      maxor = maxor + 1
      cond$(curcond) = clrspc$(t$)
      un(curcond + 1) = condor
      unnot(curcond) = curunnot
      curunnot = false
      curcond = curcond + 1
      checkfornot = 4
      t$ = "": c$ = "": b$ = ""
    END IF
  END IF
  END IF
label50:
LOOP

curor = 0
FOR i = 0 TO maxcond
 getconditions cond$(i), a$, b$, cond$
 IF b$ = "" THEN b$ = "0": cond$ = "<>"
 useor = un(i)
 cnot = unnot(i)

 IF useor = condor THEN
   IF dotype = 1 THEN PRINT #2, "JMP DO" + STR2$(workdo) + "code"
   IF dotype = 2 THEN PRINT #2, "JMP DO" + STR2$(workdo) + "end"
   PRINT #2, "doOR" + STR2$(workdo) + "label" + STR2$(curor) + ":"
   curor = curor + 1
 END IF

 a = getoptype(a$)
 b = getoptype(b$)

 IF NOT a = b THEN show.error 27, ""

   IF dotype = 2 THEN
   IF NOT maxor = 0 THEN
    IF curor < maxor THEN
     jmplabel$ = "doOR" + STR2$(workdo) + "label" + STR2$(curor)
    ELSE
     jmplabel$ = "DO" + STR2$(workdo) + "code"
    END IF
   ELSE : jmplabel$ = "DO" + STR2$(workdo) + "code"
   END IF
   ELSE
   IF NOT maxor = 0 THEN
    IF curor < maxor THEN
     jmplabel$ = "doOR" + STR2$(workdo) + "label" + STR2$(curor)
    ELSE
     jmplabel$ = "DO" + STR2$(workdo) + "end"
    END IF
   ELSE : jmplabel$ = "DO" + STR2$(workdo) + "end"
   END IF

   END IF

 IF a = mathop THEN
   c = Scanline(a$, changepos)
   d = Scanline(b$, changepos)
   IF c = float OR d = float THEN     ' FLOAT
     printc cond$(i)
     Math.parser a$, skip, 0
     IF fpuworkmethod = textended THEN
       PRINT #2, "FSTP TWORD [tmpfpuvar4]"
     ELSE : PRINT #2, "FSTP QWORD [tmpfpuvar4]"
     END IF
     Math.parser b$, skip, 0

     IF fpuworkmethod = textended THEN
       PRINT #2, "FLD TWORD [tmpfpuvar4]"
     ELSE : PRINT #2, "FLD QWORD [tmpfpuvar4]"
     END IF

     PRINT #2, "FCOMPP"
     PRINT #2, "FSTSW AX"
     PRINT #2, "SAHF"

   SELECT CASE cond$
     CASE "=", "=="
       IF cnot = false THEN
         PRINT #2, "JNE " + jmplabel$
       ELSE : PRINT #2, "JE " + jmplabel$
       END IF
     CASE ">"
       IF cnot = false THEN
         PRINT #2, "JNA " + jmplabel$
       ELSE : PRINT #2, "JA " + jmplabel$
       END IF
     CASE "<"
       IF cnot = false THEN
         PRINT #2, "JNB " + jmplabel$
       ELSE : PRINT #2, "JB " + jmplabel$
       END IF
     CASE "=>", ">="
       IF cnot = false THEN
         PRINT #2, "JNAE " + jmplabel$
       ELSE : PRINT #2, "JAE " + jmplabel$
       END IF
     CASE "=<", "<="
       IF cnot = false THEN
         PRINT #2, "JNBE " + jmplabel$
       ELSE : PRINT #2, "JBE " + jmplabel$
       END IF
     CASE "<>", "><"
       IF cnot = false THEN
         PRINT #2, "JE " + jmplabel$
       ELSE : PRINT #2, "JNE " + jmplabel$
       END IF
     END SELECT
   ELSE                               ' INTEGER
     printc cond$(i)
     Math.parser a$, intgr, 0
     PRINT #2, "PUSH EAX"
     Math.parser b$, intgr, 0
     PRINT #2, "POP EBX"
     PRINT #2, "CMP EBX, EAX"

   SELECT CASE cond$
     CASE "=", "=="
       IF cnot = false THEN
         PRINT #2, "JNE " + jmplabel$
       ELSE : PRINT #2, "JE " + jmplabel$
       END IF
     CASE ">"
       IF cnot = false THEN
         PRINT #2, "JNG " + jmplabel$
       ELSE : PRINT #2, "JG " + jmplabel$
       END IF
     CASE "<"
       IF cnot = false THEN
         PRINT #2, "JNL " + jmplabel$
       ELSE : PRINT #2, "JL " + jmplabel$
       END IF
     CASE "=>", ">="
       IF cnot = false THEN
         PRINT #2, "JNGE " + jmplabel$
       ELSE : PRINT #2, "JGE " + jmplabel$
       END IF
     CASE "=<", "<="
       IF cnot = false THEN
         PRINT #2, "JNLE " + jmplabel$
       ELSE : PRINT #2, "JLE " + jmplabel$
       END IF
     CASE "<>", "><"
       IF cnot = false THEN
         PRINT #2, "JE " + jmplabel$
       ELSE : PRINT #2, "JNE " + jmplabel$
       END IF
     END SELECT

   END IF
 ELSE    ' STRING
   printc cond$(i)

   string.parser a$
   string.parser b$

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

   PRINT #2, "MOV EBX, [curtmpblock]"
   PRINT #2, "SHL EBX, " + STR$(tmpstringsize)
   PRINT #2, "ADD EBX, [tmpblockoffset]"
   dectmp
   dectmp
   PRINT #2, "CALL CmpStrings"
   PRINT #2, "CMP EAX, 1"

   IF cnot = false THEN
     PRINT #2, "JNE " + jmplabel$
   ELSE
     PRINT #2, "JE " + jmplabel$
   END IF
 END IF

NEXT i

END IF

PRINT #2, "JMP dolabel" + STR2$(workdo)
PRINT #2, "DO" + STR2$(workdo) + "end:"
POP workdo

END SUB

SUB kw.lptr (mode)

IF mode = 2 THEN
  PRINT #2, "MOV EBX, ubprog_" + LCASE$(clrspc$(par$))
ELSE
  PRINT #2, "MOV EAX, ubprog_" + LCASE$(clrspc$(par$))
END IF

END SUB

SUB kw.lucase (text$, mode)

PRINT #2, "PUSH EAX"
string.parser text$
PRINT #2, "MOV EBX, EAX"
PRINT #2, "POP EAX"
IF mode = 1 THEN PRINT #2, "CALL Lcase$"
IF mode = 2 THEN PRINT #2, "CALL Ucase$"
dectmp

END SUB

SUB kw.memcopy (size, mode)
n = getarg(0, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)

IF arg1$ = "" OR arg2$ = "" OR arg3$ = "" THEN show.error 37, ""

IF mode = 1 THEN t$ = "MOVS"
IF mode = 2 THEN t$ = "STOS"

SELECT CASE size
  CASE tbyte: MOV$ = t$ + "B"
  CASE tinteger: MOV$ = t$ + "W"
  CASE tlong: MOV$ = t$ + "D"
END SELECT

IF mode = 1 THEN
  Math.parser arg1$, intgr, 0
  PRINT #2, "PUSH EAX"
  Math.parser arg2$, intgr, 0
  PRINT #2, "PUSH EAX"
  Math.parser arg3$, intgr, 0
  PRINT #2, "MOV ECX, EAX"

  IF insidesub THEN PRINT #2, "MOV [push4], ESI"

  PRINT #2, "POP EDI"
  PRINT #2, "POP ESI"
ELSE
  Math.parser arg1$, intgr, 0
  PRINT #2, "PUSH EAX"
  Math.parser arg3$, intgr, 0
  PRINT #2, "PUSH EAX"
  Math.parser arg2$, intgr, 0
  PRINT #2, "POP ECX"

  IF insidesub THEN PRINT #2, "MOV [push4], ESI"

  PRINT #2, "POP EDI"
END IF

PRINT #2, "CLD"
PRINT #2, "REP " + MOV$

PRINT #2, "MOV EDI, [varedi]"
IF insidesub THEN PRINT #2, "MOV ESI, [push4]"

END SUB

SUB kw.mid
Pushtext par$
Args = getarg(0, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)
Poptext
Checkargs Args, 3

PRINT #2, "PUSH EAX"
Math.parser arg2$, intgr, 0
PRINT #2, "PUSH EAX"
Math.parser arg3$, intgr, 0
PRINT #2, "PUSH EAX"
string.parser arg1$
PRINT #2, "MOV ECX, EAX"
PRINT #2, "POP EBX"
PRINT #2, "POP EDX"
PRINT #2, "ADD ECX, 4"
PRINT #2, "ADD ECX, EDX"
PRINT #2, "POP EAX"
PRINT #2, "CALL copytostring"
END SUB

SUB kw.next

printc "Next"
var$ = forvar$

IF fortype = intgr THEN
  Getvarvalue var$, current, typeobj$, leavemem, gotvartype

  SELECT CASE gotvartype
    CASE tbyte: PRINT #2, "MOV EBX, 0": PRINT #2, "MOV BL, [EAX]"
    CASE tinteger: PRINT #2, "MOV EBX, 0": PRINT #2, "MOV BX, [EAX]"
    CASE tlong: PRINT #2, "MOV EBX, [EAX]"
    CASE tsingle: PRINT #2, "FLD DWORD [EAX]": PRINT #2, "FISTP DWORD [temp]": PRINT #2, "MOV EBX, [temp]"
    CASE tdouble: PRINT #2, "FLD QWORD [EAX]": PRINT #2, "FISTP DWORD [temp]": PRINT #2, "MOV EBX, [temp]"
    CASE textended: PRINT #2, "FLD TWORD [EAX]": PRINT #2, "FISTP DWORD [temp]": PRINT #2, "MOV EBX, [temp]"
  END SELECT

  ' PRINT #2, "MOV EBX, [EAX]"
  PRINT #2, "MOV ECX, [EAX]"
  PRINT #2, "MOV EDX, [FOR" + STR2$(workfor) + "STEP]"

  IF stepsign = neg THEN
    PRINT #2, "SUB ECX, EDX"
  ELSE
    PRINT #2, "ADD ECX, EDX"
  END IF

  SELECT CASE gotvartype
    CASE tbyte: PRINT #2, "MOV [EAX], CL"
    CASE tinteger: PRINT #2, "MOV [EAX], CX"
    CASE tlong: PRINT #2, "MOV [EAX], ECX"
    CASE tsingle: PRINT #2, "MOV [temp], ECX": PRINT #2, "FILD DWORD [temp]": PRINT #2, "FSTP DWORD [EAX]"
    CASE tdouble: PRINT #2, "MOV [temp], ECX": PRINT #2, "FILD DWORD [temp]": PRINT #2, "FSTP QWORD [EAX]"
    CASE textended: PRINT #2, "MOV [temp], ECX": PRINT #2, "FILD DWORD [temp]": PRINT #2, "FSTP TWORD [EAX]"
  END SELECT

  PRINT #2, "CMP EBX, [FOR" + STR2$(workfor) + "END]"
  IF stepsign = neg THEN
    PRINT #2, "JNLE forloop" + STR2$(workfor)
  ELSE : PRINT #2, "JNGE forloop" + STR2$(workfor)
  END IF
ELSE
  Getvarvalue var$, current, typeobj$, leavemem, gotvartype
  PRINT #2, "MOV EBX, EAX"

  SELECT CASE gotvartype
    CASE tbyte:
      PRINT #2, "MOV ECX, 0"
      PRINT #2, "MOV CL, [EAX]"
      PRINT #2, "MOV [temp], ECX"
      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

  PRINT #2, "FCOM QWORD [FOR" + STR2$(workfor) + "END]"
  PRINT #2, "FSTSW AX"
  PRINT #2, "FADD QWORD [FOR" + STR2$(workfor) + "STEP]"
  
  SELECT CASE gotvartype
    CASE tbyte:
      PRINT #2, "MOV ECX, temp"
      PRINT #2, "FISTP DWORD [ECX]"
      PRINT #2, "MOV [EAX], CL"
    CASE tinteger: PRINT #2, "FISTP WORD [EBX]"
    CASE tlong: PRINT #2, "FISTP DWORD [EBX]"
    CASE tsingle: PRINT #2, "FSTP DWORD [EBX]"
    CASE tdouble: PRINT #2, "FSTP QWORD [EBX]"
    CASE textended: PRINT #2, "FSTP TWORD [EBX]"
  END SELECT
  
  PRINT #2, "SAHF"
  
  IF stepsign = neg THEN
    PRINT #2, "JNBE forloop" + STR2$(workfor)
  ELSE : PRINT #2, "JNAE forloop" + STR2$(workfor)
  END IF
  
END IF

PRINT #2, "forend" + STR2$(workfor) + ":"

Popt forvar$
POP stepsign
POP fortype
POP workfor

forcounter = forcounter - 1

END SUB

SUB kw.open

startpos = getcharpos
DO UNTIL UCASE$(a$) = "FOR"
  a$ = getword$(wordtype)
  IF a$ = lineeof THEN show.error 32, ""
LOOP

file$ = MID$(codetext$, startpos, (getcharpos - 3) - startpos)
mode$ = getword$(wordtype)
spos = getcharpos
accs$ = getword$(wordtype)

IF UCASE$(accs$) = "ACCESS" THEN   ' Solo para compatibilidad
  b$ = getword$(wordtype)          ' no tiene ningun efecto
ELSE
  getcharpos = spos
END IF

b$ = getword$(wordtype)
IF NOT UCASE$(b$) = "AS" THEN show.error 4, ""

IF UCASE$(mode$) = "BINARY" THEN
  filenum$ = LTRIM$(MID$(codetext$, getcharpos, LEN(codetext$) - getcharpos + 1))
  filenum$ = ClearFilenum$(filenum$)
  Math.parser filenum$, intgr, 0
  PRINT #2, "PUSH eax"
  string.parser file$
  PRINT #2, "MOV EBX, eax"
  PRINT #2, "POP eax"
  PRINT #2, "CALL OpenFile"
ELSE
  show.error 38, mode$
END IF

END SUB

SUB kw.out (size)

n = getarg(0, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)
Checkargs n, 2

Math.parser arg1$, intgr, 0
PRINT #2, "PUSH EAX"
Math.parser arg2$, intgr, 0
PRINT #2, "POP EDX"
SELECT CASE size
  CASE tbyte: PRINT #2, "OUT DX, AL"
  CASE tinteger: PRINT #2, "OUT DX, AX"
  CASE tlong: PRINT #2, "OUT DX, EAX"
END SELECT

END SUB

SUB kw.poke (mode)
n = getarg(0, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)
IF arg1$ = "" OR arg2$ = "" THEN show.error 37, ""

Math.parser arg1$, intgr, 0
PRINT #2, "PUSH EAX"
Math.parser arg2$, intgr, 0
PRINT #2, "POP EDX"
SELECT CASE mode
  CASE tbyte: reg$ = "AL"
  CASE tinteger: reg$ = "AX"
  CASE tlong: reg$ = "EAX"
END SELECT
PRINT #2, "MOV [EDX], " + reg$
END SUB

' Writes a string into a fixed memory location
SUB kw.pokes

n = getarg(0, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)

IF NOT n = 2 AND NOT n = 3 THEN Checkargs 1, 3

IF n = 2 THEN
  Math.parser arg1$, intgr, 0
  PRINT #2, "PUSH EAX"
  string.parser arg2$
  PRINT #2, "MOV ECX, [EAX]"
  PRINT #2, "ADD EAX, 4"
  IF insidesub THEN PRINT #2, "MOV [push4], ESI"
  PRINT #2, "POP EDI"
  PRINT #2, "MOV ESI, EAX"
  PRINT #2, "CLD"
  PRINT #2, "REP MOVSB"
  PRINT #2, "MOV EDI, [varedi]"
  IF insidesub THEN PRINT #2, "MOV ESI, [push4]"
ELSE
  Math.parser arg1$, intgr, 0
  PRINT #2, "PUSH EAX"
  Math.parser arg2$, intgr, 0
  PRINT #2, "PUSH EAX"
  string.parser arg3$
  PRINT #2, "POP ECX"
  PRINT #2, "ADD EAX, 4"
  IF insidesub THEN PRINT #2, "MOV [push4], ESI"
  PRINT #2, "POP EDI"
  PRINT #2, "MOV ESI, EAX"
  PRINT #2, "CLD"
  PRINT #2, "REP MOVSB"
  PRINT #2, "MOV EDI, [varedi]"
  IF insidesub THEN PRINT #2, "MOV ESI, [push4]"
END IF
END SUB

SUB kw.print
ontextwin

t$ = MID$(codetext$, getcharpos, LEN(codetext$) - getcharpos + 1)
Pushtext t$
  a$ = getword$(wordtype)
  IF a$ = lineeof THEN PRINT #2, "INC word [texty]": EXIT SUB
Poptext
string.parser t$
PRINT #2, "CALL Print"
dectmp

updatewin
END SUB

SUB kw.select

printc fullcodetext$

a$ = UCASE$(getword$(wordtype))
IF NOT a$ = "CASE" THEN show.error 16, "SELECT"

PUSH curcase
PUSH savedif
PUSH workselect

savedif = workif
curcase = 0
oldworkselect = workselect
workselect = curselect

CND.Select

IF oldworkselect >= 0 THEN
  PRINT #5, "; SAVE cmpreg"
ELSE : PRINT #5, "; DONT SAVE cmpreg"
END IF
curselect = curselect + 1
END SUB

SUB kw.setnewoffset

n = getarg(0, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)
IF arg1$ = "" OR arg2$ = "" THEN show.error 37, ""

var$ = LTRIM$(RTRIM$(arg1$))
a = sexist(var$, i, typeblock$, mempos&, varshared)

IF lastfound = arraytype THEN
  IF varshared = true OR NOT insidesub = true THEN
    arraytext$ = "Array"
  ELSEIF insidesub = true THEN
    arraytext$ = "subArray"
  END IF

  Math.parser arg2$, intgr, 0
  PRINT #2, "MOV [" + arraytext$ + STR2$(i) + "], EAX"
ELSE
  IF NOT fixedvar = true THEN show.error 44, ""
  Math.parser arg2$, intgr, 0
  Getvarvalue var$, 0, typeobj$, leavemem3, gotvartype
END IF
END SUB

SUB kw.string (text$)

Pushtext text$
n = getarg(0, arg1$, arg2$, arg3$, arg4$, arg5$, arg6$, arg7$, arg8$, arg9$, arg10$)
Checkargs n, 2
Poptext

IF getoptype(arg2$) = mathop THEN
  PRINT #2, "PUSH EAX"
  Math.parser arg2$, intgr, 0
  PRINT #2, "PUSH EAX"
ELSE
  PRINT #2, "PUSH EAX"
  string.parser arg2$
  dectmp
  PRINT #2, "MOV EBX, 0"
  PRINT #2, "MOV BL, [EAX+4]"
  PRINT #2, "PUSH EBX"
END IF

Math.parser arg1$, intgr, 0
PRINT #2, "MOV ECX, EAX"
PRINT #2, "POP EBX"
PRINT #2, "POP EAX"
PRINT #2, "CALL String$"

END SUB

SUB kw.val (text$)

string.parser text$
dectmp
IF insidesub THEN PRINT #2, "PUSH ESI"
PRINT #2, "MOV EBX, EAX"
PRINT #2, "CALL NEAR Val"
PRINT #2, "MOV EDI, [varedi]"
IF insidesub THEN PRINT #2, "POP ESI"


END SUB

FUNCTION kw.varptr
printc "VARPTR"

Pushtext par$
b$ = getword$(wordtype)

a = sexist(b$, i, typeblock$, mempos&, varshared)

IF lastfound = arraytype AND par$ = "" THEN par$ = "0"

IF NOT typeblock$ = "" THEN
tmp = INSTR(b$, ".")

IF NOT tmp > 0 THEN
FOR i = 0 TO curtype
  IF UCASE$(typeblock$) = UCASE$(typename$(i)) THEN
    tfile$ = tmpdir$ + "\tf" + LTRIM$(STR$(i)) + ".typ"
    OPEN tfile$ FOR INPUT AS #100
      INPUT #100, a$
    CLOSE #100
    b$ = b$ + "." + a$
    GOTO label62
  END IF
NEXT i
END IF
END IF

IF NOT a = -1 THEN
  Getvarvalue b$, 1, "", leavemem, gotvartype
  kw.varptr = gotvartype
  Poptext
  EXIT FUNCTION
END IF

label62:
sa$ = UCASE$(b$)
tmp = INSTR(b$, ".")

IF tmp > 0 THEN
  typeobj$ = MID$(b$, tmp + 1, LEN(b$) - (tmp))
  b$ = MID$(b$, 1, tmp - 1)

a = sexist(b$, i, typeblock$, mempos&, varshared)
b = gettypemempos&(typeblock$, typeobj$, objtype)
IF NOT a = -1 AND NOT objtype = tstring THEN
  Getvarvalue b$, 1, typeobj$, leavemem, gotvartype
  kw.varptr = gotvartype
  Poptext
  EXIT FUNCTION
END IF
END IF

IF wordtype = withpar AND par$ = "" THEN par$ = "0"
IF Stringexist(sa$, leavemem, i, isarray, par$) THEN kw.varptr = tstring: Poptext: EXIT FUNCTION
show.error 15, b$

END FUNCTION

SUB loop.for

PUSH workfor
PUSH fortype
PUSH stepsign
Pusht forvar$
workfor = curfor

var$ = getword$(wordtype)

s$ = getword$(wordtype2)
IF NOT s$ = "=" OR NOT wordtype = normal THEN show.error 28, ""

gt = 1
DO WHILE NOT endloop = true
  f$ = e$
  e$ = d$
  d$ = c$
  c$ = b$
  b$ = a$
  a$ = getchar$
  t$ = t$ + b$

  IF a$ = CHR$(34) THEN
    IF strg = true THEN
      strg = false
    ELSE
      strg = true
      checkfornot = 0
    END IF
  END IF

  IF strg = true THEN GOTO label48

  IF UCASE$(f$ + e$ + d$ + c$ + b$ + a$) = " STEP " THEN
    IF f$ = CHR$(9) OR f$ = CHR$(32) THEN
      endi$ = LTRIM$(MID$(t$, 1, LEN(t$) - 5))
      t$ = ""
      gettingstep = true
    END IF
  ELSEIF UCASE$(d$ + c$ + b$ + a$) = " TO " THEN
    IF d$ = CHR$(9) OR d$ = CHR$(32) THEN
      starti$ = LTRIM$(MID$(t$, 1, LEN(t$) - 3))
      t$ = ""
      gt = 2
    END IF
  END IF

  IF a$ = lineeof THEN
    IF gt = 1 THEN show.error 29, ""
    IF gettingstep = true THEN
      step$ = LTRIM$(t$)
      EXIT DO
    ELSE
      endi$ = LTRIM$(t$)
      EXIT DO
    END IF
  END IF

label48:
LOOP

' var$        ...  variable
' starti$     ...  inicio
' endi$       ...  fin
' step$       ...  step
' COLOR 7, 9

a = Scanline(var$, changepos) - 2
b = Scanline(starti$, changepos) - 2
c = Scanline(endi$, changepos) - 2

IF NOT step$ = "" THEN
  d = Scanline(step$, changepos) - 2
ELSE : d = 0
END IF

R = a OR b OR c OR d

Pushtext step$
  a$ = getword$(wordtype)
  b$ = getword$(wordtype2)
  IF NOT b$ = lineeof OR NOT wordtype = intgr AND NOT wordtype = float THEN
    tmp = 1
  IF errfile$ = "" THEN
    PRINT "Warning: STEP cannot be negative in this sentence: "
    PRINT Savedtext$(cursave - 1)
  ELSE
    PRINT #11, "Warning: STEP cannot be negative in this sentence: "
    PRINT #11, Savedtext$(cursave - 1)
  END IF
    IF ignorestep = false THEN SLEEP
  END IF
Poptext

Pushtext endi$
  a3$ = getword$(wordtype)
  b3$ = getword$(wordtype2)
  IF NOT b3$ = lineeof OR NOT wordtype = intgr AND NOT wordtype = float THEN tmp3 = 1
Poptext

IF R = 0 THEN   ' ****---------- INTEGER
  fortype = intgr
  PRINT #3, "FOR" + STR2$(curfor) + "END DD 0"
  IMath.Parser starti$

  Getvarvalue var$, current, typeobj$, leavemem2, gotvartype
  IMath.Parser endi$
  PRINT #2, "MOV [FOR" + STR2$(curfor) + "END], EAX"

IF NOT step$ = "" THEN
  IF NOT tmp = 1 THEN
    IF MID$(a$, 1, 1) = "-" THEN
      stepsign = neg
      PRINT #3, "FOR" + STR2$(curfor) + "STEP DD " + MID$(a$, 2, LEN(a$) - 1)
    ELSE
      PRINT #3, "FOR" + STR2$(curfor) + "STEP DD " + a$
      stepsign = positive
    END IF
  ELSE
    PRINT #3, "FOR" + STR2$(curfor) + "STEP DD 0"
    IMath.Parser step$
    PRINT #2, "MOV [FOR" + STR2$(curfor) + "STEP], EAX"
    stepsign = positive
  END IF
ELSE
  PRINT #3, "FOR" + STR2$(curfor) + "STEP DD 1"
  stepsign = positive
END IF
' ************************************************/**\**/*********************
' ****************-----------------------------**/****\/**********************
ELSE            ' ****---------- FLOAT          /     / \                    *
' ****************-----------------------------/*****/***\********************
' ********************************************/*****/*****\*******************
  fortype = float

  Getvarvalue var$, current, typeobj$, leavemem, gotvartype
  PRINT #2, "PUSH EAX"
  Math.parser starti$, skip, 0
  PRINT #2, "POP EAX"

  SELECT CASE gotvartype
    CASE tbyte:
      PRINT #2, "MOV EBX, temp"
      PRINT #2, "FISTP DWORD [EBX]"
      PRINT #2, "MOV [EAX], BL"
    CASE tinteger: PRINT #2, "FISTP WORD [EAX]"
    CASE tlong: PRINT #2, "FISTP DWORD [EAX]"
    CASE tsingle: PRINT #2, "FSTP DWORD [EAX]"
    CASE tdouble: PRINT #2, "FSTP QWORD [EAX]"
    CASE textended: PRINT #2, "FSTP TWORD [EAX]"
  END SELECT
  
  IF NOT tmp3 = 1 THEN
    PRINT #3, "FOR" + STR2$(curfor) + "END DQ " + addpoint$(a3$)
  ELSE
    PRINT #3, "FOR" + STR2$(curfor) + "END DQ 0.0"
    Math.parser endi$, skip, 0
    PRINT #2, "FSTP QWORD [FOR" + STR2$(curfor) + "END]"
  END IF

IF NOT step$ = "" THEN
  IF NOT tmp = 1 THEN
    stepsign = positive
    PRINT #3, "FOR" + STR2$(curfor) + "STEP DQ " + a$
    IF MID$(a$, 1, 1) = "-" THEN stepsign = neg
  ELSE
    PRINT #3, "FOR" + STR2$(curfor) + "STEP DQ 0.0"
    Math.parser step$, skip, 0
    PRINT #2, "FSTP QWORD [FOR" + STR2$(curfor) + "STEP]"
    stepsign = positive
  END IF
ELSE
  PRINT #3, "FOR" + STR2$(curfor) + "STEP DQ 1.0"
  stepsign = positive
END IF
END IF

PRINT #2, "forloop" + STR2$(workfor) + ":"

fortype(forcounter) = fortype
forcounter = forcounter + 1

curfor = curfor + 1
forvar$ = var$
END SUB

FUNCTION processcif
DIM cond$(40)
DIM un(40)
DIM unnot(40)

strg = false

checkfornot = 3
globalcond = true
DO WHILE NOT endloop = true
  f$ = e$
  e$ = d$
  d$ = c$
  c$ = b$
  b$ = a$
  a$ = getchar$
  t$ = t$ + c$

  IF a$ = CHR$(34) THEN
    IF strg = true THEN
      strg = false
    ELSE
      strg = true
      checkfornot = 0
    END IF
  END IF

  IF strg = true THEN GOTO label42

  IF f$ = CHR$(9) OR f$ = CHR$(32) THEN
  IF UCASE$(e$ + d$ + c$ + b$) = "THEN" THEN
label43:
  IF a$ = CHR$(9) OR a$ = CHR$(32) OR a$ = lineeof THEN
    cond$(curcond) = clrspc$(MID$(t$, 1, LEN(t$) - 4))
    unnot(curcond) = curunnot
    maxcond = curcond
    EXIT DO
  END IF
  END IF
  END IF

  IF a$ = lineeof THEN GOTO label43

  IF checkfornot >= 0 THEN
  IF UCASE$(c$ + b$ + a$) = "NOT" THEN
    t$ = ""
    c$ = "": b$ = "": a$ = ""
    curunnot = true
  END IF
  END IF

  IF NOT a$ = CHR$(32) AND NOT a$ = CHR$(9) THEN
    IF checkfornot > 0 THEN checkfornot = checkfornot - 1
  END IF

  IF c$ = CHR$(32) OR c$ = CHR$(9) THEN
  IF a$ = CHR$(32) OR a$ = CHR$(9) THEN
    IF b$ = "&" THEN
      cond$(curcond) = clrspc$(t$)
      un(curcond + 1) = condand
      unnot(curcond) = curunnot
      curunnot = false
      curcond = curcond + 1
      checkfornot = 4
      t$ = "": c$ = "": b$ = ""
    ELSEIF b$ = "|" THEN
      maxor = maxor + 1
      cond$(curcond) = clrspc$(t$)
      un(curcond + 1) = condor
      unnot(curcond) = curunnot
      curunnot = false
      curcond = curcond + 1
      checkfornot = 4
      t$ = "": c$ = "": b$ = ""
    END IF
  END IF
  END IF
label42:
LOOP

FOR i = 0 TO curcond
  tmpcond = false
  IF un(i) = condor THEN
    IF globalcond = true THEN processcif = true: EXIT FUNCTION
    globalcond = true
  END IF

  getconditions cond$(i), a$, b$, cond$
  t = Scanconstline(a$)
  IF NOT t = Scanconstline(b$) THEN show.error 27, ""
  SELECT CASE t
    CASE float, intgr
      Pushtext a$
      CMath.parser value1#
      Poptext
      Pushtext b$
      CMath.parser value2#
      Poptext
      SELECT CASE cond$
        CASE "=>", ">=": IF value1# >= value2# THEN tmpcond = true
        CASE "=<", "<=": IF value1# <= value2# THEN tmpcond = true
        CASE "=", "==": IF value1# = value2# THEN tmpcond = true
        CASE ">": IF value1# > value2# THEN tmpcond = true
        CASE "<": IF value1# < value2# THEN tmpcond = true
        CASE "<>": IF value1# <> value2# THEN tmpcond = true
      END SELECT
    CASE stringtype
      Pushtext a$
      CString.parser s1$
      Poptext
      Pushtext b$
      CString.parser s2$
      Poptext
      IF s1$ = s2$ THEN tmpcond = true
  END SELECT
  IF unnot(i) = true THEN tmpcond = NOT tmpcond
  globalcond = globalcond AND tmpcond
NEXT i

processcif = globalcond
END FUNCTION

FUNCTION Scanconstline (text$)
Pushtext text$
Scanconstline = intgr
DO WHILE NOT endloop = true
  a$ = getword$(wordtype)

  IF a$ = lineeof THEN Poptext: EXIT FUNCTION

  IF wordtype = intgr THEN GOTO label1
  IF wordtype = float THEN
label2:
    Scanconstline = wordtype
    Poptext
    EXIT FUNCTION
  END IF

  IF wordtype = stringtype THEN
label3:
    Scanconstline = wordtype
    Poptext
    EXIT FUNCTION
  END IF

  SELECT CASE a$
    CASE "-", "*", "/", "+", "AND", "OR", "XOR", "NOT"
    CASE ELSE
      a = Getconsttype(a$, value&, stringvalue$, floatvalue#)
      IF a = -1 THEN show.error 15, a$
      IF a = stringtype THEN GOTO label3
      IF a = float THEN GOTO label2
  END SELECT

label1:
LOOP
END FUNCTION

