' Gabasic 0.30 source
' --------------------
'
' Just to learn, never copy code from here and paste it in other text

' Gabasic doesn't support floating point math(yet)
' I will rewrite Gabasic sometime
' UltraBasic (that's how the new Gabasic will be called)
' will be finish before february 2001. It will be a ULTRA
' powerfull  Basic compiler, it will be 95% qb compatible
' and faster than Gabasic !!!!!.

' If you would like to help with UltraBasic project, mail me at
' gabfm@hotmail.com

' Don't try to learn how the "IF" command is processed in Gabasic,
' it sucks !!!

' Don't forget to visit the following pages:
' www.master-creating.de, www.graphite-tech.com

' Good luck with your compiler !!!!!!!!!

DECLARE SUB kw.string (t$)
DECLARE FUNCTION Findword% (word$)
DECLARE SUB kw.mouseexist (cop%)
DECLARE SUB kw.mousedat (mmode%, cop%)
DECLARE SUB ifOther ()
DECLARE SUB ifOR ()
DECLARE SUB fixIFline ()
DECLARE SUB kw.randomize ()
DECLARE SUB kw.getmaxres (cop%, restype%)
DECLARE SUB tprint (t$)
DECLARE SUB skiptemp2 (t$)
DECLARE SUB kw.shell ()
DECLARE SUB kw.timer (cop%)
DECLARE SUB kw.lucase (t$, mode%)
DECLARE SUB kw.exit ()
DECLARE SUB kw.stringr (par$)
DECLARE SUB kw.killdir (mode%)
DECLARE SUB kw.getcmd (ctype%)
DECLARE SUB Addsub ()
DECLARE SUB kw.lof (t$, cop%)
DECLARE SUB kw.seek (t$, cop%)
DECLARE SUB kw.settranscolor ()
DECLARE SUB kw.vput (ptype%)
DECLARE SUB kw.vget ()
DECLARE SUB kw.vhline (ltype%)
DECLARE SUB kw.setvoffs ()
DECLARE SUB kw.fillbox (boxtype%)
DECLARE SUB kw.setclip ()
DECLARE SUB kw.line ()
DECLARE SUB kw.abssgn (t$, cop%, otype%)
DECLARE SUB kw.setvect ()
DECLARE SUB kw.getvect (t$, cop%)
DECLARE SUB kw.inp (t$, ptype%, cop%)
DECLARE SUB kw.loadkeyb ()
DECLARE SUB kw.val (t$, cop%)
DECLARE SUB kw.kill ()
DECLARE SUB kw.asc (t$, cop%)
DECLARE SUB decword ()
DECLARE SUB Skiptemp ()
DECLARE SUB kw.memfill (ctype%)
DECLARE SUB kw.memcopy (ctype%)
DECLARE SUB kw.getput (mode%, memmode%)
DECLARE SUB kw.get ()
DECLARE SUB kw.close ()
DECLARE SUB kw.open ()
DECLARE SUB mem.redim ()
DECLARE SUB kw.varptr (t$, cop%)
DECLARE SUB kw.peek (t$, ptype%, cop%)
DECLARE SUB kw.poke (ptype%)
DECLARE SUB kw.out (outtype%)
DECLARE SUB kw.setcol ()
DECLARE SUB kw.point (t$, cop%)
DECLARE SUB kw.rnd (t$, cop%, RegType%)
DECLARE SUB kw.str (par$)
DECLARE SUB kw.mid (t$)
DECLARE SUB kw.inkey (cop%)
DECLARE SUB emumain (t$)
DECLARE SUB kw.next ()
DECLARE SUB SPop (t$)
DECLARE SUB spush (t$)
DECLARE SUB kw.screen ()
DECLARE SUB kw.pset ()
DECLARE SUB kw.do ()
DECLARE SUB kw.loop ()
DECLARE SUB kw.else ()
DECLARE SUB kw.chrS (t$)
DECLARE SUB kw.for ()
DECLARE SUB kw.if (mode%)
DECLARE SUB kw.asm ()
DECLARE SUB kw.color ()
DECLARE SUB kw.setstring ()
DECLARE SUB kw.end ()
DECLARE SUB kw.locate ()
DECLARE SUB kw.waitkey ()
DECLARE SUB kw.print ()
DECLARE SUB kw.cls ()
DECLARE SUB kw.len (t$, cop%)
DECLARE SUB kw.gosub ()
DECLARE SUB kw.goto ()
DECLARE SUB mem.addlabel (name$)
DECLARE SUB mem.const ()
DECLARE SUB mem.addinmd (t$)
DECLARE SUB CheckOthers (par$)
DECLARE SUB string.parser (t$, mode%)
DECLARE SUB EndProgram ()
DECLARE SUB BuildFiles ()
DECLARE SUB CallKeyword (name$)
DECLARE SUB waitchar ()
DECLARE SUB VPop (value%)
DECLARE SUB vpush (value%)
DECLARE SUB SetKeywords ()
DECLARE SUB Math.Parser (t$, usertype%)
DECLARE SUB Quickshow ()
DECLARE SUB mem.addvar (name$, vaftype%, value&)
DECLARE SUB show.error (er%)
DECLARE SUB mem.dim ()
DECLARE SUB Main ()
DECLARE SUB Init ()
DECLARE SUB SetWhiteChars (mode)
DECLARE FUNCTION GetLabel% (name$)
DECLARE FUNCTION GetTempDir$ ()
DECLARE FUNCTION GetStringType% (name$)
DECLARE FUNCTION GetInmd$ ()
DECLARE FUNCTION GetFullWord$ (mode%)
DECLARE FUNCTION Gettype% (t$)
DECLARE FUNCTION GetWord$ (par$)
DECLARE FUNCTION GetChar$ ()
DECLARE FUNCTION GetArrayType% (name$)
DECLARE FUNCTION GetName$ (text$)
DECLARE FUNCTION iskeyword% (name$)
DECLARE FUNCTION CheckVar% (name$, vartype%)

DIM SHARED getcharpos AS INTEGER, SStack$(20)
DIM SHARED whitechar(20) AS STRING * 1, char$(7)

DIM SHARED max%, whitecounter%, text$, stringsize&, global$, linen&, version$
DIM SHARED basfile$, asmfile$, exefile$, endword$, wx%, wy%, cc%, compmode%
DIM SHARED logfile$, processagain%, processed%

CONST arrayt = 1, intt = 2, stringt = 3, longt = 4, toend = 1, tobegin = 2
CONST true = 1, false = 0, constt = 5, ifmode = 1, vart = 5, formode = 2
CONST formodes = 3, subs = 1, add = 2, Byte = 5, openmode = 4, bytet = 5
CONST distribute = 1, addressmode = 5

compmode% = distribute         ' MODO DEL COMPILADOR
version$ = "0.30 Beta 2 (DO NOT REDISTRIBUTE)"

GOSUB LoadCmdln    ' Cargar la linea de commandos

DIM SHARED intvars(max%) AS STRING * 30         '\
DIM SHARED longvars(max%) AS STRING * 30        '| Nombre y datos
DIM SHARED Arrays(max%) AS STRING * 31          '| de los objectos.
DIM SHARED Strings(max%) AS STRING * 31         '|
DIM SHARED Constvar(max% / 2) AS STRING * 30    '|
DIM SHARED constval(max% / 2) AS LONG           '/
DIM SHARED label(max%) AS STRING * 30
DIM SHARED Fornext(10) AS STRING * 30
DIM SHARED vstack(100) AS INTEGER
DIM SHARED subpar$(20)
DIM SHARED ortext$(1 TO 10)
DIM SHARED selcasetext$(1 TO 10)

Constvar(0) = "TRUE": constval(0) = -1
Constvar(1) = "FALSE": constval(1) = 0

DIM SHARED curint%, curlong%, curarray%, curstring%, curinmd%, curconst%
DIM SHARED curlabel%, curfor%, curif%, curstack%, elseav%, workif%, workdo%
DIM SHARED curdo%, workfor%, cursstack%, tempdir$, cursub%, ls, cursub2%
DIM SHARED curstringparser%, curor%, useor%, curorlabel%, workor%, cursel%
DIM SHARED curmouse%, getwordmode%
curconst% = 2
workfor% = -1

ON ERROR GOTO Errorhandler

tempdir$ = GetTempDir$

Main              ' Y ahora lo purete !

END
' ------------------------------------
' *   Carga la linea de commandos    *
' ------------------------------------
LoadCmdln:
max% = 100
stringsize& = 64000

SetWhiteChars 0
IF compmode% = distribute THEN
  text$ = COMMAND$
ELSE
  text$ = "-bas test\test.bas -asm tmp.asm -exe tmp.exe"
  ' text$ = "-bas zip\examples\g.bas -asm tmp.asm -exe tmp.exe"
  ' text$ = "-bas test\keys.bas -asm tmp.asm -exe tmp.exe"
END IF
Init

char$(0) = "|": char$(1) = "/": char$(2) = "-": char$(3) = "\": char$(4) = "|"
char$(5) = "\": char$(6) = "-": char$(7) = "/":
RETURN

Errorhandler:
COLOR 9
PRINT "ERROR IN MAIN PROGRAM !!!!"
PRINT
PRINT "Maybe your program has errors, or maybe gabasic has bugs"
PRINT ""
PRINT "If you can, send an e-mail to": PRINT
COLOR 2
PRINT "     gabfm@hotmail.com": PRINT
COLOR 15
PRINT "telling the bug"

PRINT "Current line in infile: ", linen&
PRINT "Text: ", text$
PRINT "Error(qb): ", ERR
PRINT "Current Char: ", getcharpos
PRINT "Text Len: ", LEN(text$)
END

SUB Addsub

n$ = GetWord$(par$)

IF NOT LEN(n$) = 40 THEN n$ = n$ + SPACE$(40 - LEN(n$))
IF NOT LEN(par$) = 200 THEN par$ = par$ + SPACE$(200 - LEN(par$))

d$ = n$ + par$

PUT #4, (cursub% * 240) + 1, d$
cursub% = cursub% + 1

END SUB

DEFINT A-Z
SUB BuildFiles

OPEN asmfile$ FOR OUTPUT AS #1
  filename$ = "include\code.inc": GOSUB copyfile
  labels = true: filename$ = tempdir$ + "\code.txt": GOSUB copyfile: labels = false
  PRINT #1, "; ---------------------------------------------------"
  PRINT #1, "; *             Internal routines                   *"
  PRINT #1, "; ---------------------------------------------------"
  filename$ = "include\string.asm": GOSUB copyfile
  filename$ = "include\mouse.asm": GOSUB copyfile

  filename$ = "include\file.asm": GOSUB copyfile
  filename$ = "include\math.asm": GOSUB copyfile
  filename$ = "include\text.asm": GOSUB copyfile
  filename$ = "include\misc.asm": GOSUB copyfile
  filename$ = "include\keyb.asm": GOSUB copyfile
  filename$ = "include\mem.asm": GOSUB copyfile
  filename$ = "include\vga.asm": GOSUB copyfile
  filename$ = "include\sprite.asm": GOSUB copyfile
  filename$ = "include\svga.asm": GOSUB copyfile
  
  filename$ = "include\dpmi.asm": GOSUB copyfile
  filename$ = "include\endprg.inc": GOSUB copyfile
  EndProgram
  filename$ = "include\data.inc": GOSUB copyfile
  filename$ = tempdir$ + "\data.txt ": GOSUB copyfile
  PRINT #1, "TmpStringSize DD " + STR$(stringsize&)

CLOSE
EXIT SUB

copyfile:
  waitchar
  OPEN filename$ FOR INPUT AS #2
  DO WHILE NOT EOF(2)
    LINE INPUT #2, a$
    IF labels = true THEN
      IF MID$(a$, 1, 4) = "GOTO" THEN
	b$ = MID$(a$, 6, LEN(a$) - 5)
	PRINT #1, "JMP NEAR Label" + LTRIM$(STR$(GetLabel%(b$)))
      ELSEIF MID$(a$, 1, 5) = "GOSUB" THEN
	b$ = MID$(a$, 7, LEN(a$) - 6)
	PRINT #1, "CALL NEAR Label" + LTRIM$(STR$(GetLabel%(b$)))
      ELSEIF MID$(a$, 1, 6) = "MEMADR" THEN
	b$ = MID$(a$, 8, LEN(a$) - 7)
	PRINT #1, "MOV EDX, Label" + LTRIM$(STR$(GetLabel%(b$)))
      ELSE : IF NOT a$ = "" THEN PRINT #1, a$
      END IF
    ELSE : IF NOT a$ = "" THEN PRINT #1, a$
    END IF
  LOOP
  CLOSE #2
RETURN

END SUB

SUB CheckOthers (par$)

label5:
savepos% = getcharpos
tmp = CheckVar(global$, vartype%)
a$ = GetWord$(notneededPar$)

IF NOT getcharpos >= LEN(text$) THEN tmp$ = MID$(text$, getcharpos + 1, LEN(text$) - getcharpos)

IF NOT tmp = -1 THEN
  SELECT CASE vartype%
    CASE longt
      IF NOT a$ = "=" AND NOT a$ = "=-" AND NOT a$ = "=+" THEN show.error 11
      Math.Parser tmp$, longt

      SELECT CASE a$
	CASE "=": PRINT #2, "MOV [LongVar" + LTRIM$(STR$(tmp)) + "], EAX"
	CASE "=+": PRINT #2, "ADD [LongVar" + LTRIM$(STR$(tmp)) + "], EAX"
	CASE "=-": PRINT #2, "SUB [LongVar" + LTRIM$(STR$(tmp)) + "], EAX"
      END SELECT

    CASE intt
      IF NOT a$ = "=" AND NOT a$ = "=-" AND NOT a$ = "=+" THEN show.error 11
      Math.Parser tmp$, intt

      SELECT CASE a$
	CASE "=": PRINT #2, "MOV [IntVar" + LTRIM$(STR$(tmp)) + "], AX"
	CASE "=+": PRINT #2, "ADD [IntVar" + LTRIM$(STR$(tmp)) + "], AX"
	CASE "=-": PRINT #2, "SUB [IntVar" + LTRIM$(STR$(tmp)) + "], AX"
      END SELECT

    CASE stringt
      IF NOT a$ = "=" AND NOT a$ = "=+" THEN show.error 11
      IF a$ = "=" THEN usetype% = tobegin
      IF a$ = "=+" THEN usetype% = toend
      IF NOT par$ = "" AND GetStringType%(global$) = arrayt THEN
	Math.Parser par$, longt
	PRINT #2, "MOV EBX, [StringMax" + LTRIM$(STR$(tmp)) + "]"
	PRINT #2, "MUL EBX"
	PRINT #2, "ADD EAX, [StringOffset" + LTRIM$(STR$(tmp)) + "]"
	string.parser tmp$, usetype%
      ELSE
	' --- Para poder usar a$ = a$ + b$
	tmp2 = Findword%(global$)

	IF tmp2 = 0 THEN
	  PRINT #2, "MOV EAX, [StringOffset" + LTRIM$(STR$(tmp)) + "]"
	  string.parser tmp$, usetype%
	ELSE
	  PRINT #2, "MOV EAX, [StringOffset]"
	  PRINT #2, "ADD EAX, [TmpStringSize]"
	  PRINT #2, "PUSH EAX"
	  string.parser tmp$, tobegin
	  PRINT #2, "POP EAX"
	  PRINT #2, "MOV EBX, [StringOffset" + LTRIM$(STR$(tmp)) + "]"
	  PRINT #2, "MOV DWORD [EBX], 0"
	  PRINT #2, "XCHG EAX, EBX"
	  PRINT #2, "CALL MoveString"
	END IF
	' --- Hasta Aca ---
      END IF
    CASE arrayt
      IF par$ = "" THEN show.error 10
      IF NOT a$ = "=" AND NOT a$ = "=-" AND NOT a$ = "=+" THEN show.error 11
      arraytype% = GetArrayType%(global$)

      Math.Parser tmp$, arraytype%
      PRINT #2, "PUSH EAX"

      Math.Parser par$, longt
      IF arraytype% = bytet THEN Ereg$ = "AL"
      IF arraytype% = intt THEN PRINT #2, "SHL EAX, 1": Ereg$ = "AX"
      IF arraytype% = longt THEN PRINT #2, "SHL EAX, 2": Ereg$ = "EAX"
      PRINT #2, "MOV EBX, [ArrayOffset" + LTRIM$(STR$(tmp)) + "]"
      PRINT #2, "ADD EBX, EAX"

      PRINT #2, "POP EAX"

      SELECT CASE a$
	CASE "=": PRINT #2, "MOV [EBX], " + Ereg$
	CASE "=+": PRINT #2, "ADD [EBX], " + Ereg$
	CASE "=-": PRINT #2, "SUB [EBX], " + Ereg$
      END SELECT
    CASE ELSE: show.error 10
  END SELECT
