Seeing as this is very important reason for QB45's success I've developed a scripting engine for JBASIC called JISC.
Code: Select all
J = JBASIC
I = INSTRUCTION
S = SET
C = CODE
JISC code should also prove fairly easy to translate directly into ASSEMBLY code.
Here is an example of a simple JISC source listing
Code: Select all
module main
function console_writeline
print_int32
end_function
function main
push_int16 -1
cint32
push_int32 7
add_int32
end_function
callfn main
callfn console_writeline
end_module
Code: Select all
DEFINT A-Z
TYPE udtStack
float AS DOUBLE
int16 AS INTEGER
int32 AS LONG
str AS LONG
END TYPE
TYPE udtFunctions
ssource AS STRING * 40
lposition AS LONG
llength AS LONG
END TYPE
CONST True = -1
CONST False = 0
DECLARE SUB main ()
DECLARE SUB parseTokens (icount AS INTEGER)
DECLARE SUB restoreState ()
DECLARE SUB saveState ()
DECLARE SUB serror (ssource AS STRING)
DIM SHARED spriModuleName AS STRING
DIM SHARED spriTokens(255) AS STRING
DIM SHARED ipriTokens AS INTEGER
DIM SHARED upriStack(255) AS udtStack
DIM SHARED ipriStack AS INTEGER
DIM SHARED spriOldTokens(27, 255) AS STRING
DIM SHARED ipriOldTokens AS INTEGER
DIM SHARED spriStringHeap(255) AS STRING
DIM SHARED ipriStringHeap AS INTEGER
DIM SHARED upriFunctions(255) AS udtFunctions
DIM SHARED ipriFunctions AS INTEGER
DIM SHARED spriCurrentFunction AS STRING
DIM SHARED lpriCurrentBytePos AS LONG
DIM SHARED lpriOldCurrentBytePos(27) AS LONG
DIM SHARED bprifunctionfoundflag AS LONG
DIM SHARED bpriFunctionExecuting AS LONG
DIM SHARED ipriState AS INTEGER
CLS
main
END
SUB main
DIM schar AS STRING
DIM stemp AS STRING
OPEN "c:\qb45\jisc3\test\test.asm" FOR INPUT AS #1
DO
schar = INPUT$(1, #1)
lpriCurrentBytePos = lpriCurrentBytePos + 1
SELECT CASE schar
CASE CHR$(10), CHR$(13)
spriTokens(ipriTokens) = stemp
ipriTokens = ipriTokens + 1
stemp = ""
parseTokens ipriTokens
CASE CHR$(9), CHR$(32)
spriTokens(ipriTokens) = stemp
ipriTokens = ipriTokens + 1
stemp = ""
CASE CHR$(34)
DO
schar = INPUT$(1, #1)
SELECT CASE schar
CASE CHR$(34)
EXIT DO
CASE ELSE
stemp = stemp + schar
END SELECT
LOOP UNTIL EOF(1)
CASE ELSE
stemp = stemp + schar
END SELECT
LOOP UNTIL EOF(1)
CLOSE #1
END SUB
SUB parseTokens (icount AS INTEGER)
DIM iindex AS INTEGER
DIM iiterate AS INTEGER
DIM itmp01 AS INTEGER
DIM itmp02 AS INTEGER
DIM ltmp01 AS LONG
DIM ltmp02 AS LONG
DIM dtmp01 AS DOUBLE
DIM dtmp02 AS DOUBLE
DIM stemp AS STRING
DIM bfound AS INTEGER
FOR iindex = 0 TO icount - 1
IF bprifunctionfoundflag = False OR LCASE$(spriTokens(iindex)) = "end_function" THEN
SELECT CASE LCASE$(spriTokens(iindex))
'-----------------------------------------------------------------------
' Add Floats
'-----------------------------------------------------------------------
CASE "add_float"
dtmp01 = upriStack(ipriStack).float
upriStack(ipriStack).float = 0
ipriStack = ipriStack - 1
dtmp02 = upriStack(ipriStack).float
upriStack(ipriStack).float = 0
upriStack(ipriStack).float = dtmp01 + dtmp02
'-----------------------------------------------------------------------
' Add Intgers
'-----------------------------------------------------------------------
CASE "add_int16"
itmp01 = upriStack(ipriStack).int16
upriStack(ipriStack).int16 = 0
ipriStack = ipriStack - 1
itmp02 = upriStack(ipriStack).int16
upriStack(ipriStack).int16 = 0
upriStack(ipriStack).int16 = itmp01 + itmp02
'-----------------------------------------------------------------------
' Add Longs
'-----------------------------------------------------------------------
CASE "add_int32"
ltmp01 = upriStack(ipriStack).int32
upriStack(ipriStack).int32 = 0
ipriStack = ipriStack - 1
ltmp02 = upriStack(ipriStack).int32
upriStack(ipriStack).int32 = 0
upriStack(ipriStack).int32 = ltmp01 + ltmp02
'-----------------------------------------------------------------------
' Add Strings
'-----------------------------------------------------------------------
CASE "add_str"
dtmp01 = VAL(spriStringHeap(upriStack(ipriStack).str))
upriStack(ipriStack).str = 0
ipriStack = ipriStack - 1
dtmp02 = VAL(spriStringHeap(upriStack(ipriStack).str))
upriStack(ipriStack).str = 0
ipriStringHeap = ipriStringHeap + 1
upriStack(ipriStack).str = ipriStringHeap
spriStringHeap(ipriStringHeap) = STR$(dtmp01 + dtmp02)
ipriStringHeap = ipriStringHeap + 1
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "callfn"
iindex = iindex + 1
stemp = LCASE$(spriTokens(iindex))
FOR iiterate = 0 TO UBOUND(upriFunctions)
IF RTRIM$(LCASE$(upriFunctions(iiterate).ssource)) = stemp THEN
bfound = True
EXIT FOR
END IF
NEXT iiterate
IF bfound = False THEN
serror "Function not found"
END
ELSE
saveState
SEEK #1, upriFunctions(iiterate).lposition + 2
bpriFunctionExecuting = True
END IF
'-----------------------------------------------------------------------
' Convert value at TOS to float
'-----------------------------------------------------------------------
CASE "cfloat"
itmp01 = upriStack(ipriStack).int16
IF itmp01 <> 0 THEN
upriStack(ipriStack).float = CDBL(itmp01)
upriStack(ipriStack).int16 = 0
ELSE
ltmp01 = upriStack(ipriStack).int32
IF ltmp01 <> 0 THEN
upriStack(ipriStack).float = CDBL(ltmp01)
upriStack(ipriStack).int32 = 0
ELSE
dtmp01 = upriStack(ipriStack).float
IF dtmp01 <> 0 THEN
upriStack(ipriStack).float = CDBL(dtmp01)
upriStack(ipriStack).float = 0
END IF
END IF
END IF
'-----------------------------------------------------------------------
' Convert value at TOS to int16
'-----------------------------------------------------------------------
CASE "cint16"
itmp01 = upriStack(ipriStack).int16
IF itmp01 <> 0 THEN
upriStack(ipriStack).int16 = CINT(itmp01)
ELSE
ltmp01 = upriStack(ipriStack).int32
IF ltmp01 <> 0 THEN
upriStack(ipriStack).int16 = CINT(ltmp01)
upriStack(ipriStack).int32 = 0
ELSE
dtmp01 = upriStack(ipriStack).float
IF dtmp01 <> 0 THEN
upriStack(ipriStack).int16 = CINT(dtmp01)
upriStack(ipriStack).float = 0
END IF
END IF
END IF
'-----------------------------------------------------------------------
' Convert value at TOS to Int32
'-----------------------------------------------------------------------
CASE "cint32"
itmp01 = upriStack(ipriStack).int16
IF itmp01 <> 0 THEN
upriStack(ipriStack).int32 = CLNG(itmp01)
upriStack(ipriStack).int16 = 0
ELSE
ltmp01 = upriStack(ipriStack).int32
IF ltmp01 <> 0 THEN
upriStack(ipriStack).int32 = CLNG(ltmp01)
ELSE
dtmp01 = upriStack(ipriStack).float
IF dtmp01 <> 0 THEN
upriStack(ipriStack).int32 = CINT(dtmp01)
upriStack(ipriStack).float = 0
END IF
END IF
END IF
'-----------------------------------------------------------------------
' Convert value at TOS to string
'-----------------------------------------------------------------------
CASE "cstr"
'-----------------------------------------------------------------------
' Divide Floats
'-----------------------------------------------------------------------
CASE "div_float"
dtmp01 = upriStack(ipriStack).float
upriStack(ipriStack).float = 0
ipriStack = ipriStack - 1
dtmp02 = upriStack(ipriStack).float
upriStack(ipriStack).float = 0
upriStack(ipriStack).float = dtmp02 / dtmp01
'-----------------------------------------------------------------------
' Divide Integers
'-----------------------------------------------------------------------
CASE "div_int16"
itmp01 = upriStack(ipriStack).int16
upriStack(ipriStack).int16 = 0
ipriStack = ipriStack - 1
itmp02 = upriStack(ipriStack).int16
upriStack(ipriStack).int16 = 0
upriStack(ipriStack).int16 = itmp02 / itmp01
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "div_int32"
ltmp01 = upriStack(ipriStack).int32
upriStack(ipriStack).int32 = 0
ipriStack = ipriStack - 1
ltmp02 = upriStack(ipriStack).int32
upriStack(ipriStack).int32 = 0
upriStack(ipriStack).int32 = ltmp02 / ltmp01
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "div_str"
dtmp01 = VAL(spriStringHeap(upriStack(ipriStack).str))
upriStack(ipriStack).str = 0
ipriStack = ipriStack - 1
dtmp02 = VAL(spriStringHeap(upriStack(ipriStack).str))
upriStack(ipriStack).str = 0
ipriStringHeap = ipriStringHeap + 1
upriStack(ipriStack).str = ipriStringHeap
spriStringHeap(ipriStringHeap) = STR$(dtmp02 / dtmp01)
ipriStringHeap = ipriStringHeap + 1
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "end"
'do nothing now
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "end_function"
IF bpriFunctionExecuting = True THEN
bpriFunctionExecuting = False
restoreState
SEEK #1, lpriCurrentBytePos + 2
ELSE
IF bprifunctionfoundflag = True THEN
bprifunctionfoundflag = False
upriFunctions(ipriFunctions - 1).llength = lpriCurrentBytePos - upriFunctions(ipriFunctions - 1).lposition
ELSE
serror "end_function found without matching function"
END
END IF
END IF
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "end_module"
spriModuleName = ""
END
'-----------------------------------------------------------------------
' Declares a function
' TODO: Add code that checks to see if the function has already been
' declared.
'-----------------------------------------------------------------------
CASE "function"
iindex = iindex + 1
stemp = spriTokens(iindex)
bprifunctionfoundflag = True
upriFunctions(ipriFunctions).ssource = stemp
upriFunctions(ipriFunctions).lposition = lpriCurrentBytePos
ipriFunctions = ipriFunctions + 1
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "idiv_float"
dtmp01 = upriStack(ipriStack).float
upriStack(ipriStack).float = 0
ipriStack = ipriStack - 1
dtmp02 = upriStack(ipriStack).float
upriStack(ipriStack).float = 0
upriStack(ipriStack).float = dtmp02 \ dtmp01
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "idiv_int16"
itmp01 = upriStack(ipriStack).int16
upriStack(ipriStack).int16 = 0
ipriStack = ipriStack - 1
itmp02 = upriStack(ipriStack).int16
upriStack(ipriStack).int16 = 0
upriStack(ipriStack).int16 = itmp02 \ itmp01
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "idiv_int32"
ltmp01 = upriStack(ipriStack).int32
upriStack(ipriStack).int32 = 0
ipriStack = ipriStack - 1
ltmp02 = upriStack(ipriStack).int32
upriStack(ipriStack).int32 = 0
upriStack(ipriStack).int32 = ltmp02 \ ltmp01
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "idiv_str"
dtmp01 = VAL(spriStringHeap(upriStack(ipriStack).str))
upriStack(ipriStack).str = 0
ipriStack = ipriStack - 1
dtmp02 = VAL(spriStringHeap(upriStack(ipriStack).str))
upriStack(ipriStack).str = 0
ipriStringHeap = ipriStringHeap + 1
upriStack(ipriStack).str = ipriStringHeap
spriStringHeap(ipriStringHeap) = STR$(dtmp02 \ dtmp01)
ipriStringHeap = ipriStringHeap + 1
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "mod_float"
dtmp01 = upriStack(ipriStack).float
upriStack(ipriStack).float = 0
ipriStack = ipriStack - 1
dtmp02 = upriStack(ipriStack).float
upriStack(ipriStack).float = 0
upriStack(ipriStack).float = dtmp02 MOD dtmp01
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "mod_int16"
itmp01 = upriStack(ipriStack).int16
upriStack(ipriStack).int16 = 0
ipriStack = ipriStack - 1
itmp02 = upriStack(ipriStack).int16
upriStack(ipriStack).int16 = 0
upriStack(ipriStack).int16 = itmp02 MOD itmp01
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "mod_int32"
ltmp01 = upriStack(ipriStack).int32
upriStack(ipriStack).int32 = 0
ipriStack = ipriStack - 1
ltmp02 = upriStack(ipriStack).int32
upriStack(ipriStack).int32 = 0
upriStack(ipriStack).int32 = ltmp02 MOD ltmp01
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "mod_str"
dtmp01 = VAL(spriStringHeap(upriStack(ipriStack).str))
upriStack(ipriStack).str = 0
ipriStack = ipriStack - 1
dtmp02 = VAL(spriStringHeap(upriStack(ipriStack).str))
upriStack(ipriStack).str = 0
ipriStringHeap = ipriStringHeap + 1
upriStack(ipriStack).str = ipriStringHeap
spriStringHeap(ipriStringHeap) = STR$(dtmp02 MOD dtmp01)
ipriStringHeap = ipriStringHeap + 1
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "module"
iindex = iindex + 1
spriModuleName = spriTokens(iindex)
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "mul_float"
dtmp01 = upriStack(ipriStack).float
upriStack(ipriStack).float = 0
ipriStack = ipriStack - 1
dtmp02 = upriStack(ipriStack).float
upriStack(ipriStack).float = 0
upriStack(ipriStack).float = dtmp01 * dtmp02
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "mul_int16"
itmp01 = upriStack(ipriStack).int16
upriStack(ipriStack).int16 = 0
ipriStack = ipriStack - 1
itmp02 = upriStack(ipriStack).int16
upriStack(ipriStack).int16 = 0
upriStack(ipriStack).int16 = itmp01 * itmp02
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "mul_int32"
ltmp01 = upriStack(ipriStack).int32
upriStack(ipriStack).int32 = 0
ipriStack = ipriStack - 1
ltmp02 = upriStack(ipriStack).int32
upriStack(ipriStack).int32 = 0
upriStack(ipriStack).int32 = ltmp01 + ltmp02
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "mul_str"
dtmp01 = VAL(spriStringHeap(upriStack(ipriStack).str))
upriStack(ipriStack).str = 0
ipriStack = ipriStack - 1
dtmp02 = VAL(spriStringHeap(upriStack(ipriStack).str))
upriStack(ipriStack).str = 0
ipriStringHeap = ipriStringHeap + 1
upriStack(ipriStack).str = ipriStringHeap
spriStringHeap(ipriStringHeap) = STR$(dtmp01 * dtmp02)
ipriStringHeap = ipriStringHeap + 1
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "sub_float"
dtmp01 = upriStack(ipriStack).float
upriStack(ipriStack).float = 0
ipriStack = ipriStack - 1
dtmp02 = upriStack(ipriStack).float
upriStack(ipriStack).float = 0
upriStack(ipriStack).float = dtmp02 - dtmp01
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "sub_int16"
itmp01 = upriStack(ipriStack).int16
upriStack(ipriStack).int16 = 0
ipriStack = ipriStack - 1
itmp02 = upriStack(ipriStack).int16
upriStack(ipriStack).int16 = 0
upriStack(ipriStack).int16 = itmp02 - itmp01
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "sub_int32"
ltmp01 = upriStack(ipriStack).int32
upriStack(ipriStack).int32 = 0
ipriStack = ipriStack - 1
ltmp02 = upriStack(ipriStack).int32
upriStack(ipriStack).int32 = 0
upriStack(ipriStack).int32 = ltmp02 - ltmp01
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "sub_str"
dtmp01 = VAL(spriStringHeap(upriStack(ipriStack).str))
upriStack(ipriStack).str = 0
ipriStack = ipriStack - 1
dtmp02 = VAL(spriStringHeap(upriStack(ipriStack).str))
upriStack(ipriStack).str = 0
ipriStringHeap = ipriStringHeap + 1
upriStack(ipriStack).str = ipriStringHeap
spriStringHeap(ipriStringHeap) = STR$(dtmp02 - dtmp01)
ipriStringHeap = ipriStringHeap + 1
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "push_float"
ipriStack = ipriStack + 1
upriStack(ipriStack).float = VAL(spriTokens(iindex + 1))
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "push_int16"
ipriStack = ipriStack + 1
upriStack(ipriStack).int16 = VAL(spriTokens(iindex + 1))
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "push_int32"
ipriStack = ipriStack + 1
upriStack(ipriStack).int32 = VAL(spriTokens(iindex + 1))
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "push_str"
ipriStack = ipriStack + 1
upriStack(ipriStack).str = ipriStringHeap
spriStringHeap(ipriStringHeap) = spriTokens(iindex + 1)
ipriStringHeap = ipriStringHeap + 1
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "print_float"
PRINT upriStack(ipriStack).float
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "print_int16"
PRINT upriStack(ipriStack).int16
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "print_int32"
PRINT upriStack(ipriStack).int32
'-----------------------------------------------------------------------
'
'-----------------------------------------------------------------------
CASE "print_str"
PRINT spriStringHeap(upriStack(ipriStack).str)
END SELECT
END IF
NEXT iindex
ERASE spriTokens
ipriTokens = 0
END SUB
SUB restoreState
DIM iindex AS INTEGER
ipriState = ipriState - 1
lpriCurrentBytePos = lpriOldCurrentBytePos(ipriState)
lpriOldCurrentBytePos(ipriState) = 0
FOR iindex = 0 TO 255
spriTokens(iindex) = spriOldTokens(ipriState, iindex)
spriOldTokens(ipriState, iindex) = ""
NEXT iindex
END SUB
SUB saveState
DIM iindex AS INTEGER
lpriOldCurrentBytePos(ipriState) = lpriCurrentBytePos
FOR iindex = 0 TO 255
spriOldTokens(ipriState, iindex) = spriTokens(iindex)
NEXT iindex
ipriState = ipriState + 1
END SUB
SUB serror (ssource AS STRING)
PRINT ssource
END SUB
-Jeff