ELSE        ' ------- Agrega variables si no existen
  IF NOT par$ = "" THEN show.error 6

' --- Ver si es un SUB
a$ = SPACE$(40)
getcharpos = savepos%
FOR i% = 0 TO cursub% - 1
  GET #4, (i% * 240) + 1, a$
  tmp = INSTR(a$, " ")
  IF tmp >= 1 THEN
    a$ = MID$(a$, 1, tmp - 1)
  END IF

  IF LCASE$(a$) = LCASE$(global$) THEN
    d$ = SPACE$(200)
    GET #4, , d$
    b$ = ""
    C = -1
    DO WHILE NOT b$ = "eof"
      C = C + 1
      b$ = GetFullWord$(0)
      subpar$(C) = b$
    LOOP
    st$ = text$
    spos = getcharpos
    getcharpos = 0
    text$ = d$
    FOR i2 = 0 TO C - 1
      emumain GetFullWord$(0) + " = " + subpar$(i2)
    NEXT i2
    text$ = st$
    getcharpos = spos
    PRINT #2, "CALL NEAR Sub" + LTRIM$(STR$(i%))
  EXIT SUB
  END IF
NEXT i%

  SELECT CASE MID$(global$, LEN(global$), 1)
    CASE "$"
      PRINT #2, "MOV EBX, [StringOffset" + LTRIM$(STR$(curstring%)) + "]"
      PRINT #2, "CMP EBX, 0"
      PRINT #2, "JNE SkipAlloc" + LTRIM$(STR$(curstring%))
      PRINT #2, "MOV EAX, [StringSize]"
      PRINT #2, "ADD EAX, 4"
      PRINT #2, "MOV [StringMax" + LTRIM$(STR$(curstring%)) + "], EAX"
      mem.addvar global$, stringt, 0
      PRINT #2, "CALL NEAR AllocBlock"
      tmp% = curstring% - 1
      PRINT #2, "MOV [StringOffset" + LTRIM$(STR$(tmp%)) + "], EAX"
      PRINT #2, "MOV EBX, [StringHandle" + LTRIM$(STR$(tmp%)) + "]"
      PRINT #2, "MOV [EBX], SI"
      PRINT #2, "MOV [EBX+2], DI"
      PRINT #2, "SkipAlloc" + LTRIM$(STR$(tmp%)) + ":"
    CASE "%":  mem.addvar global$, intt, 0
    CASE ELSE
      mem.addvar global$, longt, 0
  END SELECT
  getcharpos = savepos%
  GOTO label5
END IF
END SUB

FUNCTION CheckVar% (name$, vartype%)
name$ = LCASE$(name$)
FOR i = 0 TO curint%
  IF GetName$(LCASE$(intvars(i))) = name$ THEN vartype% = intt: CheckVar% = i: EXIT FUNCTION
NEXT i

FOR i = 0 TO curlong%
  IF GetName$(LCASE$(longvars(i))) = name$ THEN vartype% = longt: CheckVar% = i: EXIT FUNCTION
NEXT i

FOR i = 0 TO curarray%
  IF GetName$(LCASE$(Arrays(i))) = name$ THEN vartype% = arrayt: CheckVar% = i: EXIT FUNCTION
NEXT i

FOR i = 0 TO curstring%
  IF GetName$(LCASE$(Strings(i))) = name$ THEN vartype% = stringt: CheckVar% = i: EXIT FUNCTION
NEXT i

FOR i = 0 TO curconst%
  IF GetName$(LCASE$(Constvar(i))) = name$ THEN vartype% = constt: CheckVar% = i: EXIT FUNCTION
NEXT i

vartype% = -1
CheckVar% = -1
END FUNCTION

DEFSNG A-Z
SUB decword
IF ls >= 1 THEN PRINT #2, "DEC word [curtmp]": ls = ls - 1
END SUB

SUB emumain (t$)
  stext$ = text$
  spos = getcharpos

  text$ = t$
  getcharpos = 0
  global$ = GetWord$(par$)
    CheckOthers par$
  text$ = stext$
  getcharpos = spos

END SUB

DEFINT A-Z
SUB EndProgram

FOR i = 0 TO curarray% - 1
  PRINT #1, "CMP DWORD [ArrayHandle" + LTRIM$(STR$(i)) + "], 0"
  PRINT #1, "JE SkipDA" + LTRIM$(STR$(i))

  PRINT #1, "mov ebx, [ArrayHandle" + LTRIM$(STR$(i)) + "]"
  PRINT #1, "mov si, [ebx]"
  PRINT #1, "mov di, [ebx+2]"
  PRINT #1, "Call NEAR FreeBlock"
  PRINT #1, "SkipDA" + LTRIM$(STR$(i)) + ":"
NEXT i

FOR i = 0 TO curstring% - 1
  PRINT #1, "CMP DWORD [StringHandle" + LTRIM$(STR$(i)) + "], 0"
  PRINT #1, "JE SkipDS" + LTRIM$(STR$(i))
  
  PRINT #1, "mov ebx, [StringHandle" + LTRIM$(STR$(i)) + "]"
  PRINT #1, "mov si, [ebx]"
  PRINT #1, "mov di, [ebx+2]"
  PRINT #1, "Call NEAR FreeBlock"
  PRINT #1, "SkipDS" + LTRIM$(STR$(i)) + ":"
NEXT i

PRINT #1, "mov ax, 4C00h"
PRINT #1, "int 21h"

END SUB

FUNCTION Findword% (word$)
a$ = LCASE$(text$)
b$ = LCASE$(word$)
wlen = LEN(word$)
FOR i = getcharpos TO LEN(text$) - wlen

  IF MID$(a$, i, 1) = CHR$(34) THEN
    IF t = 1 THEN
      t = 0
    ELSE : t = 1
    END IF
  END IF

  IF t = 0 THEN
  IF MID$(a$, i, wlen) = b$ THEN
    Findword% = i
    EXIT FUNCTION
  END IF

  IF MID$(a$, i, 1) = "'" OR MID$(a$, i, 1) = ";" THEN Findword% = 0: EXIT FUNCTION
  END IF
NEXT i
END FUNCTION

SUB fixIFline
' Cambia ANDs a & y Ors a |
startpos = getcharpos

DO WHILE NOT endloop = 1
  spos = getcharpos
  a$ = GetWord$(par$)
  IF a$ = "eof" THEN endloop = 1

  IF LCASE$(a$) = "and" THEN
    s2pos = getcharpos
    b$ = GetWord$(par$)
    IF LCASE$(b$) = "not" THEN b$ = GetWord$(a$)
    b$ = GetWord$(par$)
    IF b$ = "=" THEN
      a$ = MID$(text$, 1, spos)
      b$ = MID$(text$, s2pos + 2, LEN(text$) - (s2pos))
      text$ = a$ + " & " + b$
    END IF
  END IF

  IF LCASE$(a$) = "or" THEN
    s2pos = getcharpos
    b$ = GetWord$(par$)
    IF LCASE$(b$) = "not" THEN b$ = GetWord$(a$)
    b$ = GetWord$(par$)
    IF b$ = "=" THEN
      a$ = MID$(text$, 1, spos)
      b$ = MID$(text$, s2pos + 2, LEN(text$) - (s2pos))
      text$ = a$ + " | " + b$
    END IF
  END IF
LOOP

getcharpos = startpos

END SUB

DEFSNG A-Z
FUNCTION GetArrayType% (name$)
tmp% = CheckVar%(name$, vartype%)
IF NOT vartype% = arrayt THEN show.error 4
a$ = Arrays(tmp%)
GetArrayType% = ASC(MID$(a$, 31, 1))
END FUNCTION

FUNCTION GetChar$

getcharpos = getcharpos + 1

IF getcharpos > LEN(text$) THEN GetChar$ = "eof": EXIT FUNCTION
  tmp$ = MID$(text$, getcharpos, 1)

IF getwordmode% = 0 THEN
  IF tmp$ = "'" OR tmp$ = ";" THEN GetChar$ = "eof": EXIT FUNCTION
END IF

GetChar$ = MID$(text$, getcharpos, 1)

END FUNCTION

FUNCTION GetFullWord$ (mode%)

getwordmode% = 0
endword$ = ""

DO WHILE NOT endloop = 1
 a$ = GetChar$
 IF a$ = "eof" THEN GetFullWord$ = "eof":  EXIT FUNCTION
 wtmp = -1
 FOR i = 0 TO whitecounter%
   IF NOT a$ = whitechar(i) THEN
     wtmp = wtmp + 1
   END IF
 NEXT i
 IF wtmp = whitecounter% THEN endloop = 1
LOOP

getcharpos = getcharpos - 1

b$ = ""
endloop = 0
inmd = 0
DO WHILE NOT endloop = 1
 a$ = GetChar$

 IF inmd = 0 THEN IF a$ = "(" THEN parentesis = parentesis + 1

 IF a$ = CHR$(34) THEN
   IF inmd = 1 THEN
     inmd = 0: getwordmode% = 0
   ELSE : inmd = 1: getwordmode% = 1
   END IF
 END IF
 
 IF inmd = 0 THEN
 IF a$ = ")" THEN
   IF parentesis = 0 THEN
     show.error 19
   ELSE : parentesis = parentesis - 1
 END IF
 END IF
 END IF
IF a$ = "eof" THEN
label23:
   IF NOT inmd = 0 AND a$ = "eof" THEN show.error 22
   IF NOT parantesis = 0 AND a$ = "eof" THEN show.error 99

   IF NOT inmd = 0 THEN GOTO label12
   IF NOT parentesis = 0 THEN GOTO label12
label10:
   getwordmode% = 0
   GetFullWord$ = b$:  EXIT FUNCTION
 END IF

 IF a$ = "," THEN IF inmd = 0 AND parentesis = 0 THEN GOTO label23

 IF mode% = ifmode OR mode% = formode THEN
 IF inmd = 0 AND parentesis = 0 THEN
   SELECT CASE LCASE$(a$)
     CASE "=", "<", ">", "&", "|": j% = 1
   END SELECT
   IF j% = 1 THEN endword$ = a$: GOTO label10
 END IF
 END IF

label12:
 b$ = b$ + a$

 IF mode% = ifmode OR mode% = formode OR mode% = formodes OR mode% = openmode OR mode% = addressmode THEN
 IF inmd = 0 AND parentesis = 0 THEN
   SELECT CASE mode%
     CASE ifmode: a% = 3: b% = 4: w$ = "then"
     CASE formode: a% = 1: b% = 2: w$ = "to"
     CASE formodes: a% = 3: b% = 4: w$ = "step"
     CASE openmode: a% = 2: b% = 3: w$ = "for"
     CASE addressmode: a% = 1: b% = 2: w$ = "as"
   END SELECT
   IF LEN(b$) > a% THEN
   IF LCASE$(MID$(b$, LEN(b$) - a%, b%)) = w$ THEN
   b$ = MID$(b$, 1, LEN(b$) - b%)
   endword$ = w$: GOTO label10
   END IF
   END IF
 END IF
 END IF

LOOP

END FUNCTION

FUNCTION GetInmd$

DO WHILE NOT endloop = 1
 a$ = GetChar
 IF a$ = "eof" THEN GetInmd$ = "eof": EXIT FUNCTION
 IF a$ = CHR$(34) THEN endloop = 1
LOOP

endloop = 0

DO WHILE NOT endloop = 1
  a$ = GetChar
  IF a$ = CHR$(34) THEN GetInmd$ = b$: EXIT FUNCTION
  IF a$ = "eof" THEN GetInmd$ = "eof": EXIT FUNCTION
  b$ = b$ + a$
LOOP

END FUNCTION

FUNCTION GetLabel% (name$)
FOR i = 0 TO curlabel% - 1
  IF GetName$(LCASE$(label(i))) = name$ THEN GetLabel% = i: EXIT FUNCTION
NEXT i
END FUNCTION

FUNCTION GetName$ (text$)
IF text$ = STRING$(30, CHR$(0)) THEN GetName$ = "": EXIT FUNCTION

tmp% = INSTR(text$, CHR$(32))
IF tmp% = 0 THEN tmp% = 31
IF tmp% = 1 THEN GetName$ = "": EXIT FUNCTION
GetName$ = MID$(text$, 1, tmp% - 1)
END FUNCTION

FUNCTION GetStringType% (name$)
tmp% = CheckVar%(name$, vartype%)
IF NOT vartype% = stringt THEN show.error 4
a$ = Strings(tmp%)
GetStringType% = ASC(MID$(a$, 31, 1))

END FUNCTION

FUNCTION GetTempDir$

a$ = ENVIRON$("TEMP")
IF NOT a$ = "" THEN
  IF MID$(a$, LEN(a$), 1) = "\" THEN a$ = MID$(a$, 1, LEN(a$) - 1)
  GetTempDir$ = a$
END IF

a$ = ENVIRON$("TMP")
IF NOT a$ = "" THEN
  IF MID$(a$, LEN(a$), 1) = "\" THEN a$ = MID$(a$, 1, LEN(a$) - 1)
  GetTempDir$ = a$
END IF

END FUNCTION

FUNCTION Gettype% (t$)
savetext$ = text$
savepos = getcharpos
text$ = t$
getcharpos = 0

DO WHILE NOT endloop = 1
  a$ = GetWord$(par$)

  IF a$ = "eof" THEN
label14: getcharpos = savepos
    text$ = savetext$
    Gettype = vart
    EXIT FUNCTION
  END IF

  IF a$ = "+" GOTO label13

  SELECT CASE LCASE$(a$)
    CASE "\", "/", "*", "-", "ror", "rol", "mod", "shl", "shl", "<<", ">>": GOTO label14
    CASE "input", "len", "asc", "abs", "sgn", "rnd", "point", "varptr", "seek", "lof": GOTO label14
    CASE "getvect", "peek", "peekw", "peekd", "inp", "inpw", "inpd", "val", "timer": GOTO label14
    CASE "getmaxx", "getmaxy", "mouser", "mousel", "mousex", "mousey", "mouseexist": GOTO label14
    CASE "str$", "chr$", "mid$", "inkey$", "command$", "getexepath$": GOTO label15
    CASE "ucase$", "lcase$", "space$", "string$": GOTO label15
  END SELECT

  IF MID$(a$, 1, 1) = CHR$(34) THEN GOTO label15

  tmp% = CheckVar%(a$, vartype%)
  IF vartype% = stringt THEN GOTO label15
  GOTO label14
  
label13:
LOOP

label15:
getcharpos = savepos
text$ = savetext$
Gettype = stringt
EXIT FUNCTION

END FUNCTION

DEFINT A-Z
FUNCTION GetWord$ (par$)

getwordmode% = 0

DO WHILE NOT endloop = 1
 a$ = GetChar
 IF a$ = "eof" THEN GetWord$ = "eof":  EXIT FUNCTION
 wtmp = -1
 FOR i = 0 TO whitecounter%
   IF NOT a$ = whitechar(i) THEN
     wtmp = wtmp + 1
   END IF
 NEXT i
 IF wtmp = whitecounter% THEN
   IF a$ = CHR$(34) THEN getwordmode% = 1
   endloop = 1
 END IF
LOOP
inmd = 0
b$ = a$
par$ = ""
endloop = 0

DO WHILE NOT endloop = 1
 a$ = GetChar$
 IF a$ = "eof" THEN GetWord$ = b$: getwordmode% = 0:   EXIT FUNCTION

 FOR i = 0 TO whitecounter%
   IF a$ = whitechar(i) THEN GetWord$ = b$: getcharpos = getcharpos - 1:   EXIT FUNCTION
 NEXT i

IF getwordmode% = 0 THEN

 IF a$ = "(" THEN
   DO WHILE NOT endloop2 = 1
     a$ = GetChar$
     IF a$ = CHR$(34) THEN
       IF inmd = 1 THEN
	 inmd = 0: getwordmode% = 0
       ELSE : inmd = 1: getwordmode% = 1
       END IF
     END IF

     IF a$ = "(" AND inmd = 0 THEN parentesis = parentesis + 1
     IF a$ = ")" AND inmd = 0 THEN
       IF parentesis = 0 THEN
	 GetWord$ = b$
	 EXIT FUNCTION
       ELSE : parentesis = parentesis - 1
       END IF
     END IF
     par$ = par$ + a$
   LOOP
 END IF

END IF
 b$ = b$ + a$
LOOP

END FUNCTION

DEFSNG A-Z
SUB ifOther
IF useor% = true THEN

text$ = ortext$(curor%)
getcharpos = 0

kw.if 1

curor% = curor% - 1
useor% = false

END IF
END SUB

SUB Init
CLS
COLOR 9
PRINT "GABasic"; : COLOR 15: PRINT " v" + version$
PRINT "Gabriel Fernandez 2000"
PRINT

IF text$ = "" THEN
  COLOR 9: PRINT "Basic "; : COLOR 15
  INPUT "File: ", basfile$
  IF basfile$ = "" THEN END
  whitechar(0) = "."
    text$ = basfile$
    name$ = GetWord$(par$)
    name$ = UCASE$(name$)
    ext$ = GetWord$(par$)
  whitechar(0) = " "
  IF ext$ = "eof" THEN ext$ = "BAS"
  ext$ = "." + ext$

  COLOR 9: PRINT "Asm"; : COLOR 15: PRINT " File [" + name$ + ".ASM]: ";
  INPUT "", asmfile$
    IF asmfile$ = "" THEN asmfile$ = name$
  COLOR 9: PRINT "EXE"; : COLOR 15: PRINT " File [" + name$ + ".EXE]: ";
  INPUT "", exefile$
    IF exefile$ = "" THEN exefile$ = name$
  IF INSTR(asmfile$, ".") = 0 THEN asmfile$ = asmfile$ + ".ASM"
  IF INSTR(exefile$, ".") = 0 THEN exefile$ = exefile$ + ".EXE"
  basfile$ = name$ + ext$
  EXIT SUB
ELSE
  a$ = GetWord$(par$)
  DO WHILE NOT a$ = "eof"
  SELECT CASE LCASE$(a$)
    CASE "-s": stringsize& = VAL(GetWord$(par$))
    CASE "-asm": asmfile$ = GetWord$(par$)
    CASE "-bas": basfile$ = GetWord$(par$)
    CASE "-exe": exefile$ = GetWord$(par$)
    CASE "-max": max% = VAL(GetWord$(par$))
    CASE "-logtofile"
      logfile$ = GetTempDir$ + "\gabasic.log"
    CASE "-h"
      COLOR 9
      PRINT "GABasic.exe"; : COLOR 15
      PRINT " -bas [file] -asm [file] -exe [file] -s [size] -max [number]"
      PRINT
      PRINT " -bas = Basic file to compile"
      PRINT " -asm = Destination asm file"
      PRINT " -exe(optional) = Destination exe, if omited, no exe will be written"
      PRINT " -s = Set the string block size, read GAbasic.txt for more info"
      PRINT " -max = Set the maximun number of objects, read GAbasic.txt for more info"
      PRINT "        Use this if you get the 'All data objects used' Error"
      PRINT
    END
  END SELECT
  a$ = GetWord$(par$)
  LOOP

  IF INSTR(basfile$, ".") = 0 THEN asmfile$ = asmfile$ + ".BAS"
  IF INSTR(asmfile$, ".") = 0 THEN asmfile$ = asmfile$ + ".ASM"
  IF NOT exefile$ = "" THEN
    IF INSTR(exefile$, ".") = 0 THEN exefile$ = exefile$ + ".EXE"
  END IF
END IF

END SUB

DEFINT A-Z
SUB kw.abssgn (t$, cop, otype)

IF cop = 1 THEN PRINT #2, "PUSH EAX"
  Math.Parser t$, longt

SELECT CASE otype
  CASE 1: PRINT #2, "CALL NEAR ABS"
  CASE 2: PRINT #2, "CALL NEAR SGN"
END SELECT

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

END SUB

SUB kw.asc (t$, cop)

spos = getcharpos
stext$ = text$
text$ = t$
getcharpos = 0
IF cop = 1 THEN PRINT #2, "PUSH EAX"

a$ = GetFullWord$(0)
b$ = GetFullWord$(0)
getcharpos = spos
skiptemp2 a$

IF NOT b$ = "eof" THEN
  PRINT #2, "PUSH EAX"
  Math.Parser b$, longt
  PRINT #2, "POP EBX"
  PRINT #2, "ADD EBX, EAX"
  PRINT #2, "DEC EBX"
  PRINT #2, "MOV EAX, EBX"
  PRINT #2, "XOR EBX, EBX"
  PRINT #2, "MOV BL, [EAX+4]"
ELSE
  PRINT #2, "XOR EBX, EBX"
  PRINT #2, "MOV BL, [EAX+4]"
END IF

IF cop = 1 THEN
  PRINT #2, "POP EAX"
ELSE : PRINT #2, "MOV EAX, EBX"
END IF

decword

getcharpos = spos
text$ = stext$

END SUB

DEFSNG A-Z
SUB kw.asm

DO WHILE NOT endloop = 1
  LINE INPUT #1, text$
  linen& = linen& + 1
  getcharpos = 0
  a$ = LCASE$(GetWord$(par$))
  IF a$ = "endasm" OR a$ = "}" THEN GOTO label9
  IF a$ = "end" AND LCASE$(GetWord$(par$)) = "asm" THEN GOTO label9
  PRINT #2, text$
LOOP

label9:
PRINT #2, "; } End Asm"
EXIT SUB

END SUB

SUB kw.chrS (t$)
Math.Parser t$, longt
PRINT #2, "MOV EBX, EAX"
PRINT #2, "MOV EAX, [spush]"
PRINT #2, "CALL NEAR CHR$"
END SUB

SUB kw.close
a$ = GetWord$(par$)
Math.Parser a$, longt
PRINT #2, "CALL NEAR CloseFile"

END SUB

SUB kw.cls

PRINT #2, "CALL NEAR Cls"

END SUB

SUB kw.color
a$ = GetFullWord$(0)
IF a$ = "eof" THEN show.error 1
Math.Parser a$, longt

b$ = GetFullWord$(0)
PRINT #2, "MOV [spush], ax"

IF NOT b$ = "eof" THEN
  Math.Parser b$, longt
ELSE
  PRINT #2, "MOV AL, [screencolor]"
  PRINT #2, "SHR AL, 4"
  PRINT #2, "AND AL, 15 "'11110000b"
END IF

PRINT #2, "MOV bx, [spush]"
PRINT #2, "SHL al, 4"
PRINT #2, "ADD al, bl"
PRINT #2, "MOV [screencolor], al"

END SUB

SUB kw.do

' --- Una copia de if, para loop

lt$ = GetWord$(par$)
savepos = getcharpos
n$ = GetWord$(par$)

IF LCASE$(lt$) = "while" THEN
  IF NOT UCASE$(n$) = "NOT" THEN
    getcharpos = savepos: n$ = "n"
  ELSE :  n$ = ""
  END IF
ELSEIF LCASE$(lt$) = "until" THEN
  IF NOT UCASE$(n$) = "NOT" THEN
    getcharpos = savepos: n$ = ""
  ELSE :  n$ = "n"
  END IF
ELSE
  show.error 13
END IF

a$ = GetFullWord$(ifmode)
cmptype$ = endword$
b$ = GetFullWord$(ifmode)
SELECT CASE endword$
  CASE ">", "<", "=": cmptype$ = cmptype$ + endword$: b$ = GetFullWord$(ifmode)
END SELECT

' Aca vamos a ver si se va usar de modo de cadenas o de modo de variables

PRINT #2, "dolabel" + LTRIM$(STR$(curdo%)) + ":"

' --- Si es modo de variables
tmp% = Gettype%(a$)
IF tmp% = vart THEN
SELECT CASE cmptype$
  CASE "=<", "<=": CMP$ = "j" + n$ + "le"
  CASE "<", "<": CMP$ = "j" + n$ + "l"
  CASE "=>", ">=": CMP$ = "j" + n$ + "ge"
  CASE ">", ">": CMP$ = "j" + n$ + "g"
  CASE "=": CMP$ = "j" + n$ + "e"
  CASE ELSE: show.error 12
END SELECT
Math.Parser a$, longt
PRINT #2, "PUSH EAX"
Math.Parser b$, longt
PRINT #2, "POP EBX"
PRINT #2, "CMP EBX, EAX"
PRINT #2, UCASE$(CMP$) + " NEAR dolabel" + LTRIM$(STR$(curdo% + 1))

' ********-----------------------------------------------****
ELSE   ' *-------____ Para cadenas _____-----------------****
' ********-----------------------------------------------****
 savetext$ = text$
 savepos2 = getcharpos
 text$ = a$
 getcharpos = 0

 d$ = GetWord$(par$)
 C$ = GetWord$(par$)
	GOSUB label18
 text$ = b$
 getcharpos = 0

 a$ = b$
 d$ = GetWord$(par$)
 C$ = GetWord$(par$)
	GOSUB label18
IF cmptype$ = "=" THEN
  CMP$ = "j" + n$ + "e"
ELSE : show.error 12
END IF

PRINT #2, "MOV EAX, [ifaddress1]"
PRINT #2, "MOV EBX, [ifaddress2]"
PRINT #2, "CALL NEAR CmpStrings"
FOR i = 1 TO tmpused
  PRINT #2, "DEC word [curtmp]"
NEXT i
PRINT #2, "CMP EAX, EBX"
PRINT #2, UCASE$(CMP$) + " NEAR dolabel" + LTRIM$(STR$(curdo% + 1))
END IF

vpush workdo%

curdo% = curdo% + 2
workdo% = curdo%

EXIT SUB

' /
' | Todo Para no copiar una cadena al pedo y hacer el programa
' | mas rapido
' \
label18:
IF NOT C$ = "eof" THEN
usetmp3:
  PRINT #2, "XOR EBX, EBX"
  PRINT #2, "MOV BX, [curtmp]"
  PRINT #2, "MOV EAX, [StringOffset]"
  PRINT #2, "SHL EBX, 10"
  PRINT #2, "INC word [curtmp]"
  PRINT #2, "ADD EAX, EBX"
  IF time = 0 THEN
    PRINT #2, "MOV [ifaddress1], EAX"
  ELSE : PRINT #2, "MOV [ifaddress2], EAX"
  END IF
  tmpused = tmpused + 1
  string.parser a$, tobegin
ELSE
  tmp% = CheckVar%(d$, vartype%)
  IF tmp% = -1 THEN GOTO usetmp3
  IF NOT vartype% = stringt THEN show.error 10

  IF par$ = "" THEN
    PRINT #2, "MOV EAX, [StringOffset" + LTRIM$(STR$(tmp%)) + "]"
  ELSE
    Math.Parser par$, longt
    PRINT #2, "MOV EBX, [StringMax" + LTRIM$(STR$(tmp%)) + "]"
    PRINT #2, "MUL EBX"
    PRINT #2, "ADD EAX, [StringOffset" + LTRIM$(STR$(tmp%)) + "]"
  END IF

  IF time = 0 THEN
    PRINT #2, "MOV [ifaddress1], EAX"
  ELSE : PRINT #2, "MOV [ifaddress2], EAX"
  END IF
END IF
time = 1
RETURN


END SUB

SUB kw.else

elseav% = 1
PRINT #2, "JMP NEAR iflabel" + LTRIM$(STR$(workif% - 1))
PRINT #2, "iflabel" + LTRIM$(STR$(workif% - 2)) + ":"
ifOther

END SUB

SUB kw.end
a$ = GetWord$(par$)

SELECT CASE LCASE$(a$)
CASE "eof"
  PRINT #2, "XOR AX, AX"
  PRINT #2, "CALL NEAR EndProgram"
CASE "sub"
  PRINT #2, "RET"
CASE "if"
  IF elseav% = 0 THEN
    PRINT #2, "JMP NEAR iflabel" + LTRIM$(STR$(workif% - 1))
    PRINT #2, "iflabel" + LTRIM$(STR$(workif% - 2)) + ":"
  ELSE
    PRINT #2, "iflabel" + LTRIM$(STR$(workif% - 1)) + ":"
  END IF
  ifOther
  IF elseav% = 0 THEN PRINT #2, "iflabel" + LTRIM$(STR$(workif% - 1)) + ":"
  VPop workor%
  VPop useor%
  VPop workif%
  VPop elseav%
END SELECT

END SUB

SUB kw.exit
a$ = GetWord$(par$)
SELECT CASE LCASE$(a$)
  CASE "sub": PRINT #2, "RET"
  CASE "do": PRINT #2, "JMP NEAR dolabel" + LTRIM$(STR$(workdo% - 1))
  CASE "for": PRINT #2, "JMP NEAR nextfor" + LTRIM$(STR$(workfor%))
  CASE ELSE: show.error 100
END SELECT
END SUB

SUB kw.fillbox (boxtype%)
a$ = GetFullWord$(0)
b$ = GetFullWord$(0)
C$ = GetFullWord$(0)
d$ = GetFullWord$(0)
e$ = GetFullWord$(0)

Math.Parser d$, longt
PRINT #2, "PUSH EAX"
Math.Parser b$, longt
PRINT #2, "PUSH EAX"
Math.Parser e$, longt
PRINT #2, "PUSH EAX"
Math.Parser C$, longt
PRINT #2, "PUSH EAX"
Math.Parser a$, longt
PRINT #2, "POP EBX"
PRINT #2, "POP ECX"
PRINT #2, "POP EDX"
PRINT #2, "POP EDI"
IF boxtype% = 1 THEN PRINT #2, "CALL NEAR Fillbox"
IF boxtype% = 2 THEN PRINT #2, "CALL NEAR Box"
END SUB

SUB kw.for

a$ = GetFullWord$(formode)
b$ = GetFullWord$(formode)
C$ = GetFullWord$(formodes)
d$ = GetFullWord$(0)

IF NOT workfor% = -1 THEN
  PRINT #2, "PUSH WORD [fortmp]"
END IF

  Math.Parser C$, longt
  PRINT #2, "MOV [fortmp], EAX"

IF MID$(d$, 1, 1) = "-" THEN
  tmp$ = a$ + " = " + b$ + "+ " + MID$(d$, 2, LEN(d$) - 1)
  tmp2$ = a$ + " = " + a$ + "- " + MID$(d$, 2, LEN(d$) - 1)
  mode% = subs
ELSEIF d$ = "eof" THEN
  tmp$ = a$ + " = " + b$ + "- " + "1"
  tmp2$ = a$ + " = " + a$ + "+ " + "1"
  mode% = add
ELSE
  tmp$ = a$ + " = " + b$ + "- " + d$
  tmp2$ = a$ + " = " + a$ + "+ " + d$
  mode% = add
END IF

  emumain tmp$

PRINT #2, "for" + LTRIM$(STR$(curfor%)) + ":"
  emumain tmp2$
  vpush workfor%
  vpush mode%
  spush a$
  workfor% = curfor%
  curfor% = curfor% + 1

END SUB

DEFINT A-Z
SUB kw.getcmd (ctype)

SELECT CASE ctype
CASE 1: PRINT #2, "CALL NEAR Getexepath"
CASE 2: PRINT #2, "CALL NEAR Getcommandline"
END SELECT

END SUB

SUB kw.getmaxres (cop, restype)

IF restype = 1 THEN tmp$ = "[maxx]"
IF restype = 2 THEN tmp$ = "[maxy]"

IF cop = 0 THEN
  PRINT #2, "mov eax, " + tmp$
ELSE
  PRINT #2, "mov ebx, " + tmp$
END IF

END SUB

SUB kw.getput (mode, memmode)

a$ = GetFullWord$(0)
b$ = GetFullWord$(0)
C$ = GetFullWord$(0)
d$ = GetFullWord$(0)

IF d$ = "eof" THEN
  fhandle$ = a$
  pos$ = b$
  Dest$ = C$
ELSE
  fhandle$ = a$
  bytes$ = b$
  pos$ = C$
  Dest$ = d$
END IF

stext$ = text$
text$ = Dest$
savepos = getcharpos
getcharpos = 0
  Dest$ = GetWord$(par$)
text$ = pos$
getcharpos = 0
  tmp$ = GetWord$(par$)
getcharpos = savepos
text$ = stext$

IF NOT memmode = true THEN
tmp = CheckVar(Dest$, vartype)
IF NOT tmp >= 0 THEN show.error 6
SELECT CASE vartype
  CASE intt: PRINT #2, "MOV EBX, IntVar" + LTRIM$(STR$(tmp)): PRINT #2, "MOV ecx, 2"
  CASE longt:  PRINT #2, "MOV EBX, LongVar" + LTRIM$(STR$(tmp)): PRINT #2, "MOV ecx, 4"
  CASE stringt  ' ----------------------- Strings
  IF NOT par$ = "" AND GetStringType(Dest$) = arrayt THEN
    PRINT #2, "PUSH EAX"
    Math.Parser par$, longt
    PRINT #2, "MOV EBX, [StringMax" + LTRIM$(STR$(tmp)) + "]"
    PRINT #2, "MUL EBX"
    PRINT #2, "ADD EAX, [StringOffset" + LTRIM$(STR$(tmp)) + "]"
    PRINT #2, "MOV EBX, EAX"
    PRINT #2, "POP EAX"
  ELSE
    PRINT #2, "MOV EBX, [StringOffset" + LTRIM$(STR$(tmp)) + "]"
  END IF
  IF NOT bytes$ = "" THEN
    PRINT #2, "PUSH EBX"
    Math.Parser bytes$, longt
    PRINT #2, "MOV ECX, EAX"
    PRINT #2, "MOV [EBX], EAX"
    PRINT #2, "POP EBX"
  ELSE
    PRINT #2, "MOV ECX, [EBX]"
  END IF
  PRINT #2, "ADD EBX, 4"
  CASE arrayt    ' -------------------- Arrays
    arraytype = GetArrayType%(Dest$)
    PRINT #2, "PUSH EAX"
    Math.Parser par$, longt
    IF arraytype = intt THEN PRINT #2, "SHL EAX, 1": Ereg$ = ""
    IF arraytype = longt THEN PRINT #2, "SHL EAX, 2": Ereg$ = "E"
    PRINT #2, "MOV EBX, [ArrayOffset" + LTRIM$(STR$(tmp)) + "]"
    PRINT #2, "ADD EBX, EAX"
    PRINT #2, "POP EAX"
  IF bytes$ = "" THEN
    IF arraytype = bytet THEN PRINT #2, "MOV ecx, 1"
    IF arraytype = intt THEN PRINT #2, "MOV ecx, 2"
    IF arraytype = longt THEN PRINT #2, "MOV ecx, 4"
  END IF
END SELECT
ELSE
  Math.Parser d$, longt
  PRINT #2, "PUSH EAX"
  Math.Parser bytes$, longt
  PRINT #2, "mov ecx, eax"
  PRINT #2, "POP EBX"
END IF

Math.Parser fhandle$, longt

IF NOT tmp$ = "eof" THEN
  PRINT #2, "PUSH EAX"
  PRINT #2, "PUSH EBX"
  PRINT #2, "PUSH ECX"
  PRINT #2, "PUSH eax"
  PRINT #2, "Shl eax, 1"
  PRINT #2, "add eax, filehandle"
  PRINT #2, "mov bx, [eax]"
  PRINT #2, "PUSH EBX"
  Math.Parser pos$, longt
  PRINT #2, "mov ebx, tmp"
  PRINT #2, "DEC eax"
  PRINT #2, "mov [ebx], eax"
  PRINT #2, "mov cx, [ebx+2]"
  PRINT #2, "mov dx, [ebx]"
  PRINT #2, "POP EBX"
  PRINT #2, "mov ax, 4200h"
  PRINT #2, "INT 21H"
  PRINT #2, "POP EBX"
  PRINT #2, "Shl ebx, 2"
  PRINT #2, "ADD EBX, filepos"
  PRINT #2, "MOV [EBX], ax"
  PRINT #2, "MOV [EBX+2], dx"
  PRINT #2, "POP ECX"
  PRINT #2, "POP EBX"
  PRINT #2, "POP EAX"
END IF

IF mode = 1 THEN PRINT #2, "CALL NEAR Get"
IF mode = 2 THEN PRINT #2, "CALL NEAR Put"

END SUB

SUB kw.getvect (t$, cop)
IF cop = 1 THEN PRINT #2, "PUSH EAX"

Math.Parser t$, longt

PRINT #2, "MOV BL, AL"
PRINT #2, "MOV AX, 204h"
PRINT #2, "INT 31h"

IF cop = 1 THEN
  PRINT #2, "MOV EBX, EDX"
  PRINT #2, "POP EAX"
ELSE
  PRINT #2, "MOV EAX, EDX"
END IF
END SUB

DEFSNG A-Z
SUB kw.gosub
a$ = GetWord$(par$)
IF a$ = "eof" THEN show.error 1
PRINT #2, "GOSUB " + a$

END SUB

SUB kw.goto
a$ = GetWord$(par$)
IF a$ = "eof" THEN show.error 1
PRINT #2, "GOTO " + a$
END SUB

DEFINT A-Z
SUB kw.if (mode)

tmpor = false

label19:
savepos = getcharpos
n$ = GetWord$(par$)

IF NOT UCASE$(n$) = "NOT" THEN
  getcharpos = savepos: n$ = "n"
ELSE : n$ = ""
END IF

IF mode = 1 THEN
  IF n$ = "n" THEN
    n$ = ""
  ELSE : n$ = "n"
  END IF
END IF

a$ = GetFullWord$(ifmode)
cmptype$ = endword$
b$ = GetFullWord$(ifmode)
cont$ = endword$

SELECT CASE endword$
  CASE ">", "<", "=": cmptype$ = cmptype$ + endword$: b$ = GetFullWord$(ifmode)
END SELECT

' Aca vamos a ver si se va usar de modo de cadenas o de modo de variables

' ********-----------------------------------------------****
' ********-------____ Para variables _____---------------****
' ********-----------------------------------------------****

tmp% = Gettype%(a$)
IF tmp% = vart THEN

SELECT CASE cmptype$
  CASE "<>"
    IF NOT UCASE$(n$) = "NOT" THEN
      getcharpos = savepos: n$ = "n"
    ELSE : n$ = ""
    END IF
    CMP$ = "j" + n$ + "le"
  CASE "=<", "<=": CMP$ = "j" + n$ + "le"
  CASE "<", "<": CMP$ = "j" + n$ + "l"
  CASE "=>", ">=": CMP$ = "j" + n$ + "ge"
  CASE ">", ">": CMP$ = "j" + n$ + "g"
  CASE "=": CMP$ = "j" + n$ + "e"
  CASE ELSE: show.error 12
END SELECT

Math.Parser a$, longt
PRINT #2, "PUSH EAX"
Math.Parser b$, longt
PRINT #2, "POP EBX"
PRINT #2, "CMP EBX, EAX"

IF mode = 0 THEN    ' Para OR
  PRINT #2, UCASE$(CMP$) + " NEAR iflabel" + LTRIM$(STR$(curif%))
ELSE
  PRINT #2, UCASE$(CMP$) + " NEAR iforlabel" + LTRIM$(STR$(workor%))
END IF

IF cont$ = "&" THEN GOTO label19  ' Para AND

IF cont$ = "|" THEN
  IF mode = 1 THEN
    text$ = MID$(text$, getcharpos + 1, LEN(text$) - getcharpos)
    getcharpos = 0
    kw.if 1
  ELSE
    curor% = curor% + 1
    ortext$(curor%) = MID$(text$, getcharpos + 1, LEN(text$) - getcharpos)
    tmpor = true

    w$ = ""
    DO WHILE NOT LCASE$(w$) = "then"
      w$ = GetWord$(par$)
    LOOP
  END IF
END IF

' ********-----------------------------------------------****
ELSE   ' *-------____ Para cadenas _____-----------------****
' ********-----------------------------------------------****
 savetext$ = text$
 savepos2 = getcharpos
 text$ = a$
 getcharpos = 0

 d$ = GetWord$(par$)
 C$ = GetWord$(par$)
	GOSUB label16
 text$ = b$
 getcharpos = 0

 a$ = b$
 d$ = GetWord$(par$)
 C$ = GetWord$(par$)
	GOSUB label16
IF cmptype$ = "=" THEN
  CMP$ = "j" + n$ + "e"
ELSE : show.error 12
END IF
		    
PRINT #2, "MOV EAX, [ifaddress1]"
PRINT #2, "MOV EBX, [ifaddress2]"
PRINT #2, "CALL NEAR CmpStrings"
FOR i = 1 TO tmpused
  PRINT #2, "DEC word [curtmp]"
NEXT i
PRINT #2, "CMP EAX, EBX"

IF mode = 0 THEN
  PRINT #2, UCASE$(CMP$) + " NEAR iflabel" + LTRIM$(STR$(curif%))
ELSE
  PRINT #2, UCASE$(CMP$) + " NEAR iforlabel" + LTRIM$(STR$(workor%))
END IF

text$ = savetext$
getcharpos = savepos2

  IF cont$ = "&" THEN
    IF NOT compmode% = distribute THEN PRINT #2, "; ---- Next if (AND)"
    tmpused = 0
    GOTO label19   ' Para AND(&)
  END IF

IF cont$ = "|" THEN
IF mode = 1 THEN
  text$ = MID$(text$, getcharpos + 1, LEN(text$) - getcharpos)
  getcharpos = 0
  kw.if 1
ELSE
  curor% = curor% + 1
  ortext$(curor%) = MID$(text$, getcharpos + 1, LEN(text$) - getcharpos)
  tmpor = true

  w$ = ""
  DO WHILE NOT LCASE$(w$) = "then"
    w$ = GetWord$(par$)
  LOOP
END IF
END IF

' //----------------------------------------\\
END IF ' --------*** FIN DEL IF PARA CADENAS -
' \\----------------------------------------//

IF mode = 0 THEN
vpush elseav%
vpush workif%
vpush useor%
vpush workor%

useor% = tmpor
curif% = curif% + 2
workif% = curif%
workor% = curorlabel%
curorlabel% = curorlabel% + 1

elseav% = 0

spos = getcharpos
tmp$ = GetWord$(a$)
IF NOT tmp$ = "eof" THEN
  getcharpos = 0
  text$ = MID$(text$, spos + 1, LEN(text$) - spos)
  processagain% = true
END IF

PRINT #2, "iforlabel" + LTRIM$(STR$(workor%)) + ":"
END IF
EXIT SUB

' /
' | Todo Para no copiar una cadena al pedo
' \
label16:
IF NOT C$ = "eof" THEN
usetmp2:
  PRINT #2, "XOR EBX, EBX"
  PRINT #2, "MOV BX, [curtmp]"
  PRINT #2, "MOV EAX, [StringOffset]"
  PRINT #2, "SHL EBX, 10"
  PRINT #2, "INC word [curtmp]"
  PRINT #2, "ADD EAX, EBX"
  IF time = 0 THEN
    PRINT #2, "MOV [ifaddress1], EAX"
  ELSE : PRINT #2, "MOV [ifaddress2], EAX"
  END IF
  tmpused = tmpused + 1
  string.parser a$, tobegin
ELSE
  tmp% = CheckVar%(d$, vartype%)
  IF tmp% = -1 THEN GOTO usetmp2
  IF NOT vartype% = stringt THEN show.error 10

  IF par$ = "" THEN
    PRINT #2, "MOV EAX, [StringOffset" + LTRIM$(STR$(tmp%)) + "]"
  ELSE
    Math.Parser par$, longt
    PRINT #2, "MOV EBX, [StringMax" + LTRIM$(STR$(tmp%)) + "]"
    PRINT #2, "MUL EBX"
    PRINT #2, "ADD EAX, [StringOffset" + LTRIM$(STR$(tmp%)) + "]"
  END IF

  IF time = 0 THEN
    PRINT #2, "MOV [ifaddress1], EAX"
  ELSE : PRINT #2, "MOV [ifaddress2], EAX"
  END IF
END IF
time = 1
RETURN

END SUB

SUB kw.inkey (cop)
IF NOT cop = 0 THEN
  PRINT #2, "PUSH EAX"
END IF

PRINT #2, "CALL NEAR Inkey"

IF NOT cop = 0 THEN
  PRINT #2, "MOV EBX, EAX"
  PRINT #2, "POP EAX"
END IF

END SUB

SUB kw.inp (t$, ptype, cop)

IF cop = 1 THEN PRINT #2, "PUSH EAX"
Math.Parser t$, longt
PRINT #2, "MOV EDX, EAX"

SELECT CASE ptype
  CASE Byte: PRINT #2, "MOV EAX, 0": PRINT #2, "IN AL, DX"
  CASE intt: PRINT #2, "MOV EAX, 0": PRINT #2, "IN AX, DX"
  CASE longt: PRINT #2, "IN EAX, DX"
END SELECT

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

END SUB

SUB kw.killdir (mode)
a$ = GetFullWord$(0)
a$ = a$ + " + CHR$(0)"

PRINT #2, "XOR EBX, EBX"
PRINT #2, "MOV BX, [curtmp]"
PRINT #2, "MOV EAX, [StringOffset]"
PRINT #2, "SHL EBX, 10"
PRINT #2, "INC word [curtmp]"
PRINT #2, "ADD EAX, EBX"
string.parser a$, tobegin
PRINT #2, "ADD EAX, 4"
PRINT #2, "MOV EDX, EAX"

SELECT CASE mode
  CASE 1
    PRINT #2, "MOV AH, 41h"     ' Kill
    PRINT #2, "INT 21h"
  CASE 2
    PRINT #2, "MOV AH, 39h"     ' Make dir
    PRINT #2, "INT 21h"
  CASE 3
    PRINT #2, "MOV AH, 3Ah"     ' Del dir
    PRINT #2, "INT 21h"
  CASE 4
    PRINT #2, "MOV AH, 3Bh"     ' Change dir
    PRINT #2, "INT 21h"
END SELECT

END SUB

SUB kw.len (t$, cop)

IF cop = 1 THEN PRINT #2, "PUSH EAX"

PRINT #2, "XOR EBX, EBX"
PRINT #2, "MOV BX, [curtmp]"
PRINT #2, "MOV EAX, [StringOffset]"
PRINT #2, "SHL EBX, 10"
PRINT #2, "INC word [curtmp]"
PRINT #2, "ADD EAX, EBX"

string.parser t$, tobegin

IF cop = 1 THEN
  PRINT #2, "MOV EAX, [StringOffset]"
  PRINT #2, "MOV EBX, [EAX]"
  PRINT #2, "POP EAX"
ELSE
  PRINT #2, "MOV EBX, [StringOffset]"
  PRINT #2, "MOV EAX, [EBX]"
END IF

PRINT #2, "DEC word [curtmp]"

END SUB

SUB kw.line
spos = getcharpos
a$ = GetWord$(par$)
IF LCASE$(a$) = "input" THEN GOTO lineinput
getcharpos = spos

' -------------- LINE (vga) --------------

a$ = GetFullWord$(0)
b$ = GetFullWord$(0)
C$ = GetFullWord$(0)
d$ = GetFullWord$(0)
e$ = GetFullWord$(0)

Math.Parser e$, longt
PRINT #2, "MOV EDI, EAX"
Math.Parser d$, longt
PRINT #2, "PUSH EAX"
Math.Parser C$, longt
PRINT #2, "PUSH EAX"
Math.Parser b$, longt
PRINT #2, "PUSH EAX"
Math.Parser a$, longt
PRINT #2, "POP EBX"
PRINT #2, "POP ECX"
PRINT #2, "POP EDX"
PRINT #2, "CALL NEAR line"
EXIT SUB

lineinput:   ' ------------- LINE INPUT
a$ = GetFullWord$(0)
b$ = GetFullWord$(0)

Math.Parser "VARPTR(" + LTRIM$(b$) + ")", longt
PRINT #2, "PUSH EAX"
Math.Parser a$, longt
PRINT #2, "POP EBX"
PRINT #2, "CALL NEAR FileInput"
END SUB

DEFSNG A-Z
SUB kw.locate
a$ = GetFullWord$(0)
Math.Parser a$, intt

PRINT #2, "DEC AX"
PRINT #2, "MOV WORD [texty], AX"
a$ = GetFullWord$(0)
Math.Parser a$, intt
PRINT #2, "DEC AX"
PRINT #2, "MOV WORD [textx], AX"


END SUB

DEFINT A-Z
SUB kw.lof (t$, cop)
IF cop = 1 THEN PRINT #2, "PUSH EAX"

Math.Parser t$, longt
PRINT #2, "CALL Lof"

IF cop = 1 THEN
  PRINT #2, "POP Eax"
ELSE : PRINT #2, "MOV EAX, EBX"
END IF
END SUB

DEFSNG A-Z
SUB kw.loop

PRINT #2, "JMP NEAR dolabel" + LTRIM$(STR$(workdo% - 2))
PRINT #2, "dolabel" + LTRIM$(STR$(workdo% - 1)) + ":"
VPop workdo%

END SUB

SUB kw.lucase (t$, mode%)
skiptemp2 t$
PRINT #2, "MOV ebx, eax"
PRINT #2, "MOV eax, [spush]"
IF mode% = 1 THEN PRINT #2, "CALL NEAR Lcase$"
IF mode% = 2 THEN PRINT #2, "CALL NEAR Ucase$"
decword
getcharpos = spos
text$ = st$
END SUB

DEFINT A-Z
SUB kw.memcopy (ctype)
a$ = GetFullWord$(0)
b$ = GetFullWord$(0)
C$ = GetFullWord$(0)

Math.Parser C$, longt
PRINT #2, "PUSH EAX"
Math.Parser b$, longt
PRINT #2, "PUSH EAX"
Math.Parser a$, longt

PRINT #2, "POP EBX"
PRINT #2, "POP ECX"

SELECT CASE ctype
  CASE Byte: PRINT #2, "Call NEAR Memcopy"
  CASE intt: PRINT #2, "Call NEAR Memcopyw"
  CASE longt: PRINT #2, "Call NEAR Memcopyd"
END SELECT

END SUB

SUB kw.memfill (ctype)

a$ = GetFullWord$(0)
b$ = GetFullWord$(0)
C$ = GetFullWord$(0)

Math.Parser b$, longt
PRINT #2, "PUSH EAX"
Math.Parser a$, longt
PRINT #2, "PUSH EAX"
Math.Parser C$, longt

PRINT #2, "POP EBX"
PRINT #2, "POP ECX"

SELECT CASE ctype
  CASE Byte: PRINT #2, "Call NEAR Memfill"
  CASE intt: PRINT #2, "Call NEAR Memfillw"
  CASE longt: PRINT #2, "Call NEAR Memfilld"
END SELECT

END SUB

SUB kw.mid (t$)
savepos = getcharpos
stext$ = text$
text$ = t$
getcharpos = 0

a$ = GetFullWord$(0)
b$ = GetFullWord$(0)
C$ = GetFullWord$(0)
getcharpos = 0
IF a$ = "eof" OR C$ = "eof" OR b$ = "eof" THEN show.error 1
text$ = a$
getcharpos = 0
b1$ = GetWord$(par$)
c1$ = GetWord$(par$)

PRINT #2, "PUSH WORD [spush]"

' -------------------------------------------
  Math.Parser b$, longt
  PRINT #2, "PUSH EAX"
  Math.Parser C$, longt
  PRINT #2, "PUSH EAX"
' -------------------------------------------

IF NOT c1$ = "eof" THEN
usetmp4:
  PRINT #2, "XOR EBX, EBX"
  PRINT #2, "MOV BX, [curtmp]"
  PRINT #2, "MOV EAX, [StringOffset]"
  PRINT #2, "SHL EBX, 10"
  PRINT #2, "INC word [curtmp]"
  PRINT #2, "ADD EAX, EBX"
  PRINT #2, "PUSH EAX"
  string.parser a$, tobegin
  PRINT #2, "POP EAX"
  PRINT #2, "DEC word [curtmp]"
EXIT SUB
ELSE
  tmp% = CheckVar%(b1$, vartype%)
  IF tmp% = -1 THEN GOTO usetmp4
  IF NOT vartype% = stringt THEN show.error 10

  IF par$ = "" THEN
    PRINT #2, "MOV EAX, [StringOffset" + LTRIM$(STR$(tmp%)) + "]"
  ELSE
    Math.Parser par$, longt
    PRINT #2, "MOV EBX, [StringMax" + LTRIM$(STR$(tmp%)) + "]"
    PRINT #2, "MUL EBX"
    PRINT #2, "ADD EAX, [StringOffset" + LTRIM$(STR$(tmp%)) + "]"
  END IF
END IF

PRINT #2, "POP ECX"
PRINT #2, "POP EBX"
PRINT #2, "POP WORD [spush]"
PRINT #2, "MOV EDX, [spush]"

PRINT #2, "CALL NEAR MID$"

text$ = stext$
getcharpos = savepos

END SUB

SUB kw.mousedat (mmode, cop)
PRINT #2, "MOV EBX, 0"
IF NOT cop = 0 THEN PRINT #2, "PUSH EAX"
SELECT CASE mmode
   CASE 1
      PRINT #2, "Call Mousebutton"
      PRINT #2, "AND BX, 1"
   CASE 2
      PRINT #2, "Call Mousebutton"
      PRINT #2, "AND BX, 2"
      PRINT #2, "SHR BX, 1"
   CASE 3: PRINT #2, "CALL Getmousex"
   CASE 4: PRINT #2, "CALL Getmousey"
END SELECT
IF NOT cop = 0 THEN
  PRINT #2, "POP EAX"
ELSE
  PRINT #2, "MOV EAX, EBX"
END IF
END SUB

SUB kw.mouseexist (cop)

SELECT CASE cop
  CASE 0
    PRINT #2, "MOV EAX, 0"
    PRINT #2, "INT 33h"
  CASE ELSE
    PRINT #2, "PUSH EAX"
    PRINT #2, "MOV EAX, 0"
    PRINT #2, "INT 33h"
    PRINT #2, "MOV EBX, EAX"
    PRINT #2, "POP EAX"
END SELECT

END SUB

DEFSNG A-Z
SUB kw.next
SPop a$
VPop mode%
Math.Parser a$, longt
PRINT #2, "MOV EBX, [fortmp]"
PRINT #2, "CMP EAX, EBX"

IF mode% = add THEN
  PRINT #2, "JNGE NEAR for" + LTRIM$(STR$(workfor%))
  PRINT #2, "nextfor" + LTRIM$(STR$(workfor%)) + ":"
ELSE
  PRINT #2, "JNLE NEAR for" + LTRIM$(STR$(workfor%))
  PRINT #2, "nextfor" + LTRIM$(STR$(workfor%)) + ":"
END IF

VPop workfor%
IF NOT workfor% = -1 THEN
  PRINT #2, "POP WORD [fortmp]"
END IF
END SUB

SUB kw.open

a$ = GetFullWord$(openmode)
a$ = a$ + " + CHR$(0)"

mode$ = GetWord$(par$)
SELECT CASE LCASE$(mode$)
  CASE "binary", "input", "output"
  CASE ELSE: show.error 15
END SELECT
t$ = GetWord$(par$)
IF NOT LCASE$(t$) = "as" THEN show.error 20
b$ = GetFullWord$(0)

PRINT #2, "XOR EBX, EBX"
PRINT #2, "MOV BX, [curtmp]"
PRINT #2, "MOV EAX, [StringOffset]"
PRINT #2, "SHL EBX, 10"
PRINT #2, "INC word [curtmp]"
PRINT #2, "ADD EAX, EBX"
string.parser a$, tobegin
PRINT #2, "PUSH EAX"
Math.Parser b$, longt
PRINT #2, "POP EBX"

PRINT #2, "CALL NEAR OpenFile"
PRINT #2, "DEC word [curtmp]"

END SUB

SUB kw.out (outtype%)
a$ = GetFullWord$(0)
b$ = GetFullWord$(0)

Math.Parser a$, longt
'PRINT #2, "MOV EAX, EBX"
'PRINT #2, "MOV EDX, EAX"
PRINT #2, "PUSH EAX"
Math.Parser b$, longt
PRINT #2, "POP EDX"
SELECT CASE outtype%
  CASE Byte: PRINT #2, "OUT DX, AL"
  CASE intt: PRINT #2, "OUT DX, AX"
  CASE longt: PRINT #2, "OUT DX, EAX"
END SELECT

END SUB

DEFINT A-Z
SUB kw.peek (t$, ptype, cop)

IF cop = 1 THEN PRINT #2, "PUSH EAX"
Math.Parser t$, longt

SELECT CASE ptype
  CASE Byte: PRINT #2, "XOR EBX, EBX": PRINT #2, "MOV BL, [EAX]"
  CASE intt: PRINT #2, "XOR EBX, EBX": PRINT #2, "MOV BX, [EAX]"
  CASE longt: PRINT #2, "MOV EBX, [EAX]"
END SELECT

IF cop = 1 THEN
  PRINT #2, "POP EAX"
ELSE
  PRINT #2, "MOV EAX, EBX"
END IF

END SUB

SUB kw.point (t$, cop)

stext$ = text$
text$ = t$
savepos = getcharpos
getcharpos = 0

a$ = GetFullWord$(0)
b$ = GetFullWord$(0)

IF a$ = "eof" OR b$ = "eof" THEN show.error 1
IF cop = 1 THEN PRINT #2, "PUSH EAX"

Math.Parser b$, longt
PRINT #2, "PUSH EAX"
Math.Parser a$, longt
PRINT #2, "POP EBX"

PRINT #2, "CALL NEAR Point"

IF cop = 1 THEN PRINT #2, "MOV ECX, EAX": PRINT #2, "POP EAX"

END SUB

SUB kw.poke (ptype)

a$ = GetFullWord$(0)
b$ = GetFullWord$(0)

Math.Parser a$, longt
PRINT #2, "PUSH EAX"
Math.Parser b$, longt
PRINT #2, "POP EBX"
SELECT CASE ptype
  CASE Byte: PRINT #2, "MOV [EBX], AL"
  CASE intt: PRINT #2, "MOV [EBX], AX"
  CASE longt: PRINT #2, "MOV [EBX], EAX"
END SELECT

END SUB

SUB kw.print

spos = getcharpos
a$ = GetFullWord$(0)
tmp = Gettype(a$)

IF NOT tmp = vart THEN
  getcharpos = spos
  Skiptemp
  PRINT #2, "CALL NEAR Print"
  decword
ELSE
  Skiptemp
  PRINT #2, "PUSH EAX"
  Math.Parser a$, longt
  PRINT #2, "POP EBX"
  PRINT #2, "CALL NEAR Fileprint"
  decword
END IF

END SUB

DEFSNG A-Z
SUB kw.pset
' AX = x
' BX = y
' CX = C

a$ = GetFullWord$(0)
b$ = GetFullWord$(0)
C$ = GetFullWord$(0)

Math.Parser C$, longt
PRINT #2, "PUSH EAX"
Math.Parser b$, longt
PRINT #2, "PUSH EAX"
Math.Parser a$, longt
PRINT #2, "POP EBX"
PRINT #2, "POP ECX"
PRINT #2, "CALL NEAR Pset"

END SUB

SUB kw.randomize
a$ = GetFullWord$(0)
Math.Parser a$, longt

PRINT #2, "mov [Rand3], ax"
PRINT #2, "mov bx, 3"
PRINT #2, "mov dx, 0"
PRINT #2, "div bx"
PRINT #2, "mov [Rand1], ax"
PRINT #2, "shl ax, 1"
PRINT #2, "mov [Rand2], ax"

END SUB

DEFINT A-Z
SUB kw.rnd (t$, cop, RegType)

IF cop = 1 THEN PRINT #2, "PUSH EAX"
IF RegType = longt THEN PRINT #2, "XOR EAX, EAX"

Math.Parser t$, intt

PRINT #2, "CALL NEAR RND"

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


END SUB

DEFSNG A-Z
SUB kw.screen
a$ = GetFullWord$(0)

Math.Parser a$, longt

PRINT #2, "CALL NEAR Screen"

END SUB

DEFINT A-Z
SUB kw.seek (t$, cop)

IF cop = 1 THEN PRINT #2, "PUSH EAX"
Math.Parser t$, longt

PRINT #2, "SHL EAX, 2"
PRINT #2, "ADD EAX, filepos"
PRINT #2, "MOV EBX, [EAX]"
PRINT #2, "INC EBX"

IF cop = 1 THEN
  PRINT #2, "POP EAX"
ELSE : PRINT #2, "MOV EAX, EBX"
END IF

END SUB

DEFSNG A-Z
SUB kw.setclip
a$ = GetFullWord$(0)
b$ = GetFullWord$(0)
C$ = GetFullWord$(0)
d$ = GetFullWord$(0)

Math.Parser a$, longt
PRINT #2, "MOV [ClipX1], eax"
Math.Parser b$, longt
PRINT #2, "MOV [ClipY1], eax"
Math.Parser C$, longt
PRINT #2, "MOV [ClipX2], eax"
Math.Parser d$, longt
PRINT #2, "MOV [ClipY2], eax"

END SUB

SUB kw.setcol

' EAX, Col  EBX, R   ECX, G  EDX, B

a$ = GetFullWord$(0)
b$ = GetFullWord$(0)
C$ = GetFullWord$(0)
d$ = GetFullWord$(0)

Math.Parser d$, longt
PRINT #2, "PUSH EAX"
Math.Parser C$, longt
PRINT #2, "PUSH EAX"
Math.Parser b$, longt
PRINT #2, "PUSH EAX"
Math.Parser a$, longt
PRINT #2, "POP EBX"
PRINT #2, "POP ECX"
PRINT #2, "POP EDX"

PRINT #2, "CALL NEAR SetCol"


END SUB

SUB kw.setstring

a$ = GetFullWord$(0)
IF a$ = "" THEN show.error 1
Math.Parser a$, longt
PRINT #2, "MOV [StringSize], EAX"

END SUB

SUB kw.settranscolor
a$ = GetFullWord$(0)
Math.Parser a$, longt
PRINT #2, "MOV [transcolor], ax"
END SUB

SUB kw.setvect
a$ = GetFullWord$(0)
b$ = GetFullWord$(0)

stext$ = text$
text$ = b$
savepos = getcharpos
getcharpos = 0
  C$ = GetWord$(par$)
getcharpos = savepos
text$ = stext$

Math.Parser a$, longt
PRINT #2, "MOV BL, AL"

IF MID$(C$, 1, 1) = "@" THEN
  PRINT #2, "MEMADR " + MID$(C$, 2, LEN(C$) - 1)
ELSE
  Math.Parser b$, longt
  PRINT #2, "MOV EDX, EAX"
END IF

PRINT #2, "MOV CX, DS"
PRINT #2, "MOV AX, 205h"
PRINT #2, "INT 31h"

END SUB

SUB kw.setvoffs
Math.Parser GetFullWord$(0), longt
PRINT #2, "MOV [vaddress], eax"

END SUB

SUB kw.shell

a$ = GetFullWord$(0)
b$ = GetFullWord$(0)

a$ = a$ + " + CHR$(0)"
b$ = b$ + " + CHR$(0Dh)"

skiptemp2 b$
PRINT #2, "PUSH EAX"
skiptemp2 a$
PRINT #2, "POP EBX"
PRINT #2, "CALL Shell"

decword
decword

END SUB

SUB kw.str (par$)

Math.Parser par$, longt

PRINT #2, "MOV EBX, EAX"
PRINT #2, "MOV EAX, [spush]"
PRINT #2, "CALL NEAR STR$"
END SUB

DEFINT A-Z
SUB kw.string (t$)
stext$ = text$
spos = getcharpos
getcharpos = 0
text$ = t$

a$ = GetFullWord$(0)
b$ = GetFullWord$(0)

Math.Parser a$, longt
PRINT #2, "PUSH EAX"

IF Gettype(b$) = vart THEN
  Math.Parser b$, longt
  PRINT #2, "MOV EBX, EAX"
ELSE
  skiptemp2 b$
  PRINT #2, "MOV BL, [EAX+4]"
  decword
END IF

PRINT #2, "POP ECX"
PRINT #2, "MOV EAX, [spush]"
PRINT #2, "CALL String$"

getcharpos = spos
text$ = stext$
END SUB

SUB kw.timer (cop)
IF cop = 1 THEN PRINT #2, "PUSH EAX"
PRINT #2, "CALL NEAR Timer"

IF cop = 1 THEN PRINT #2, "MOV EBX, EAX": PRINT #2, "POP EAX"
END SUB

SUB kw.val (t$, cop)
stext$ = text$
text$ = t$
savepos = getcharpos
getcharpos = 0
IF cop = 1 THEN PRINT #2, "PUSH EAX"
Skiptemp

PRINT #2, "MOV EBX, EAX"
PRINT #2, "CALL NEAR Val"
IF cop = 1 THEN PRINT #2, "MOV EBX, EAX": PRINT #2, "POP EAX"

decword

getcharpos = savepos
text$ = stext$

END SUB

SUB kw.varptr (t$, cop)
IF cop = 1 THEN
  r$ = "EBX"
ELSE : r$ = "EAX"
END IF

stext$ = text$
text$ = t$
savepos = getcharpos
getcharpos = 0

a$ = GetWord$(par$)

tmpnum = CheckVar(a$, vartype)
IF par$ = "" THEN
  SELECT CASE vartype
    CASE intt: PRINT #2, "MOV " + r$ + ", IntVar" + LTRIM$(STR$(tmpnum))
    CASE longt: PRINT #2, "MOV " + r$ + ", LongVar" + LTRIM$(STR$(tmpnum))
    CASE arrayt: PRINT #2, "MOV " + r$ + ", [ArrayOffset" + LTRIM$(STR$(tmpnum)) + "]"
    CASE stringt: PRINT #2, "MOV " + r$ + ", [StringOffset" + LTRIM$(STR$(tmpnum)) + "]"
  END SELECT
ELSEIF vartype = arrayt AND NOT par$ = "" THEN
 IF cop = 1 THEN PRINT #2, "PUSH EAX"
   Math.Parser par$, longt
 SELECT CASE GetArrayType(a$)
   CASE intt: PRINT #2, "SHL EAX, 1"
   CASE longt: PRINT #2, "SHL EAX, 2"
 END SELECT
 PRINT #2, "ADD EAX, [ArrayOffset" + LTRIM$(STR$(tmpnum)) + "]"
 IF cop = 1 THEN
   PRINT #2, "MOV EBX, EAX"
   PRINT #2, "POP EAX"
 END IF
ELSEIF NOT par$ = "" AND vartype = stringt THEN
  IF GetStringType%(global$) = arrayt THEN
    IF cop = 1 THEN PRINT #2, "PUSH EAX"
    Math.Parser par$, longt
    PRINT #2, "MOV EBX, [StringMax" + LTRIM$(STR$(tmpnum)) + "]"
    PRINT #2, "MUL EBX"
    PRINT #2, "ADD EAX, [StringOffset" + LTRIM$(STR$(tmpnum)) + "]"
   IF cop = 1 THEN
    PRINT #2, "MOV EBX, EAX"
    PRINT #2, "POP EAX"
   END IF
  ELSE
    PRINT #2, "MOV " + r$ + ", [StringOffset" + LTRIM$(STR$(tmpnum)) + "]"
  END IF
END IF

getcharpos = savepos
text$ = stext$
END SUB

DEFSNG A-Z
SUB kw.vget
a$ = GetFullWord$(0)
b$ = GetFullWord$(0)
C$ = GetFullWord$(0)
d$ = GetFullWord$(0)
e$ = GetFullWord$(0)

e$ = "VARPTR(" + e$ + ")"
Math.Parser e$, longt
PRINT #2, "PUSH EAX"
Math.Parser d$, longt
PRINT #2, "PUSH EAX"
Math.Parser C$, longt
PRINT #2, "PUSH EAX"
Math.Parser b$, longt
PRINT #2, "PUSH EAX"
Math.Parser a$, longt

PRINT #2, "POP EBX"
PRINT #2, "POP ECX"
PRINT #2, "POP EDX"
PRINT #2, "POP EDI"
PRINT #2, "CALL NEAR VGet"

END SUB

SUB kw.vhline (ltype%)
a$ = GetFullWord$(0)
b$ = GetFullWord$(0)
C$ = GetFullWord$(0)
d$ = GetFullWord$(0)

Math.Parser d$, longt
PRINT #2, "PUSH EAX"
Math.Parser C$, longt
PRINT #2, "PUSH EAX"
Math.Parser b$, longt
PRINT #2, "PUSH EAX"
Math.Parser a$, longt
PRINT #2, "POP EBX"
PRINT #2, "POP EDX"
PRINT #2, "POP ECX"

IF ltype% = 1 THEN PRINT #2, "CALL NEAR Hline"
IF ltype% = 2 THEN PRINT #2, "CALL NEAR Vline"
END SUB

SUB kw.vput (ptype%)
a$ = GetFullWord$(0)
b$ = GetFullWord$(0)
C$ = GetFullWord$(0)

C$ = "VARPTR(" + C$ + ")"
Math.Parser C$, longt
PRINT #2, "PUSH EAX"
Math.Parser b$, longt
PRINT #2, "PUSH EAX"
Math.Parser a$, longt

PRINT #2, "POP EBX"
PRINT #2, "POP ESI"
IF ptype% = 1 THEN PRINT #2, "CALL NEAR VPut"
IF ptype% = 2 THEN PRINT #2, "CALL NEAR VSPut"

END SUB

SUB kw.waitkey
PRINT #2, "XOR AX, AX"
PRINT #2, "INT 16h"
END SUB

SUB Main

LOCATE 4, 1: PRINT "Compiling...        "
wx% = 15
wy% = 4

' ---------------------------------------------
' Esta parte sirve para cambiar select case   *
' a IFs                                       *
' ---------------------------------------------

OPEN basfile$ FOR INPUT AS #1
OPEN tempdir$ + "\fixedbas.bas" FOR OUTPUT AS #2
worksel% = 0
DO WHILE NOT EOF(1)
  LINE INPUT #1, text$
  getcharpos = 0
  global$ = GetWord$(par$)

  SELECT CASE LCASE$(global$)
  CASE "sub"
    IF endadded = 0 THEN
      PRINT #2, "END"
      endadded = 1
    END IF

    b$ = GetWord$(par$)

    IF par$ = "" THEN
      getwordmode% = 1
      a$ = GetWord$(P$)
      IF MID$(a$, 1, 1) = "(" THEN
	DO WHILE NOT MID$(a$, LEN(a$), 1) = ")"
	  a$ = a$ + GetWord$(P$)
	LOOP
	PRINT #2, "SUB " + b$ + a$
      ELSE
	PRINT #2, text$
      END IF
    ELSE
      PRINT #2, text$
   END IF

  CASE "select"
    vpush worksel%
    IF NOT LCASE$(GetWord$(P$)) = "case" THEN show.error 16
    cursel% = cursel% + 1
    selcasetext$(cursel%) = GetFullWord$(0)
    worksel% = 0
  CASE "case"
    spos% = getcharpos
    a$ = GetWord$(par$)

    IF LCASE$(a$) = "else" THEN
      IF NOT worksel% = 0 THEN PRINT #2, "ELSE"
    ELSE

    getcharpos = spos%
    IF NOT worksel% = 0 THEN PRINT #2, "END IF"
    IF cursel% = 0 THEN show.error 17
    tmp$ = "IF " + selcasetext$(cursel%) + " "

    endloop = 0
    addor = 0
    DO WHILE NOT endloop = 1
      a$ = GetFullWord$(0)
      IF a$ = "eof" THEN endloop = 1: GOTO label22
      IF addor = 0 THEN tmp$ = tmp$ + "= " + a$
      IF addor = 1 THEN tmp$ = tmp$ + " | " + selcasetext$(cursel%) + " = " + a$
      addor = 1
label22:
    LOOP
    PRINT #2, tmp$ + " THEN"
    worksel% = 1
    END IF
  CASE "end"
    IF LCASE$(GetWord$(par$)) = "select" THEN
      IF cursel% = 0 THEN show.error 21
      cursel% = cursel% - 1
      PRINT #2, "END IF"
      VPop worksel%
    ELSE
      PRINT #2, text$
    END IF
  CASE ELSE: PRINT #2, text$
  END SELECT
LOOP

IF endadded = 0 THEN
  PRINT #2, "END"
END IF

CLOSE

' ---------------------------------------------
' ---------------------------------------------

OPEN tempdir$ + "\subs.txt" FOR BINARY AS #4
a = LOF(4)
CLOSE #4

IF NOT a = 0 THEN KILL tempdir$ + "\subs.txt"

' Analiza los subs
OPEN tempdir$ + "\fixedbas.bas" FOR INPUT AS #1
OPEN tempdir$ + "\subs.txt" FOR BINARY AS #4
DO WHILE NOT EOF(1)
  LINE INPUT #1, text$
  getcharpos = 0
  global$ = GetWord$(par$)
  IF LCASE$(global$) = "sub" THEN Addsub
LOOP
CLOSE #1

OPEN tempdir$ + "\fixedbas.bas" FOR INPUT AS #1
OPEN tempdir$ + "\Code.txt" FOR OUTPUT AS #2
OPEN tempdir$ + "\Data.txt" FOR OUTPUT AS #3
IF NOT logfile$ = "" THEN
  OPEN logfile$ FOR OUTPUT AS #10
END IF

DO WHILE NOT EOF(1)
  processed% = false
  waitchar
  LINE INPUT #1, text$
  linen& = linen& + 1

  IF text$ = "" THEN GOTO loop1
    getcharpos = 0

label21:     ' ---- Para procesar de nuevo
    processagain% = false
    global$ = GetWord$(par$)
  IF global$ = "eof" THEN GOTO loop1

  IF MID$(global$, LEN(global$), 1) = ":" THEN
    mem.addlabel MID$(global$, 1, LEN(global$) - 1)
    global$ = GetWord$(par$)
    IF global$ = "eof" THEN GOTO loop1
  END IF

  IF MID$(global$, 1, 1) = "." THEN
    tmp% = INSTR(text$, ".")
    PRINT #2, MID$(text$, tmp% + 1, LEN(text$) - tmp%)
    GOTO loop1
  END IF

  PRINT #2, ";" + text$
  ' -------------------------
  ' *    Check Keywords     *
  ' -------------------------
  SELECT CASE LCASE$(global$)
    CASE "sub": PRINT #2, "Sub" + LTRIM$(STR$(cursub2%)) + ":": cursub2% = cursub2% + 1
    CASE "declare"   ' Para omitir declare para obtener mayor compatibilidad
		     ' con qbasic
    ' ---- Arrays, strings, variables handling
    CASE "setstring": kw.setstring
    CASE "dim", "dims", "dimstr", "dimi", "dimint", "dimlong", "diml": mem.dim
    CASE "redim": mem.redim
    CASE "const": mem.const
    
    ' ---- Memory and hardware manipulation
    CASE "out": kw.out Byte
    CASE "outw": kw.out intt
    CASE "outd": kw.out longt

    CASE "poke": kw.poke Byte
    CASE "pokew": kw.poke intt
    CASE "poked": kw.poke longt

    CASE "memcopy": kw.memcopy Byte
    CASE "memcopyw": kw.memcopy intt
    CASE "memcopyd": kw.memcopy longt

    CASE "memfill": kw.memfill Byte
    CASE "memfillw": kw.memfill intt
    CASE "memfilld": kw.memfill longt

    CASE "setvect": kw.setvect
    ' ---- File Handling
    CASE "open": kw.open
    CASE "close": kw.close
    CASE "get": kw.getput 1, false
    CASE "put": kw.getput 2, false
    CASE "xget": kw.getput 1, true
    CASE "xput": kw.getput 2, true
    CASE "kill": kw.killdir 1
    CASE "mkdir": kw.killdir 2
    CASE "chdir": kw.killdir 3
    CASE "killdir": kw.killdir 4
    CASE "shell": kw.shell
    ' ---- Mouse
    CASE "mouseshow": PRINT #2, "Call NEAR Mouseshow"
    CASE "mousehide": PRINT #2, "Call NEAR Mousehide"

    ' ---- Program Structure
    CASE "exit": kw.exit
    CASE "do": kw.do
    CASE "loop": kw.loop
    CASE "for": kw.for
    CASE "next": kw.next
    CASE "if": fixIFline: kw.if 0
    CASE "else": kw.else
    CASE "end": kw.end
    CASE "gosub": kw.gosub
    CASE "goto": kw.goto
    CASE "ret", "return": PRINT #2, "RET"

    ' ---- Graphics (VGA)
    CASE "pset": kw.pset
    CASE "screen": kw.screen
    CASE "setcol": kw.setcol
    CASE "line": kw.line
    CASE "fillbox": kw.fillbox 1
    CASE "box": kw.fillbox 2
    CASE "hline": kw.vhline 1
    CASE "vline": kw.vhline 2
    CASE "setclip": kw.setclip
    CASE "setvoffs": kw.setvoffs
    CASE "vget": kw.vget
    CASE "vsput": kw.vput 2
    CASE "vput": kw.vput 1
    CASE "settranscolor": kw.settranscolor
    ' ---- Textmode functions
    CASE "print": kw.print
    CASE "cls": kw.cls
    CASE "color": kw.color
    CASE "locate": kw.locate
    
    ' ---- MISC
    CASE "clearkeybuffer": PRINT #2, "CALL ClearKeyBuffer"
    CASE "waitkey": kw.waitkey
    CASE "asm": kw.asm
    CASE "sleep": kw.waitkey
    CASE "randomize": kw.randomize

    ' ---- Others
    CASE ELSE: CheckOthers par$
  END SELECT

IF processagain% = true THEN processed% = true: GOTO label21

IF processed% = true THEN
  getcharpos = 0
  text$ = "if"
  kw.end
END IF

processed% = false
loop1:
LOOP
CLOSE

BuildFiles
IF NOT compmode% = distribute THEN
  Quickshow
END IF

IF NOT exefile$ = "" THEN
  LOCATE 10, 1
  SHELL "nasm -o " + exefile$ + " -f oldrdf " + asmfile$
  SHELL "stubit " + exefile$
END IF

EXIT SUB

END SUB

DEFINT A-Y
SUB Math.Parser (t$, usertype%)

RegType = usertype%
savetext$ = text$
savepos = getcharpos
text$ = t$
getcharpos = 0
cop = 0
MathOp = 0

IF RegType = longt THEN Ereg$ = "E"

DO WHILE NOT endloop = 1
  
  a$ = GetWord$(par$)
  
  IF a$ = "eof" THEN
    getcharpos = savepos
    text$ = savetext$
    EXIT SUB
  END IF

  ' ---- Arrays
  IF NOT par$ = "" THEN
    j = 0
    SELECT CASE UCASE$(a$)
      CASE "ASC": kw.asc par$, cop: j = 1
      CASE "ABS": kw.abssgn par$, cop, 1: j = 1
      CASE "SGN": kw.abssgn par$, cop, 2: j = 1
      CASE "LEN": kw.len par$, cop: j = 1
      CASE "RND": kw.rnd par$, cop, RegType: j = 1
      CASE "POINT": kw.point par$, cop: j = 1
      CASE "VARPTR", "SADD": kw.varptr par$, cop: j = 1
      CASE "SEEK": kw.seek par$, cop: j = 1
      CASE "LOF": kw.lof par$, cop: j = 1
      CASE "GETVECT": kw.getvect par$, cop: j = 1
      CASE "PEEK": kw.peek par$, Byte, cop: j = 1
      CASE "PEEKW": kw.peek par$, intt, cop: j = 1
      CASE "PEEKD": kw.peek par$, longt, cop: j = 1
      CASE "INP": kw.inp par$, Byte, cop: j = 1
      CASE "INPW": kw.inp par$, intt, cop: j = 1
      CASE "INPD": kw.inp par$, longt, cop: j = 1
      CASE "VAL": kw.val par$, cop: j = 1
    END SELECT
    IF j = 1 THEN GOTO label2

    vn = CheckVar%(a$, vartype%)
    IF NOT vartype% = arrayt THEN show.error 4

    arraytype = GetArrayType%(a$)
    
    IF NOT cop = 0 THEN PRINT #2, "PUSH " + Ereg$ + "AX"
    Math.Parser par$, longt

    IF arraytype = intt THEN
      PRINT #2, "SHL EAX, 1"
    ELSEIF arratype = longt THEN
      PRINT #2, "SHL EAX, 2"
    END IF

    PRINT #2, "ADD EAX, [ArrayOffset" + LTRIM$(STR$(vn)) + "]"
    SaveReg$ = Ereg$
    IF arraytype = intt OR arraytype = bytet THEN
      Ereg$ = ""
      PRINT #2, "XOR EBX, EBX"
    END IF

    IF arraytype = longt THEN Ereg$ = "EBX"
    IF arraytype = intt THEN Ereg$ = "BX"
    IF arraytype = bytet THEN Ereg$ = "BL"
    
    IF NOT cop = 0 THEN
      PRINT #2, "MOV " + Ereg$ + ", [EAX]"
      Ereg$ = SaveReg$
      PRINT #2, "POP " + Ereg$ + "AX"
    ELSE
      PRINT #2, "MOV " + Ereg$ + ", [EAX]"
      Ereg$ = SaveReg$
      PRINT #2, "MOV " + Ereg$ + "AX, " + Ereg$ + "BX"
    END IF

label2: IF cop = 1 THEN b$ = Ereg$ + "BX": GOSUB MakeOp
    GOTO loop2
  END IF

  ' ---- Ver is es un numero
  IF ASC(MID$(a$, 1, 1)) >= 48 AND ASC(MID$(a$, 1, 1)) <= 57 THEN
label17:
    IF cop = 0 THEN PRINT #2, "MOV " + Ereg$ + "AX," + a$: cop = 1: GOTO loop2
    IF cop = 1 THEN
      IF MathOp >= 3 AND MathOp <= 5 THEN
	PRINT #2, "MOV " + Ereg$ + "BX," + a$
	b$ = Ereg$ + "BX"
      ELSE
	b$ = a$
      END IF
      GOSUB MakeOp
      GOTO loop2
    END IF
  END IF

  SELECT CASE UCASE$(a$)
    ' ------ Keywords que no usan parametros
    CASE "INKEY": kw.inkey cop: GOTO label2
    CASE "TIMER": kw.timer cop: GOTO label2
    CASE "GETMAXX": kw.getmaxres cop, 1: GOTO label2
    CASE "GETMAXY": kw.getmaxres cop, 2: GOTO label2
    CASE "MOUSEL": kw.mousedat 1, cop: GOTO label2
    CASE "MOUSER": kw.mousedat 2, cop: GOTO label2
    CASE "MOUSEX": kw.mousedat 3, cop: GOTO label2
    CASE "MOUSEY": kw.mousedat 4, cop: GOTO label2
    CASE "MOUSEEXIST": kw.mouseexist cop: GOTO label2

    ' ------ Math Operators
    CASE "+": MathOp = 1: Jmp = 1
    CASE "-": MathOp = 2: Jmp = 1
    CASE "/", "\": MathOp = 3: Jmp = 1
    CASE "*": MathOp = 4: Jmp = 1
    CASE "MOD": MathOp = 5: Jmp = 1
    ' ------ Shift Operations
    CASE "<<": MathOp = 6: Jmp = 1
    CASE ">>": MathOp = 7: Jmp = 1
    CASE "SHL": MathOp = 6: Jmp = 1
    CASE "SHR": MathOp = 7: Jmp = 1
    ' ------ Bits Operations
    CASE "AND": MathOp = 8: Jmp = 1
    CASE "XOR": MathOp = 9: Jmp = 1
    CASE "OR":  MathOp = 10: Jmp = 1
    CASE "NOT": MathOp = 11: Jmp = 1
    CASE "ROR": MathOp = 12: Jmp = 1
    CASE "ROL": MathOp = 13: Jmp = 1
  END SELECT
  IF Jmp = 1 THEN Jmp = 0: cop = 1: GOTO loop2

  ' ****---------------   Parentesis   ---------------****
  IF MID$(a$, 1, 1) = "(" THEN
      C$ = "": d$ = ""
      IF LEN(a$) > 1 THEN C$ = MID$(a$, 2, LEN(a$) - 1)
    DO WHILE NOT d$ = ")"
      C$ = C$ + d$
      d$ = GetChar$
      IF d$ = "eof" THEN show.error 7
    LOOP
      PRINT #2, "PUSH " + Ereg$ + "AX"
      Math.Parser C$, RegType
      PRINT #2, "MOV " + Ereg$ + "BX, " + Ereg$ + "AX"
      PRINT #2, "POP " + Ereg$ + "AX"
      b$ = Ereg$ + "BX"
    GOSUB MakeOp
    GOTO loop2
  END IF

  ' ****--------------- Para Variables ---------------****
  vn = CheckVar%(a$, vartype%)
  IF NOT vn = -1 THEN
    IF cop = 0 THEN
      Reg$ = "AX"
    ELSE : Reg$ = "BX"
    END IF
    
    IF vartype% = longt THEN
      IF RegType = intt THEN
	PRINT #2, "MOV E" + Reg$ + ", [LongVar" + LTRIM$(STR$(vn)) + "]"
      ELSE : PRINT #2, "MOV E" + Reg$ + ", [LongVar" + LTRIM$(STR$(vn)) + "]"
      END IF
      b$ = Ereg$ + "BX"
      GOSUB MakeOp: GOTO loop2
    ELSEIF vartype% = intt THEN
      IF RegType = longt THEN PRINT #2, "XOR E" + Reg$ + ", E" + Reg$
      PRINT #2, "MOV " + Reg$ + ", [IntVar" + LTRIM$(STR$(vn)) + "]"
      b$ = Ereg$ + "BX"
      GOSUB MakeOp: GOTO loop2
    ELSEIF vartype% = constt THEN
      IF MathOp >= 3 AND MathOp <= 5 THEN
	 PRINT #2, "MOV " + Ereg$ + Reg$ + "," + STR$(constval(vn))
	 b$ = Ereg$ + "BX"
      ELSE
	IF NOT cop = 0 THEN
	  b$ = STR$(constval(vn))
	ELSE
	  PRINT #2, "MOV " + Ereg$ + "AX," + STR$(constval(vn))
	  b$ = Ereg$ + "AX"
	END IF
      END IF
      GOSUB MakeOp: GOTO loop2
    END IF
  END IF

  IF MID$(a$, 1, 1) = "+" OR MID$(a$, 1, 1) = "-" THEN GOTO label17
  show.error 6

loop2:
LOOP
  EXIT SUB

MakeOp:    '---- Make Operations
SELECT CASE MathOp
  CASE 1: PRINT #2, "ADD " + Ereg$ + "AX, " + b$
  CASE 2: PRINT #2, "SUB " + Ereg$ + "AX, " + b$
  CASE 3: PRINT #2, "XOR EDX, EDX"
	  PRINT #2, "IDIV " + b$
  CASE 4: PRINT #2, "XOR EDX, EDX"
	  PRINT #2, "IMUL " + b$
  CASE 5: PRINT #2, "XOR EDX, EDX"
	  PRINT #2, "IDIV " + b$
	  PRINT #2, "MOV " + Ereg$ + "AX, " + Ereg$ + "DX"
  CASE 6: PRINT #2, "SHL " + Ereg$ + "AX, " + b$
  CASE 7: PRINT #2, "SHR " + Ereg$ + "AX, " + b$
  CASE 8: PRINT #2, "AND " + Ereg$ + "AX, " + b$
  CASE 9: PRINT #2, "XOR " + Ereg$ + "AX, " + b$
  CASE 10: PRINT #2, "OR " + Ereg$ + "AX, " + b$
  CASE 11: PRINT #2, "NOT " + Ereg$ + "AX, " + b$
  CASE 12: PRINT #2, "ROR " + Ereg$ + "AX, " + b$
  CASE 13: PRINT #2, "ROL " + Ereg$ + "AX, " + b$
END SELECT
RETURN

END SUB

DEFSNG A-Y
SUB mem.addinmd (t$)
PRINT #3, "Inmd" + LTRIM$(STR$(curinmd%)) + " DB '" + t$ + "'"
curinmd% = curinmd% + 1
END SUB

SUB mem.addlabel (name$)
label(curlabel%) = name$
PRINT #2, "Label" + LTRIM$(STR$(curlabel%)) + ":    ; " + name$
curlabel% = curlabel% + 1
END SUB

SUB mem.addvar (name$, vartype%, value&)

SELECT CASE vartype%
CASE constt
  IF curconst% > (max% / 2) THEN show.error 3
  Constvar(curconst%) = name$
  constval(curconst%) = value&
  curconst% = curconst% + 1

CASE intt
  IF curint% > max% THEN show.error 3
  PRINT #3, "IntVar" + LTRIM$(STR$(curint%)) + " DW " + STR$(value&)
  intvars(curint%) = name$
  curint% = curint% + 1
CASE longt
  IF curint% > max% THEN show.error 3
  PRINT #3, "LongVar" + LTRIM$(STR$(curlong%)) + " DD " + STR$(value&)
  longvars(curlong%) = name$
  curlong% = curlong% + 1
CASE arrayt
  IF curarray% > (max% * 2) THEN show.error 3
  PRINT #3, "ArrayOffset" + LTRIM$(STR$(curarray%)) + " DD 0"
  PRINT #3, "ArrayHandle" + LTRIM$(STR$(curarray%)) + " DD 0"
  tmp$ = name$ + SPACE$(30)
  tmp$ = MID$(tmp$, 1, 30) + CHR$(value&)
  Arrays(curarray%) = tmp$
  curarray% = curarray% + 1
CASE stringt
  IF curstring% > max% THEN show.error 3
  PRINT #3, "StringOffset" + LTRIM$(STR$(curstring%)) + " DD 0"
  PRINT #3, "StringHandle" + LTRIM$(STR$(curstring%)) + " DD 0"
  PRINT #3, "StringMax" + LTRIM$(STR$(curstring%)) + " DD 0"
  tmp$ = name$ + SPACE$(30)
  tmp$ = MID$(tmp$, 1, 30) + CHR$(value&)
  Strings(curstring%) = tmp$
  curstring% = curstring% + 1

END SELECT

END SUB

SUB mem.const

DO WHILE NOT endloop = 1
  name$ = GetWord$(par$)
  IF name$ = "eof" THEN show.error 99
  IF NOT CheckVar(name$, vartype%) = -1 THEN show.error 2
  a$ = GetWord$(par$)
  IF NOT a$ = "=" THEN show.error 11
  a$ = GetWord$(par$)
  mem.addvar name$, constt, VAL(a$)
  a$ = GetWord$(par$)
  IF a$ = "eof" THEN EXIT SUB
  IF NOT a$ = "eof" AND NOT a$ = "," THEN show.error 99
LOOP

END SUB

SUB mem.dim
name$ = global$
SetWhiteChars 1

label1:
mem = false
SELECT CASE LCASE$(global$)
  CASE "dim"
    name$ = GetWord$(par$)
    NPar$ = par$
    IF name$ = "eof" THEN show.error 1
    IF NOT par$ = "" THEN
      SetWhiteChars 0
	Math.Parser par$, longt
      SetWhiteChars 1
      PRINT #2, "INC EAX"
      
      savepos% = getcharpos          '---- Obtengo el tipo de array
      IF NOT LCASE$(GetWord$(par$)) = "as" THEN
	getcharpos = savepos%

	IF LCASE$(GetWord$(par$)) = "at" THEN
	  mem = true: memoffset$ = GetFullWord$(addressmode): GOTO label20
	ELSE : getcharpos = savepos%
	END IF

	IF MID$(name$, LEN(name$), 1) = "%" THEN
	  arraytype% = intt
	ELSE : arraytype% = longt
	END IF
	IF MID$(name$, LEN(name$), 1) = "$" THEN
	  POP = true
	  PRINT #2, "PUSH EAX"
	  a$ = "": GOTO label6
	END IF
      ELSE
label20:
	type$ = LCASE$(GetWord$(par$))
	IF type$ = "byte" THEN arraytype% = Byte
	IF type$ = "integer" THEN arraytype% = intt
	IF type$ = "long" THEN arraytype% = longt
	
' ---------------------------------------------------
'                    STRING  ARRAY
' ---------------------------------------------------
	IF type$ = "string" THEN
	  a$ = GetWord$(par$): IF NOT a$ = "*" THEN show.error 9
	  a$ = GetFullWord$(0)
	  PRINT #2, "PUSH EAX"
	  SetWhiteChars 0
	    Math.Parser a$, longt
	  SetWhiteChars 1
	  PRINT #2, "ADD EAX, 4"
	  PRINT #2, "MOV [StringMax" + LTRIM$(STR$(curstring%)) + "], EAX"
	  PRINT #2, "POP EBX"
	  PRINT #2, "MUL EBX"
	  mem.addvar name$, stringt, arrayt

	  tmp% = curstring% - 1
	  PRINT #2, "CALL NEAR AllocBlock"
	  PRINT #2, "MOV [StringOffset" + LTRIM$(STR$(tmp%)) + "], EAX"
	  PRINT #2, "MOV EBX, [StringHandle" + LTRIM$(STR$(tmp%)) + "]"
	  PRINT #2, "MOV [EBX], SI"
	  PRINT #2, "MOV [EBX+2], DI"
	  GOTO enddim
	END IF
      END IF
' ---------------------------------------------------
'                    INTEGER ARRAY
' ---------------------------------------------------

label3: IF arraytype% = intt THEN PRINT #2, "SHL EAX, 1"
	IF arraytype% = longt THEN PRINT #2, "SHL EAX, 2"

IF mem = false THEN
      arraytype& = arraytype%
      mem.addvar name$, arrayt, arraytype&
      PRINT #2, "CALL NEAR AllocBlock"
      tmp% = curarray% - 1
      PRINT #2, "MOV [ArrayOffset" + LTRIM$(STR$(tmp%)) + "], EAX"
      PRINT #2, "MOV EBX, [ArrayHandle" + LTRIM$(STR$(tmp%)) + "]"
      PRINT #2, "MOV [EBX], SI"
      PRINT #2, "MOV [EBX+2], DI"
ELSE
  arraytype& = arraytype%
  mem.addvar name$, arrayt, arraytype&
  tmp% = curarray% - 1
  Math.Parser memoffset$, longt
  PRINT #2, "MOV [ArrayOffset" + LTRIM$(STR$(tmp%)) + "], EAX"
END IF
  ELSE
      IF NOT CheckVar%(name$, vartype%) = -1 THEN show.error 2
      savepos% = getcharpos
      IF NOT LCASE$(GetWord$(par$)) = "as" THEN
	getcharpos = savepos%
	IF MID$(name$, LEN(name$), 1) = "%" THEN mem.addvar name$, intt, 0: GOTO NextDim
	IF MID$(name$, LEN(name$), 1) = "$" THEN savepos% = getcharpos: GOTO label6
	mem.addvar name$, longt, 0
      ELSE
	type$ = LCASE$(GetWord$(par$))
	IF type$ = "integer" THEN mem.addvar name$, intt, 0
	IF type$ = "long" THEN mem.addvar name$, longt, 0
	IF type$ = "string" THEN a$ = GetWord$(par$): a$ = "=": GOTO label6
      END IF
    END IF
enddim:
  CASE "dimint", "dimi"
    name$ = GetWord$(par$)
    IF name$ = "eof" THEN show.error 1

    IF NOT par$ = "" THEN
      SetWhiteChars 0
	Math.Parser par$, longt
      SetWhiteChars 1
      arraytype% = intt
      PRINT #2, "INC EAX"
      GOTO label3
    ELSE
      IF NOT CheckVar%(name$, vartype%) = -1 THEN show.error 2
      value$ = GetWord$(par$)
      IF value$ = "=" THEN value$ = GetWord$(par$)
      mem.addvar name$, intt, VAL(value$)
    END IF

  CASE "dimlong", "diml"
    name$ = GetWord$(par$)
    IF name$ = "eof" THEN show.error 1

    IF NOT par$ = "" THEN
      SetWhiteChars 0
	Math.Parser par$, longt
      SetWhiteChars 1
      arraytype% = longt
      PRINT #2, "INC EAX"
      GOTO label3
    ELSE
      IF NOT CheckVar%(name$, vartype%) = -1 THEN show.error 2
      value$ = GetWord$(par$)
      IF value$ = "=" THEN value$ = GetWord$(par$)
      mem.addvar name$, longt, VAL(value$)
    END IF

  CASE "dimstr", "dims"
    name$ = GetWord$(par$)
    savepos% = getcharpos

    IF NOT par$ = "" THEN
      POP = true
      Math.Parser par$, longt
      PRINT #2, "INC EAX"
      PRINT #2, "PUSH EAX"
    END IF

    IF name$ = "eof" THEN show.error 1
    a$ = GetWord$(par$)
label6:
    IF NOT a$ = "=" THEN
      getcharpos = savepos%
      PRINT #2, "MOV EAX, [StringSize]"
    ELSE
      a$ = GetFullWord$(0)
      SetWhiteChars 0
      Math.Parser a$, longt
      SetWhiteChars 1
    END IF
    PRINT #2, "ADD EAX, 4"
    PRINT #2, "MOV [StringMax" + LTRIM$(STR$(curstring%)) + "], EAX"
    IF POP = true THEN
      PRINT #2, "POP EBX"
      PRINT #2, "MUL EBX"
    END IF

    POP& = POP
    mem.addvar name$, stringt, POP&

    PRINT #2, "CALL NEAR AllocBlock"
    tmp% = curstring% - 1
    PRINT #2, "MOV [StringOffset" + LTRIM$(STR$(tmp%)) + "], EAX"
    PRINT #2, "MOV EBX, [StringHandle" + LTRIM$(STR$(tmp%)) + "]"
    PRINT #2, "MOV [EBX], SI"
    PRINT #2, "MOV [EBX+2], DI"
   
END SELECT

NextDim:
  savepos% = getcharpos
  IF GetWord$(par$) = "eof" THEN SetWhiteChars 0: EXIT SUB
  getcharpos = savepos%
  GOTO label1

END SUB

DEFINT A-Z
SUB mem.redim
a$ = GetWord$(par$)

IF a$ = "eof" THEN show.error 1
tmp = CheckVar(a$, vartype)

IF NOT tmp >= 0 THEN show.error 6

Math.Parser par$, longt
PRINT #2, "INC EAX"
SELECT CASE GetArrayType(a$)
  CASE intt: PRINT #2, "SHL EAX, 1"
  CASE longt: PRINT #2, "SHL EAX, 2"
END SELECT

PRINT #2, "mov ebx, [ArrayHandle" + LTRIM$(STR$(tmp)) + "]"
PRINT #2, "mov si, [ebx]"
PRINT #2, "mov di, [ebx+2]"
PRINT #2, "Call NEAR ChangeBlockSize"
PRINT #2, "MOV [ArrayOffset" + LTRIM$(STR$(tmp)) + "], EAX"
PRINT #2, "MOV EBX, [ArrayHandle" + LTRIM$(STR$(tmp)) + "]"
PRINT #2, "MOV [EBX], SI"
PRINT #2, "MOV [EBX+2], DI"

END SUB

SUB Quickshow     ' SUB to Show files

DIM name$(10)
name$(0) = tempdir$ + "\data.txt"
name$(1) = basfile$
name$(2) = tempdir$ + "\code.txt"
name$(3) = asmfile$
name$(4) = tempdir$ + "\fixedbas.bas"
tfiles = 4
maxlines = 1000

DIM text$(maxlines)
' -------------------------------------------

start:
COLOR 15, 1
CLS

COLOR 15, 11: PRINT SPACE$(70) + "QuickShow ": LOCATE 1, 1: PRINT name$(curfile): COLOR 15, 1
OPEN name$(curfile) FOR INPUT AS #1
C% = -1
DO WHILE NOT EOF(1)
  C% = C% + 1
  IF C% >= maxlines THEN EXIT DO
  LINE INPUT #1, text$(C%)
LOOP
IF C% < maxlines THEN
  text$(C% + 1) = "[------------- EOF --------------]"
  FOR i = C% + 2 TO maxlines: text$(i) = "": NEXT i
END IF
CLOSE

CLS
COLOR 15, 11: PRINT SPACE$(70) + "QuickShow ": LOCATE 1, 1: PRINT name$(curfile): COLOR 15, 1

Cp% = 0
GOSUB redrawscreen
DO WHILE NOT endqs = 1
  SELECT CASE INKEY$
    CASE CHR$(27): EXIT SUB
    CASE CHR$(0) + CHR$(65)
      COLOR 15, 11: LOCATE 10, 25: PRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
      LOCATE 11, 25: PRINT "º                         º"
      LOCATE 12, 25: PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼"
      LOCATE 11, 27: PRINT "Search: " + lword$
      LOCATE 11, 27: INPUT "Search: ", word$
      IF word$ = "" AND lword$ = "" THEN GOTO label4
      IF word$ = "" THEN word$ = lword$
      lword$ = word$
      COLOR 15, 1
      FOR i = Cp% TO C%
	tmp% = INSTR(LCASE$(text$(i)), LCASE$(word$))
	IF tmp% >= 1 THEN
	  a$ = text$(i)
	  Cp% = i: GOSUB redrawscreen
	  LOCATE 2, 1: PRINT MID$(a$, 1, tmp% - 1);
	  COLOR 15, 11: PRINT MID$(a$, tmp%, LEN(word$));
	  tmp2% = LEN(a$) - (tmp% + LEN(word$)) - 1
	  COLOR 15, 1: IF NOT tmp2% <= 0 THEN PRINT MID$(a$, tmp% + LEN(word$), tmp2%)
	  GOTO label4
	END IF
      NEXT i
      COLOR 15, 11
      LOCATE 11, 25: PRINT "º    String Not Found     º"
      COLOR 15, 1
      DO WHILE INKEY$ = "": LOOP
      GOSUB redrawscreen
label4:
    CASE CHR$(0) + CHR$(71): Cp% = 0: GOSUB redrawscreen
    CASE CHR$(0) + CHR$(79): Cp% = maxlines - 23: GOSUB redrawscreen
    CASE CHR$(0) + CHR$(73)
      Cp% = Cp% - 22
      IF Cp% < 0 THEN Cp% = 0
      GOSUB redrawscreen
    CASE CHR$(0) + CHR$(81)
      Cp% = Cp% + 22
      IF Cp% > maxlines - 26 THEN Cp% = maxlines - 26
      GOSUB redrawscreen

    CASE CHR$(0) + CHR$(80): 'Down
      IF NOT Cp% = maxlines - 23 THEN Cp% = Cp% + 1
      GOSUB redrawscreen
    CASE CHR$(0) + CHR$(72): 'Up
      IF NOT Cp% = 0 THEN Cp% = Cp% - 1
      GOSUB redrawscreen
    CASE " ", CHR$(0) + CHR$(77)
      curfile = curfile + 1
      IF curfile = tfiles + 1 THEN curfile = 0
      GOTO start
  END SELECT
LOOP

redrawscreen:
LOCATE 2, 1
FOR i = 0 TO 21
  PRINT SPACE$(80)
NEXT i
LOCATE 2, 1
FOR i = 0 TO 21
  IF MID$(text$(i + Cp%), 1, 1) = ";" THEN COLOR 14
  PRINT text$(i + Cp%)
  IF MID$(text$(i + Cp%), 1, 1) = ";" THEN COLOR 15
NEXT i
RETURN


END SUB

DEFSNG A-Z
SUB SetWhiteChars (mode)

SELECT CASE mode
  CASE 0
    whitechar(0) = CHR$(32)
    whitechar(1) = CHR$(9)
    whitechar(2) = CHR$(255)
    whitecounter% = 2
  CASE 1
    whitechar(0) = CHR$(32)
    whitechar(1) = CHR$(9)
    whitechar(2) = CHR$(255)
    whitechar(3) = ","
    whitecounter% = 3
END SELECT

END SUB

SUB show.error (er%)

IF logfile$ = "" THEN
  COLOR 9
  PRINT "Error:";
  COLOR 2
  PRINT STR$(er%) + ": ";
  COLOR 15
ELSE
  PRINT #10, er%
END IF

SELECT CASE er%
  CASE 1: tprint "Argument-count mismatch"
  CASE 2: tprint "Name already used"
  CASE 3: tprint "All data objects used"
  CASE 4: tprint "Unknown Error"
  CASE 5: tprint "'Integer Type' Expected"
  CASE 6: tprint "Object not defined"
  CASE 7: tprint "')' MISSED"
  CASE 8: tprint "'" + CHR$(34) + "' MISSED"
  CASE 9: tprint "Size required"
  CASE 10: tprint "Invalid Data type"
  CASE 11: tprint "'=' or '=+' Expected"
  CASE 12: tprint "Use =, =>, =<, >, <"
  CASE 13: tprint "Use WHILE or UNTIL"
  CASE 14: tprint "'Array' Expected"
  CASE 15: tprint "Invalid File Mode"
  CASE 16: tprint "SELECT what !?, only CASE can be used"
  CASE 17: tprint "CASE without SELECT"
  CASE 18: tprint "No valid STRING operation"
  CASE 19: tprint "')' without '('"
  CASE 20: tprint "AS required"
  CASE 21: tprint "END SELECT without SELECT"
  CASE 22: tprint CHR$(34) + " IS MISSING"
  CASE 99: tprint "Something Expected"
  CASE 100: tprint "Error not documented(because im tired)"
END SELECT

IF logfile$ = "" THEN
  PRINT "Line :";
  COLOR 2
  PRINT STR$(linen&) + ": ";
  COLOR 15
  PRINT text$
ELSE
  PRINT #10, linen&
END IF

END
END SUB

SUB Skiptemp
savepos% = getcharpos
b$ = GetWord$(par$)
C$ = GetWord$(par$)
getcharpos = savepos%
a$ = GetFullWord$(0)

IF NOT C$ = "eof" THEN
usetmp5:
  PRINT #2, "XOR EBX, EBX"
  PRINT #2, "MOV BX, [curtmp]"
  PRINT #2, "MOV EAX, [StringOffset]"
  PRINT #2, "SHL EBX, 10"
  PRINT #2, "INC word [curtmp]"
  PRINT #2, "ADD EAX, EBX"
  string.parser a$, tobegin
  ls = ls + 1
EXIT SUB
ELSE
  tmp% = CheckVar%(b$, vartype%)
  IF tmp% = -1 THEN GOTO usetmp5
  IF NOT vartype% = stringt THEN show.error 10

  IF par$ = "" THEN
    PRINT #2, "MOV EAX, [StringOffset" + LTRIM$(STR$(tmp%)) + "]"
  ELSE
    Math.Parser par$, longt
    PRINT #2, "MOV EBX, [StringMax" + LTRIM$(STR$(tmp%)) + "]"
    PRINT #2, "MUL EBX"
    PRINT #2, "ADD EAX, [StringOffset" + LTRIM$(STR$(tmp%)) + "]"
  END IF
END IF

END SUB

SUB skiptemp2 (t$)
savepos = getcharpos
st$ = text$
text$ = t$
getcharpos = 0
Skiptemp
text$ = st$
getcharpos = savepos
END SUB

SUB SPop (t$)
cursstack% = cursstack% - 1
t$ = SStack$(cursstack%)
END SUB

SUB spush (t$)
SStack$(cursstack%) = t$
cursstack% = cursstack% + 1
END SUB

DEFINT A-Z
SUB string.parser (t$, mode)

RegType = usertype%
savetext$ = text$
savepos = getcharpos
text$ = t$
getcharpos = 0
cop = 0
MathOp = 0

IF curstringparser% > 0 THEN PRINT #2, "PUSH dword [spush]"

curstringparser% = curstringparser% + 1

IF mode = tobegin THEN PRINT #2, "XOR EDX, EDX": PRINT #2, "MOV [EAX], EDX"

PRINT #2, "MOV [spush], EAX"

DO WHILE NOT endloop = 1
  savepos2 = getcharpos
  a$ = GetWord$(par$)

  IF a$ = "+" THEN cop = 2: GOTO loop3

  IF a$ = "eof" THEN
    curstringparser% = curstringparser% - 1
    IF curstringparser% > 0 THEN PRINT #2, "POP dword [spush]"
    getcharpos = savepos
    text$ = savetext$
    EXIT SUB
  END IF

  IF cop = 0 THEN
  IF a$ = "" THEN
    PRINT #2, "MOV DWORD [EAX], 0"
    GOTO loop3
  END IF
  END IF

IF cop = 0 OR cop = 2 THEN
  IF MID$(a$, 1, 1) = CHR$(34) THEN
    getcharpos = savepos2
    tmp$ = GetInmd$
    IF tmp$ = "" THEN cop = 1: GOTO loop3
    IF tmp$ = "eof" THEN show.error 8
    mem.addinmd tmp$
    PRINT #2, "MOV EBX, Inmd" + LTRIM$(STR$(curinmd% - 1))
    PRINT #2, "MOV ECX," + STR$(LEN(tmp$))
    PRINT #2, "CALL NEAR MoveInmd"
    PRINT #2, "MOV EAX, [spush]"
    cop = 1
    GOTO loop3
  END IF
END IF

IF cop = 0 OR cop = 2 THEN   ' ------------ Keywords
  SELECT CASE UCASE$(a$)
    CASE "GETEXEPATH$": kw.getcmd 1
    CASE "COMMAND$": kw.getcmd 2
    CASE "SPACE$": kw.string par$ + ", 32"
    CASE "LCASE$": kw.lucase par$, 1
    CASE "UCASE$": kw.lucase par$, 2
    CASE "STRING$": kw.string par$
    CASE "CHR$": kw.chrS par$
    CASE "MID$": kw.mid par$
    CASE "STR$": kw.str par$
    CASE "INKEY$": PRINT #2, "CALL NEAR INKEY$"
    CASE ELSE: GOTO label11
  END SELECT
  PRINT #2, "MOV EAX, [spush]"
  GOTO loop3
label11:
END IF

IF cop = 0 OR cop = 2 THEN
  IF par$ = "" THEN
    tmp = CheckVar%(a$, vartype%)
    IF tmp = -1 THEN PRINT a$: show.error 6
    IF NOT vartype% = stringt THEN show.error 10
    PRINT #2, "MOV EBX, [StringOffset" + LTRIM$(STR$(tmp)) + "]"
  ELSE
    Math.Parser par$, longt
    PRINT #2, "MOV EBX, [StringMax" + LTRIM$(STR$(tmp)) + "]"
    PRINT #2, "MUL EBX"
    PRINT #2, "MOV EBX, EAX"
    PRINT #2, "ADD EBX, [StringOffset" + LTRIM$(STR$(tmp)) + "]"
  END IF

    PRINT #2, "CALL NEAR MoveString"
    PRINT #2, "MOV EAX, [spush]"
    cop = 1
  GOTO loop3
END IF

show.error 18

loop3:
LOOP

END SUB

DEFSNG A-Z
SUB tprint (t$)
IF logfile$ = "" THEN
 PRINT t$
ELSE
 PRINT #10, t$
END IF
END SUB

SUB VPop (value%)
curstack% = curstack% - 1
value% = vstack(curstack%)
END SUB

SUB vpush (value%)
vstack(curstack%) = value%
curstack% = curstack% + 1
END SUB

SUB waitchar

  LOCATE wy%, wx%
  cc% = cc% + 1
  IF cc% >= 8 THEN cc% = 0
  PRINT char$(cc%)

END SUB

