'
This is a script engine and a demo for it.
Please report, any feedback is welcome
The 3 provided files below are:
se_engine.inc
se_errors.inc
se_engine_demo.bas
Compiled demo:
http://megaexplorer.com/miscfiles/se_engine_demo.zip
Language description:
This is a demo for my rough, proof of concept script engine
framework, or basic interprete, as you like.
Supported dialect is a expandable powerbasic subset.
Please see below for keywords detailed description.
There are two variables types, numbers and strings.
Numbers are internally stored as PB singles, strings
are dynamic strings. There is not a predefined variables
count limit. Loops and if/then can be nested to any deep,
because they are managed by state machine not recursively.
Variables must be declared prior use and are all 'globals'.
No functions and subs yet. I have a version of this with them
but more testing is need. Well...this one also needs more
testing
Save this as "se_engine.inc"
Save this as "se_errors.inc"
Save this as "se_engine_demo.bas"
This is a script engine and a demo for it.
Please report, any feedback is welcome
The 3 provided files below are:
se_engine.inc
se_errors.inc
se_engine_demo.bas
Compiled demo:
http://megaexplorer.com/miscfiles/se_engine_demo.zip
Language description:
This is a demo for my rough, proof of concept script engine
framework, or basic interprete, as you like.
Supported dialect is a expandable powerbasic subset.
Please see below for keywords detailed description.
There are two variables types, numbers and strings.
Numbers are internally stored as PB singles, strings
are dynamic strings. There is not a predefined variables
count limit. Loops and if/then can be nested to any deep,
because they are managed by state machine not recursively.
Variables must be declared prior use and are all 'globals'.
No functions and subs yet. I have a version of this with them
but more testing is need. Well...this one also needs more
testing
Save this as "se_engine.inc"
Code:
#IF 0
'########################################
'########################################
'############### SE Script engine
'############### 2007 by Gus del Solar
'############### GDSSIS software
'
'Language description:
'This is a demo for my rough, proof of concept script engine
'framework, or basic interprete, as you like.
'Supported dialect is a expandable powerbasic subset.
'Please see below for keywords detailed description.
'There are two variables types, numbers and strings.
'Numbers are internally stored as PB singles, strings
'are dynamic strings. There is not a predefined variables
'count limit. Loops and if/then can be nested to any deep,
'because they are managed by state machine not recursively.
'Variables must be declared prior use and are all 'globals'.
'No functions and subs yet. I have a version of this with them
'but more testing is need. Well...this one also needs more
'testing :)
'
'Application:
'Could be useful as didactic tool, configuration tool, etc.
'
'Internal description:
'The whole script is scanned byte by byte and tokenized using
'pointers, so quite fast. Built in functions tokens are
'loaded with a function definition code that includes argument
'count, argument types, return type, etc.
'Then a preprocessor does several pass to the tokenized code,
'I prefered a well formated code to allow fast execution later.
'All jumps and loops addresses are precalculated and set
'at preprocessor level. Variabled are dimmed in that stage also.
'Numeric expressions are converted to postfix while
'processed, then solved with the help of a little stack and
'pointers. No arrays or strings involved in math processing.
'Set %DEBUG_FLAG to 1 to see detailed debug information.
'
'Detailed description:
'
' VARIABLES TYPES SUPPORT
' numbers (PB singles)
' strings (PB dynamic strings)
'
' COMMENTS
' '
'
' NUMERIC OPERATORS SUPPORT
' +, -, *, /, \, ^, =
' <, >, =<, <=, >=, =>, <>, ><
' not, istrue, isfalse
' and, or, xor
' imp, eqv, mod
'
' STRING OPERATORS SUPPORT
' + , =, <, >, <=, =<, =>, >=
'
' FLOW CONTROL SUPPORT (any deep)
' if <cond> then, elseif <cond> then, else, end if
' exit, exit if, exit do/loop, exit for
' for var = n/var/expr to n/var/expr [step n/var/expr], next
' do, loop
' do <cond>, loop
' do, loop <cond>
' do while/until <cond>, loop
' do, loop while/until <cond>
' while <cond>, wend
' goto label
'
' STRING FUNCTIONS SUPPORT
' left (st expr,n expr)
' mid (st expr,n expr,n expr)
' right (st expr,n expr)
' trim (st expr)
' lcase (st expr)
' ucase (st expr)
' mcase (st expr)
' hcase (st expr) ThIs iS HcAsE (very ugly)
' str (n expr)
' chr (n expr)
' space (n expr)
' string (n expr,n expr)
' bin (n expr)
' hex (n expr)
' acode (st expr)
' ucode (st expr)
' nul (n expr)
' date
' time
'
' NUMERIC FUNCTIONS SUPPORT
' asc (st expr)
' instr (st expr, st expr)
' len (st expr)
' val (st expr)
' rnd (n min, n max)
' even (n expr)
' prglines
' timer
' ceil (n expr)
' int (n expr)
' fix (n expr)
' sqr (n expr), sin (n expr)
' cos (n expr), tan (n expr), atn (n expr), exp2, exp10 (n expr)
' exp (n expr), log10 (n expr), abs (n expr), log2 (n expr)
' log (n expr), sgn (n expr), fac (n expr), pi
'
' MISC
' randomize (no args, always uses timer as seed)
'
' LABELS
' standard labels
'
' I/O SUPPORT (demos)
' print, ? (will print to result textbox)
' stdout (st expr)
' stdin
' waitkey
' beep
' msgbox (st text, n style, st tittle)
'
'Note:
' No optional arguments.
'
'Whishlist:
' some script <-> caller communication
' more data types, unsigned, ext, types
' arrays
' functions, subs (and private subs and functions)
' objects ?
' better type detect
' asm math processing
' static, locals (all globals now)
' funny girls, money, cars, a timemachine
'
' =====================================================
' COPYRIGHT AND PERMISSION NOTICE (copied from elsewhere)
' =====================================================
' Copyright (c) 2007 - 2007, Gus del Solar
' All rights reserved.
' Permission to use and copy this software for non
' commercial purpose always keeping this notice. For
' commercial please contact the author at gds3k3 gmail com
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF
' ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED
' TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
' PARTICULAR PURPOSE AND NONINFRINGEMENT OF THIRD PARTY
' RIGHTS. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
' HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
' LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
' OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH
' THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
'
#ENDIF
%DEBUG_FLAG = 0 'set this one to 1 to see debug info
%ASCII_NULL = 0 '
%ASCII_TAB = 9 'TAB
%ASCII_LINEFEED = 10 'LF
%ASCII_ENTER = 13 'CR
%ASCII_ESCAPE = 27 'ESC
%ASCII_SPACE = 32 '
%ASCII_DOUBLEQUOTE = 34 '"
%ASCII_AMPER = 38 '&
%ASCII_APOSTROPHE = 39 ''
%ASCII_PARENTHESES_OPEN = 40 '(
%ASCII_PARENTHESES_CLOSE = 41 ')
%ASCII_MUL = 42 '*
%ASCII_PLUS = 43 '-
%ASCII_COMMA = 44 ',
%ASCII_MINUS = 45 '+
%ASCII_PERIOD = 46 '.
%ASCII_DIV = 47 '/
%ASCII_NUM0 = 48 '0
%ASCII_NUM9 = 57 '9
%ASCII_COLON = 58 ':
%ASCII_SEMICOLON = 59 ';
%ASCII_LESS = 60 '<
%ASCII_EQUAL = 61 '=
%ASCII_MORE = 62 '>
%ASCII_QUESTION = 63 '?
%ASCII_UCASE_A = 65 'A
%ASCII_UCASE_N = 78 'N
%ASCII_UCASE_S = 83 'S
%ASCII_UCASE_Z = 90 'Z
%ASCII_INTDIV = 92 '\
%ASCII_BRACKETOPEN = 91 '[
%ASCII_BRACKETCLOSE = 93 ']
%ASCII_CARET = 94 '^
%ASCII_UNDERSCORE = 95 '_
%ASCII_LCASE_A = 97 'a
%ASCII_LCASE_B = 98 'b
%ASCII_LCASE_C = 99 'c
%ASCII_LCASE_E = 101 'e
%ASCII_LCASE_F = 102 'f
%ASCII_LCASE_I = 105 'i
%ASCII_LCASE_M = 109 'm
%ASCII_LCASE_X = 120 'x
%ASCII_LCASE_Z = 122 'z
%ASCII_TILDE = 126 '~
%ASCII_OR = 179 '|
%SE_TOKEN_UNDEFINED = 0
%SE_TOKEN_DELIMITER = 1
%SE_TOKEN_NUMBER = 2
%SE_TOKEN_ALPHA = 3
%SE_TOKEN_STRING = 4
%SE_TOKEN_CRLF = 5
%SE_TOKEN_COLON = 6
%SE_TOKEN_EOL = 13
%SE_TOKEN_CONDITION = 8
%SE_TOKEN_NUMEXPR = 9
%SE_TOKEN_STREXPR = 10
%SE_TOKEN_ASSIGN = 11
%SE_TOKEN_PRINT = 14
%SE_MAXTOKENLEN = 64 'max token lenght, tokens are text constants, numbers, labels and var names
%SE_MAXEXPRLEN = 128 'max expression len
%SE_MAXTOKENS = 512 '512 tokens should be enough for anyone...bill said that not me
%SE_MAXCODETOKENS = 2048 'small codetokens buffer, use 8192 or more, no checking of this
'function definition flags
%SE_FDEF_USRSUB = &h00800000 'user sub
%SE_FDEF_USRFUN = &h00400000 'user function
%SE_FDEF_OPERATOR = &h20000000 'operator
%SE_FDEF_FLOWCTRL = &h00100000 'flow control
%SE_FDEF_RETNOT = &h00200000 'no return
%SE_FDEF_BINFUN = &h10000000 'built in function
%SE_FDEF_RETSNG = &h01000000 'numeric return
%SE_FDEF_RETLNG = &h02000000 'numeric return
%SE_FDEF_RETDWD = &h04000000 'numeric return
%SE_FDEF_RETSTR = &h08000000 'string return
%SE_FDEF_ARGS1 = &h00000100 'has 1 arg
%SE_FDEF_ARGS2 = &h00000200 'has 2 arg
%SE_FDEF_ARGS3 = &h00000300 'has 3 arg
%SE_FDEF_ARGS4 = &h00000400 'has 4 arg
%SE_FDEF_ARG1NUM = &h00001000 'arg1 is number
%SE_FDEF_ARG1STR = &h00002000 'arg1 is string
%SE_FDEF_ARG2NUM = &h00004000 'arg2 is number
%SE_FDEF_ARG2STR = &h00008000 'arg2 is string
%SE_FDEF_ARG3NUM = &h00010000 'arg3 is number
%SE_FDEF_ARG3STR = &h00020000 'arg3 is string
%SE_FDEF_ARG4NUM = &h00040000 'arg4 is number
%SE_FDEF_ARG4STR = &h00080000 'arg4 is string
%SE_FDEF_PARARGS = &h00000800 'args are parenthised
%SE_FDEF_RETNUM = %SE_FDEF_RETDWD OR %SE_FDEF_RETSNG OR %SE_FDEF_RETLNG 'any numeric return
'%SE_FDEF_ARG1OPT = &h01000000 'arg1 is optional
'%SE_FDEF_ARG2OPT = &h02000000 'arg2 is optional
'%SE_FDEF_ARG3OPT = &h04000000 'arg3 is optional
'%SE_FDEF_ARG4OPT = &h08000000 'arg4 is optional
%SE_FDEF_ARGMASK = &h00000700???
%SE_FDEF_PARARGS = &h00000800???
%SE_FDEF_RETMASK = &h00f00000???
%SE_FDEF_ARGTYPE = &h000ff000???
%SE_FDEF_SUBMASK = &h00800000???
%SE_FDEF_FUNMASK = &h00400000???
MACRO funargs(fun) = (fun AND %SE_FDEF_ARGMASK) \ 256 'function arguments count
MACRO parargs(fun) = ISTRUE(fun AND %SE_FDEF_PARARGS) '\ %SE_FDEF_PARARGS 'are arguments parenthised?
MACRO isnumvar(xr) = ISTRUE(xr AND %SE_FDEF_RETNUM)
%SE_TOKENCMD_ABS = 1 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_ACODE = 2 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1STR OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_AND = 3 OR %SE_FDEF_OPERATOR
%SE_TOKENCMD_AS = 4 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_ASC = 5 OR %SE_FDEF_RETNUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_ATN = 6 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_BEEP = 11 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_BIN = 10 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_CASE = 12 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_CMD = 13 OR %SE_FDEF_RETSTR OR %SE_FDEF_BINFUN
%SE_TOKENCMD_CEIL = 15 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_CHR = 18 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_CINT = 16 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_COS = 17 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_DATE = 24 OR %SE_FDEF_RETSTR OR %SE_FDEF_BINFUN
%SE_TOKENCMD_DECR = 25 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN
%SE_TOKENCMD_DO = 26 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_DWORD = 27 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_ENVGET = 28 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1STR OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_ENVSET = 29 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_EXTRACT = 30
%SE_TOKENCMD_END = 31 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_ELSE = 32 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_ELSEIF = 33 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_EQV = 34 OR %SE_FDEF_OPERATOR
%SE_TOKENCMD_ERASE = 35 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_EVEN = 36 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_EXP = 37 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_EXP2 = 38 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_EXP10 = 39 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_EXIT = 40 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_FAC = 41 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_FIX = 42 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_FOR = 43 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_FUNCTION = 44 OR %SE_FDEF_PARARGS
%SE_TOKENCMD_FRAC = 45 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_FORMAT = 46
%SE_TOKENCMD_FUNNAME = 47 OR %SE_FDEF_RETSTR OR %SE_FDEF_BINFUN
%SE_TOKENCMD_GOTO = 50 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_GOSUB = 51 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_HCASE = 55 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1STR OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_HEX = 56 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_IF = 66 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_IMP = 63 OR %SE_FDEF_OPERATOR
%SE_TOKENCMD_INCR = 65 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN
%SE_TOKENCMD_INSTR = 60 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS3 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_ARG2STR OR %SE_FDEF_ARG3STR OR %SE_FDEF_BINFUN
%SE_TOKENCMD_INT = 64 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_ISTRUE = 61 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_ISFALSE = 62 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_JOIN = 63
%SE_TOKENCMD_MAXS = 66
%SE_TOKENCMD_MINS = 67
%SE_TOKENCMD_MAX = 70 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_MSGBOX = 71 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS3 OR %SE_FDEF_ARG1STR OR %SE_FDEF_ARG2NUM OR %SE_FDEF_ARG3STR OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_MCASE = 72 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1STR OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_MID = 73 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS3 OR %SE_FDEF_ARG1STR OR %SE_FDEF_ARG2NUM OR %SE_FDEF_ARG3NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_MIN = 74 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_MOD = 75 OR %SE_FDEF_OPERATOR
%SE_TOKENCMD_NEXT = 76 OR %SE_FDEF_FLOWCTRL
%SE_TOKENCMD_NOT = 77 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_NUMBERS = 78 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_NUL = 79 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN
%SE_TOKENCMD_LCASE = 80 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1STR OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_LEFT = 81 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS2 OR %SE_FDEF_ARG1STR OR %SE_FDEF_ARG2NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_LEN = 82 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1STR OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_LOG = 83 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_LOG2 = 84 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_LOG10 = 85 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_LOOP = 86 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_LET = 87 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_LONG = 88 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_LTRIM = 89 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1STR OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_OCT = 94 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_OR = 95 OR %SE_FDEF_OPERATOR
%SE_TOKENCMD_PRGLINES = 96 OR %SE_FDEF_RETNUM OR %SE_FDEF_BINFUN
%SE_TOKENCMD_PI = 97 OR %SE_FDEF_RETNUM OR %SE_FDEF_BINFUN
%SE_TOKENCMD_RESET = 100 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_RANDOM = 101 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_RETURN = 102 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_RIGHT = 103 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS2 OR %SE_FDEF_ARG1STR OR %SE_FDEF_ARG2NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_RND = 104 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS2 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_ARG2NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_ROUND = 105 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_REMAIN = 106
%SE_TOKENCMD_REMOVE = 107
%SE_TOKENCMD_REPEAT = 108
%SE_TOKENCMD_RETAIN = 109
%SE_TOKENCMD_RTRIM = 110 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1STR OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_SIN = 114 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_SGN = 115 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_SPACE = 116 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_SQR = 117 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_STDERR = 118 OR %SE_FDEF_BINFUN
%SE_TOKENCMD_STDIN = 119 OR %SE_FDEF_RETSTR OR %SE_FDEF_BINFUN
%SE_TOKENCMD_STDOUT = 120 OR %SE_FDEF_RETNOT OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1STR OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_STR = 121 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_STRING = 122 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS2 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_ARG2STR OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_STEP = 123 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_SUB = 124 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_SELECT = 125 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_STRINGS = 126 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_SINGLE = 127 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_STRDEL = 128
%SE_TOKENCMD_STRINS = 129
%SE_TOKENCMD_STRREV = 130
%SE_TOKENCMD_TAB = 133 OR %SE_FDEF_RETSTR OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_TAN = 134 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1NUM OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_TIME = 135 OR %SE_FDEF_RETSTR OR %SE_FDEF_BINFUN
%SE_TOKENCMD_THEN = 136 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_TIMER = 137 OR %SE_FDEF_RETNUM OR %SE_FDEF_BINFUN
%SE_TOKENCMD_TO = 138 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_TRIM = 139 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1STR OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_UCASE = 143 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1STR OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_UCODE = 144 OR %SE_FDEF_RETSTR OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1STR OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_UNTIL = 145 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_VAL = 146 OR %SE_FDEF_RETNUM OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1STR OR %SE_FDEF_BINFUN OR %SE_FDEF_PARARGS
%SE_TOKENCMD_WEND = 147 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_WHILE = 148 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_WAITKEY = 149 OR %SE_FDEF_RETNOT
%SE_TOKENCMD_XOR = 150 OR %SE_FDEF_OPERATOR OR %SE_FDEF_BINFUN
%SE_TOKENCMD_PRINT = 151 OR %SE_FDEF_RETNOT OR %SE_FDEF_ARGS1 OR %SE_FDEF_ARG1STR OR %SE_FDEF_BINFUN
'misc internal use
%SE_TOKENCMD_ENDIF = 201 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_DOW = 202 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_DOU = 203 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_ENDFUN = 204 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_EXITIF = 205 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_EXITDO = 206 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_EXITWHI = 207 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_EXITFOR = 208 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_EXITFUN = 209 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_EXITSUB = 210 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_EXITSEL = 211 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_LOOPW = 212 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_LOOPU = 213 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_GLETNUM = 214 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_GLETSTR = 215 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_RSTNUM = 216 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_RSTSTR = 217 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_ERNUM = 218 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_ERSTR = 219 OR %SE_FDEF_RETNOT OR %SE_FDEF_BINFUN
%SE_TOKENCMD_LABEL = 220 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_PRENUM = 223 OR %SE_FDEF_RETNOT
%SE_TOKENCMD_PRESTR = 224 OR %SE_FDEF_RETNOT
%SE_TOKENCMD_GNUMVAR = 225 OR %SE_FDEF_RETNUM
%SE_TOKENCMD_GSTRVAR = 226 OR %SE_FDEF_RETSTR
%SE_TOKENCMD_FUNNUM = 227 OR %SE_FDEF_RETNUM OR %SE_FDEF_USRFUN OR %SE_FDEF_PARARGS 'numeric user function
%SE_TOKENCMD_ENDSUB = 228 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_ENDSEL = 229 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_ENDSCR = 230 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_JUMPTO = 231 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_FUNSTR = 232 OR %SE_FDEF_RETSTR OR %SE_FDEF_USRFUN OR %SE_FDEF_PARARGS 'string user function
%SE_TOKENCMD_OPERAT = 0 OR %SE_FDEF_OPERATOR
%SE_TOKENCMD_NUMCONST = 0 OR %SE_FDEF_RETNUM
%SE_TOKENCMD_STRCONST = 0 OR %SE_FDEF_RETSTR
%SE_TOKENCMD_INCLUDE = 233
%SE_TOKENCMD_IFS = 234 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
%SE_TOKENCMD_ELSEIFS = 235 OR %SE_FDEF_FLOWCTRL OR %SE_FDEF_BINFUN
'argument types
%SE_ARGTYPE_NUMMSK = %SE_FDEF_ARG1NUM OR %SE_FDEF_ARG2NUM OR %SE_FDEF_ARG3NUM OR %SE_FDEF_ARG4NUM
%SE_ARGTYPE_STRMSK = %SE_FDEF_ARG1STR OR %SE_FDEF_ARG2STR OR %SE_FDEF_ARG3STR OR %SE_FDEF_ARG4STR
%SE_ARGTYPE_VARNUM = %SE_TOKENCMD_GNUMVAR OR %SE_ARGTYPE_NUMMSK
%SE_ARGTYPE_VARSTR = %SE_TOKENCMD_GSTRVAR OR %SE_ARGTYPE_STRMSK
%SE_ARGTYPE_CONNUM = %SE_FDEF_RETNUM OR %SE_ARGTYPE_NUMMSK
%SE_ARGTYPE_CONSTR = %SE_FDEF_RETSTR OR %SE_ARGTYPE_STRMSK
%SE_ARGTYPE_BINNUM = %SE_FDEF_RETNUM OR %SE_FDEF_BINFUN OR %SE_ARGTYPE_NUMMSK
%SE_ARGTYPE_BINSTR = %SE_FDEF_RETSTR OR %SE_FDEF_BINFUN OR %SE_ARGTYPE_STRMSK
%SE_ARGTYPE_USRNUM = %SE_FDEF_RETNUM OR %SE_FDEF_USRFUN OR %SE_ARGTYPE_NUMMSK
%SE_ARGTYPE_USRSTR = %SE_FDEF_RETSTR OR %SE_FDEF_USRFUN OR %SE_ARGTYPE_STRMSK
%SE_ARGTYPE_EXPNUM = %SE_FDEF_RETNUM OR %SE_FDEF_OPERATOR OR %SE_ARGTYPE_NUMMSK
%SE_ARGTYPE_EXPSTR = %SE_FDEF_RETSTR OR %SE_FDEF_OPERATOR OR %SE_ARGTYPE_STRMSK
$ALLOWEDCHARS = "0123456789_abcdefghijklmnopqrstuvwxyz" 'I hope I don't forget any letter
$ALLOWEDFIRSTCHAR = "_abcdefghijklmnopqrstuvwxyz"
'lookfor function calling flags
%SE_LOOK4_NUM = %SE_TOKEN_NUMBER
%SE_LOOK4_ALPHA = %SE_TOKEN_ALPHA
%SE_LOOK4_STRING = %SE_TOKEN_STRING
%SE_LOOK4_EOL = %SE_TOKEN_EOL
%SE_LOOK4_COMMA = %ASCII_COMMA
%SE_LOOK4_EQUAL = %ASCII_EQUAL
%SE_LOOK4_PAROPEN = %ASCII_PARENTHESES_OPEN
%SE_LOOK4_PARCLOSE = %ASCII_PARENTHESES_CLOSE
%SE_LOOK4_SEMICOLON = %ASCII_SEMICOLON
%SE_LOOK4_IF = 00000200
%SE_LOOK4_MATCHPAR = 00000201
%SE_LOOK4_THEN = %SE_TOKENCMD_THEN '00000202
%SE_LOOK4_ELSEIF = 00000208
%SE_LOOK4_ELSE = 00000210
%SE_LOOK4_ENDIF = 00000211
%SE_LOOK4_DO = 00000212
%SE_LOOK4_LOOP = 00000214
%SE_LOOK4_WHILE = 00000215
%SE_LOOK4_WEND = 00000216
%SE_LOOK4_FOR = 00000217
%SE_LOOK4_NEXT = 00000218
%SE_LOOK4_FUNCTION = 00000219
%SE_LOOK4_ENDFUNC = 00000220
%SE_LOOK4_ENDSEL = 00000221
%SE_LOOK4_LABEL = 00000222
%SE_LOOK4_DOWHILE = %SE_TOKENCMD_WHILE '00000223
%SE_LOOK4_DOUNTIL = %SE_TOKENCMD_UNTIL '00000224
%SE_LOOK4_TO = %SE_TOKENCMD_TO
%SE_LOOK4_STEP = %SE_TOKENCMD_STEP
'math stack constants
%SE_EVAL_STACK = 0
%SE_EVAL_OUTPT = 1
%SE_EVAL_PRECE = 2
%SE_EVAL_OTYPE = 3
%SE_EVAL_STYPE = 4
TYPE se_token_type
tktype AS WORD
token AS ASCIIZ * %SE_MAXTOKENLEN
addrs AS DWORD
END TYPE
TYPE se_codetoken
token AS DWORD 'token address, if any
lncnt AS WORD 'source code line number
secnt AS BYTE 'statement counter
tktype AS BYTE '%SE_TOKEN_xxx or ascii delimiter
cmd AS DWORD '%SE_TOKENCMD_xxx and function definition
arg1 AS DWORD 'arguments by context
arg2 AS DWORD '
arg3 AS DWORD '
arg4 AS DWORD '
pre AS SINGLE '
END TYPE
UNION numbers_union
dwd AS DWORD 'used to convert types
sng AS SINGLE '
lng AS LONG '
END UNION
TYPE ses_type 'main program struct, this one carry all pointers
tk AS se_token_type PTR 'tokens ptr
ct AS se_codetoken PTR 'codetokens ptr
tks AS DWORD 'tokens count
ctks AS DWORD 'codetokens count
pc AS DWORD 'program counter
msp AS DWORD 'math stack address
errcode AS DWORD 'lasterror
nvarsn AS DWORD PTR 'points to numeric vars names array
svarsn AS DWORD PTR 'points to string vars names array
nvars AS SINGLE PTR 'points to numeric vars contents array
svars AS STRING PTR 'points to string vars contents array
ubn AS LONG 'ubound numeric vars array
ubs AS LONG 'ubound string vars array
END TYPE
#INCLUDE "se_errors.inc"
DECLARE FUNCTION lookfor(BYVAL ses AS ses_type PTR, BYVAL start AS LONG, BYVAL match AS DWORD) AS DWORD
DECLARE FUNCTION processnumber(BYVAL ses AS ses_type PTR, BYVAL start AS LONG, BYVAL ends AS LONG) AS SINGLE
DECLARE FUNCTION processstring(BYVAL ses AS ses_type PTR, BYVAL start AS LONG, BYVAL ends AS LONG) AS STRING
DECLARE FUNCTION funtext(code AS LONG) AS STRING
DECLARE FUNCTION prtcode(BYVAL ses AS ses_type PTR, BYVAL start AS LONG, BYVAL ends AS LONG) AS DWORD
DECLARE FUNCTION fundefs(code AS STRING) AS LONG
DECLARE FUNCTION argtypetext(code AS DWORD) AS STRING
DECLARE FUNCTION execfun(BYVAL ses AS ses_type PTR) AS DWORD
'debug helper macro
MACRO ifdbgx(x)
#IF %DEBUG_FLAG
x
#ENDIF
END MACRO
'adds double quotes
MACRO pdq(stext) = $DQ + stext + $DQ
'extracts double quotes
FUNCTION extdq(stext AS STRING) AS STRING
LOCAL stmp1 AS STRING
stmp1 = TRIM$(stext)
IF LEFT$(stmp1, 1) = $DQ THEN stmp1 = MID$(stmp1, 2)
IF RIGHT$(stmp1, 1) = $DQ THEN stmp1 = LEFT$(stmp1, LEN(stmp1) - 1)
FUNCTION = stmp1
END FUNCTION
'takes an argument type code and returns a descriptive string, for debug
FUNCTION argtypetext2(code AS DWORD) AS STRING
IF ISTRUE(code AND %SE_FDEF_RETNUM) THEN
FUNCTION = "%SE_ARGTYPE_RETNUM": EXIT FUNCTION
ELSEIF ISTRUE(code AND %SE_FDEF_RETSTR) THEN
FUNCTION = "%SE_ARGTYPE_RETSTR": EXIT FUNCTION
END IF
END FUNCTION
'takes an argument type code and returns a descriptive string, for debug
FUNCTION argtypetext(code AS DWORD) AS STRING
LOCAL stmp1 AS STRING
IF ISTRUE(code AND %SE_FDEF_OPERATOR) THEN
IF ISTRUE(code AND %SE_FDEF_RETNUM) THEN
FUNCTION = "%SE_ARGTYPE_EXPNUM": EXIT FUNCTION
ELSEIF ISTRUE(code AND %SE_FDEF_RETSTR) THEN
FUNCTION = "%SE_ARGTYPE_EXPSTR": EXIT FUNCTION
END IF
END IF
IF ISTRUE(code AND %SE_ARGTYPE_VARNUM) THEN
FUNCTION = "%SE_ARGTYPE_VARNUM": EXIT FUNCTION
ELSEIF ISTRUE(code AND %SE_ARGTYPE_VARSTR) THEN
FUNCTION = "%SE_ARGTYPE_VARSTR": EXIT FUNCTION
END IF
IF ISTRUE(code AND %SE_ARGTYPE_CONNUM) THEN
FUNCTION = "%SE_ARGTYPE_CONNUM": EXIT FUNCTION
ELSEIF ISTRUE(code AND %SE_ARGTYPE_CONSTR) THEN
FUNCTION = "%SE_ARGTYPE_CONSTR": EXIT FUNCTION
END IF
IF ISTRUE(code AND %SE_ARGTYPE_BINNUM) THEN
FUNCTION = "%SE_ARGTYPE_BINNUM": EXIT FUNCTION
ELSEIF ISTRUE(code AND %SE_ARGTYPE_BINSTR) THEN
FUNCTION = "%SE_ARGTYPE_BINSTR": EXIT FUNCTION
END IF
IF ISTRUE(code AND %SE_ARGTYPE_USRNUM) THEN
FUNCTION = "%SE_ARGTYPE_USRNUM": EXIT FUNCTION
ELSEIF ISTRUE(code AND %SE_ARGTYPE_USRSTR) THEN
FUNCTION = "%SE_ARGTYPE_USRSTR": EXIT FUNCTION
END IF
IF ISFALSE(LEN(stmp1)) THEN FUNCTION = "%SE_ARGTYPE_UNKNOW"
END FUNCTION
'takes an argument type code and returns a descriptive string, for debug
FUNCTION typearg(BYVAL fun AS DWORD) AS DWORD
IF ((fun AND %SE_FDEF_RETNUM) = %SE_FDEF_RETNUM) THEN
FUNCTION = %SE_FDEF_RETNUM
ELSEIF ((fun AND %SE_FDEF_RETSTR) = %SE_FDEF_RETSTR) THEN
FUNCTION = %SE_FDEF_RETSTR
ELSEIF ((fun AND %SE_FDEF_RETNOT) = %SE_FDEF_RETNOT) THEN
FUNCTION = %SE_FDEF_RETNOT
ELSEIF isnumvar(fun) THEN
FUNCTION = %SE_FDEF_RETNUM
END IF
END FUNCTION
FUNCTION checkarg(BYVAL ses AS ses_type PTR, BYVAL startin AS LONG, BYVAL arg AS LONG) AS DWORD
LOCAL count, tmp1, tmp2, start AS LONG, result, parflag, alpha, level AS DWORD
dbcprint(" CheckArg In : [" + FORMAT$(startin) + "-" + FORMAT$(arg) + "]")
start = startin
'I always get confussed with many stacked parenthessis...
'fff[((2+4)+fun(2,5)), 3] fun[(((((fun(x, fun(2)))))))] nada str str
' ((2+4)+fun(2,5)) ((((fun(x, fun(2)))))) nada num num
' (2+4)+fun(2,5) (((fun(x, fun(2))))) num num num
' ((fun(x, fun(2)))) num str error
' (fun(x, fun(2))) str num error
' fun(x, fun(2)) str str str
INCR count
WHILE (count < arg)
start = lookfor(ses, start + 1, %SE_LOOK4_COMMA)
IF start THEN INCR count ELSE EXIT DO
WEND
start = IIF&(start, start, startin)
DO
INCR start
SELECT CASE @ses.@ct[start].tktype
CASE %ASCII_PARENTHESES_OPEN
INCR parflag
CASE %ASCII_PARENTHESES_CLOSE
DECR parflag
IF (parflag < 0) THEN
dbcprint(" CheckArg out: 1")
EXIT FUNCTION 'syntax error
END IF
CASE %SE_TOKEN_STRING
IF ISFALSE(result) THEN
result = %SE_ARGTYPE_EXPSTR
ELSEIF (typearg(result) <> %SE_FDEF_RETSTR) THEN
dbcprint(" CheckArg out: 2")
EXIT FUNCTION 'type mismatch
END IF
CASE %SE_TOKEN_NUMBER
IF ISFALSE(result) THEN
result = %SE_ARGTYPE_EXPNUM
ELSEIF (typearg(result) <> %SE_FDEF_RETNUM) THEN
dbcprint(" CheckArg out: 3")
EXIT FUNCTION 'type mismatch
END IF
CASE %SE_TOKEN_ALPHA
IF ISFALSE(result) THEN
result = SWITCH&((typearg(@ses.@ct[start].cmd) = %SE_FDEF_RETNUM), %SE_ARGTYPE_EXPNUM, (typearg(@ses.@ct[start].cmd) = %SE_FDEF_RETSTR), %SE_ARGTYPE_EXPSTR)
ELSEIF (typearg(result) <> typearg(@ses.@ct[start].cmd)) THEN
dbcprint(" CheckArg out: 4")
EXIT FUNCTION 'type mismatch
END IF
IF funargs(@ses.@ct[start].cmd) THEN
IF parargs(@ses.@ct[start].cmd) THEN
start = @ses.@ct[start].arg2
'else
' dbcprint(" CheckArg out: 5")
' EXIT FUNCTION
END IF
END IF
CASE %ASCII_COMMA
IF ISFALSE(parflag) THEN
dbcprint(" CheckArg out: 6")
EXIT DO 'finished
END IF
CASE %SE_TOKEN_EOL
dbcprint(" CheckArg out: 7")
EXIT DO 'finished
END SELECT
LOOP WHILE (start < @ses.@ct[start].arg2)
FUNCTION = result
dbcprint(" CheckArg out: start [" + FORMAT$(startin) + "] found[" + FORMAT$(start) + "-" + FORMAT$(arg) + "] result " + argtypetext2(result))
END FUNCTION
'takes argument arg, solve it and return the result as single (n1, n2,...)
FUNCTION procargn(BYVAL ses AS ses_type PTR, BYVAL start AS LONG, BYVAL arg AS LONG) AS SINGLE
ifdbgx(TRACE PRINT FUNCNAME$)
ifdbgx(TRACE PRINT CALLSTK$(1))
LOCAL count, tmp1 AS LONG
dbcprint(" procargN In : [" + FORMAT$(start) + "-" + FORMAT$(0) + "]")
INCR start
DO
tmp1 = lookfor(ses, start, %SE_LOOK4_COMMA)
INCR count
IF (count = arg) THEN EXIT DO
INCR tmp1
start = tmp1
LOOP WHILE tmp1
dbcprint(" procargN out: [" + FORMAT$(start) + "-" + FORMAT$(tmp1 - 1) + "]")
IF tmp1 THEN
FUNCTION = processnumber(ses, start, tmp1 - 1)
END IF
END FUNCTION
'takes argument arg, solve it and return the result as string (st1, st2,...)
FUNCTION procargs(BYVAL ses AS ses_type PTR, BYVAL start AS LONG, BYVAL arg AS LONG) AS STRING
ifdbgx(TRACE PRINT FUNCNAME$)
ifdbgx(TRACE PRINT CALLSTK$(1))
LOCAL count, tmp1 AS LONG
dbcprint(" procargS In : [" + FORMAT$(start) + "-" + FORMAT$(0) + "]")
INCR start
DO
tmp1 = lookfor(ses, start, %SE_LOOK4_COMMA)
INCR count
IF (count = arg) THEN EXIT DO
INCR tmp1
start = tmp1
LOOP WHILE tmp1
dbcprint(" procargS out: [" + FORMAT$(start) + "-" + FORMAT$(tmp1 - 1) + "]")
IF tmp1 THEN
FUNCTION = processstring(ses, start, tmp1 - 1)
END IF
END FUNCTION
'This function call itself to solve arguments
'but the math engine is not recursive. Expression is
'converted to postfix then solved without recursion.
'A stack is constructed using a little array and pointers.
'Operators precedence is set in tokenizer function (can be changed)
FUNCTION processnumber(BYVAL ses AS ses_type PTR, BYVAL start AS LONG, BYVAL ends AS LONG) AS SINGLE
ifdbgx(TRACE PRINT FUNCNAME$)
ifdbgx(TRACE PRINT CALLSTK$(1))
LOCAL count AS LONG
LOCAL tmp1, tmp2, xpc AS LONG, ido, ids AS LONG, result, sgn1, sgn2 AS SINGLE
LOCAL sp AS SINGLE PTR
sp = @ses.msp
count = ends - start
dbcprint(" processnumber start-ends: [" + FORMAT$(start) + "-" + FORMAT$(ends) + "]")
IF (count < 0) THEN
dbcprint(" processnumber Result: nothing to do")
EXIT FUNCTION
END IF
IF count > %SE_MAXEXPRLEN THEN
'dbcprint("err expression too long/complex")
@ses.errcode = %SE_ERROR_EXPRTOOCOMPLEX
dbcprint(se_errortext(ses))
tprint se_errortext(ses)
EXIT FUNCTION
END IF
@sp[%SE_EVAL_PRECE OF 4, ids OF %SE_MAXEXPRLEN] = 1000
FOR xpc = start TO ends 'replace vars, solve built in functions, store in postfix
tmp1 = @ses.@ct[xpc].arg1
tmp2 = @ses.@ct[xpc].arg2
SELECT CASE AS LONG @ses.@ct[xpc].tktype
CASE %SE_TOKEN_NUMBER 'push to output
IF (count = 0) THEN
ifdbgx(result = @ses.@ct[xpc].pre)
dbcprint(" processnumber Result value: " + FORMAT$(result))
FUNCTION = @ses.@ct[xpc].pre: EXIT FUNCTION
END IF
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = @ses.@ct[xpc].pre
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKEN_ALPHA 'push to output
SELECT CASE AS LONG @ses.@ct[xpc].cmd
CASE %SE_TOKENCMD_GNUMVAR
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = @ses.@nvars[@ses.@ct[xpc].arg1]
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_GSTRVAR
@ses.errcode = %SE_ERROR_NUMEXPECTED
EXIT SELECT
CASE %SE_TOKENCMD_ISTRUE
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = ISTRUE(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_ISFALSE
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = ISFALSE(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_NOT
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = NOT(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_INSTR
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = INSTR(procargn(ses, tmp1, 1), procargs(ses, tmp1, 2), procargs(ses, tmp1, 3))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_LEN
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = LEN(processstring(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_VAL
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = VAL(processstring(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_ASC
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = ASC(processstring(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_EVEN
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = (1 AND (processnumber(ses, tmp1 + 1, tmp2 - 1)))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_ABS
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = ABS(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_INT
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = INT(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_SGN
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = SGN(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_FRAC
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = FRAC(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_FIX
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = FIX(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_CEIL
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = CEIL(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_EXP
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = EXP(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_EXP2
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = EXP2(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_EXP10
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = EXP10(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_COS
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = COS(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_ATN
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = ATN(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_SIN
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = SIN(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_TAN
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = TAN(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_SQR
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = SQR(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_LOG
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = LOG(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_LOG2
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = LOG2(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_LOG10
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = LOG10(processnumber(ses, tmp1 + 1, tmp2 - 1))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_RND
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = RND(procargn(ses, tmp1, 1), procargn(ses, tmp1, 2))
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_PI
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = ATN(1) * 4
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_PRGLINES
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = @ses.@ct[@ses.ctks].lncnt
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_FAC 'factorial, arbitrary 50 limit
sgn1 = processnumber(ses, tmp1 + 1, tmp2 - 1)
IF (sgn1 > 50) THEN
@ses.errcode = %SE_ERROR_OVERFLOW
EXIT FUNCTION
END IF
result = 1
FOR sgn2 = 1 TO sgn1
result = result * sgn2
NEXT
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = result
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_TIMER
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = TIMER
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = %SE_TOKENCMD_PRENUM
INCR ido
CASE %SE_TOKENCMD_RND
CASE ELSE
@ses.errcode = %SE_ERROR_NUMEXPECTED
END SELECT
IF ((ido = 1) AND ISFALSE(count)) THEN 'if no operand, exit
dbcprint(" processnumber Result value: " + FORMAT$(@sp[%SE_EVAL_OUTPT OF 4, ido - 1 OF %SE_MAXEXPRLEN]))
FUNCTION = @sp[%SE_EVAL_OUTPT OF 4, ido - 1 OF %SE_MAXEXPRLEN]
EXIT FUNCTION
END IF
CASE %ASCII_PARENTHESES_OPEN 'push to stack
@sp[%SE_EVAL_STYPE OF 4, ids OF %SE_MAXEXPRLEN] = @ses.@ct[xpc].tktype
@sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN] = @ses.@ct[xpc].tktype
@sp[%SE_EVAL_PRECE OF 4, ids OF %SE_MAXEXPRLEN] = @ses.@ct[xpc].arg1
INCR ids
CASE %ASCII_PARENTHESES_CLOSE 'pop stack to output until ( then discard both
IF ids THEN
DECR ids
WHILE (ids AND (@sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN] <> %ASCII_PARENTHESES_OPEN))
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = @sp[%SE_EVAL_STYPE OF 4, ids OF %SE_MAXEXPRLEN]
INCR ido
DECR ids
WEND 'ids = (
ELSE
@ses.errcode = %SE_ERROR_PAROPENEEXPECTED
END IF
CASE > %ASCII_SPACE 'operator
WHILE ((ido < %SE_MAXEXPRLEN) AND (ids > 0) AND (@ses.@ct[xpc].arg1 <= @sp[%SE_EVAL_PRECE OF 4, ids - 1 OF %SE_MAXEXPRLEN]))
DECR ids 'pop to output
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = @sp[%SE_EVAL_STYPE OF 4, ids OF %SE_MAXEXPRLEN]
INCR ido
WEND 'then push
@sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN] = @ses.@ct[xpc].tktype
@sp[%SE_EVAL_PRECE OF 4, ids OF %SE_MAXEXPRLEN] = @ses.@ct[xpc].arg1
@sp[%SE_EVAL_STYPE OF 4, ids OF %SE_MAXEXPRLEN] = @ses.@ct[xpc].tktype
INCR ids
END SELECT
NEXT
'just to see how it goes
#IF %DEBUG_FLAG
LOCAL stmp1, stmp2, stmp3 AS STRING
stmp2 = ""
FOR tmp1 = start TO ends
SELECT CASE AS LONG @ses.@ct[tmp1].tktype
CASE %SE_TOKEN_UNDEFINED
CASE %SE_TOKEN_NUMBER
stmp2 = stmp2 + "N"
stmp3 = stmp3 + FORMAT$(@ses.@ct[tmp1].pre)
CASE %SE_TOKEN_ALPHA
IF (@ses.@ct[tmp1].cmd = %SE_TOKENCMD_PRENUM) THEN
stmp2 = stmp2 + "F"
stmp3 = stmp3 + FORMAT$(@ses.@ct[tmp1].pre)
ELSEIF (@ses.@ct[tmp1].cmd = %SE_TOKENCMD_GNUMVAR) THEN
stmp2 = stmp2 + "V"
stmp3 = stmp3 + FORMAT$(@ses.@ct[tmp1].arg1) + " val[" + FORMAT$(@ses.@nvars[@ses.@ct[tmp1].arg1]) + "]"
END IF
CASE ELSE
stmp2 = stmp2 + CHR$(@ses.@ct[tmp1].tktype)
stmp3 = stmp3 + CHR$(@ses.@ct[tmp1].tktype)
END SELECT
NEXT
#ENDIF
WHILE (ids > 0) 'pop all stack to output
DECR ids
@sp[%SE_EVAL_OUTPT OF 4, ido OF %SE_MAXEXPRLEN] = @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
@sp[%SE_EVAL_OTYPE OF 4, ido OF %SE_MAXEXPRLEN] = @sp[%SE_EVAL_STYPE OF 4, ids OF %SE_MAXEXPRLEN]
INCR ido
WEND
'all expression is on output stack in postfix format now, so try to solve
'postfix solver, pseudocode from wiki (?)
'a real asm stack would be nicer and faster
'while more tokens (operands or operators) to read
' Read next token
' if token is an operand
' Push token onto stack
' else if token is an operator ("op", say)
' Pop stack and put value in temp2
' Pop stack and put value in temp1
' Push the value of temp1 op temp2 back onto stack
' endif
'endwhile
'Pop value from stack and return it
ifdbgx(stmp1 = "")
DECR ido
FOR tmp1 = 0 TO ido
SELECT CASE AS LONG @sp[%SE_EVAL_OTYPE OF 4, tmp1 OF %SE_MAXEXPRLEN]
CASE %SE_TOKENCMD_PRENUM
'a operand, push to stack
ifdbgx(stmp1 = stmp1 + FORMAT$(@sp[%SE_EVAL_OUTPT OF 4, tmp1 OF %SE_MAXEXPRLEN]))
@sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN] = @sp[%SE_EVAL_OUTPT OF 4, tmp1 OF %SE_MAXEXPRLEN]
@sp[%SE_EVAL_STYPE OF 4, ids OF %SE_MAXEXPRLEN] = @sp[%SE_EVAL_OTYPE OF 4, tmp1 OF %SE_MAXEXPRLEN]
INCR ids
CASE > %ASCII_SPACE
'> SPACE = operator, pop two operands, do the math and push result
ifdbgx(stmp1 = stmp1 + CHR$(@sp[%SE_EVAL_OUTPT OF 4, tmp1 OF %SE_MAXEXPRLEN]))
DECR ids
result = @sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN]
SELECT CASE AS CONST @sp[%SE_EVAL_OTYPE OF 4, tmp1 OF %SE_MAXEXPRLEN]
CASE %ASCII_EQUAL 'operator =
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result = @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
CASE %ASCII_PLUS 'operator +
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result + @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
CASE %ASCII_MINUS 'operator -
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result - @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
CASE %ASCII_MUL 'operator *
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result * @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
CASE %ASCII_INTDIV 'operator /
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result \ @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
CASE %ASCII_DIV 'operator /
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result / @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
CASE %ASCII_CARET 'operator ^
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result ^ @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
CASE %ASCII_LESS 'operator <
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result < @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
CASE %ASCII_MORE 'operator >
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result > @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
CASE %ASCII_LCASE_A 'operator <>
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result <> @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
CASE %ASCII_LCASE_B 'operator <=
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result <= @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
CASE %ASCII_LCASE_C 'operator =>
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result => @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
CASE %ASCII_LCASE_M 'operator MOD
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result MOD @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
CASE %ASCII_AMPER 'operator AND
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result AND @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
CASE %ASCII_OR 'operator OR
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result OR @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
CASE %ASCII_LCASE_X 'operator XOR
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result XOR @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
CASE %ASCII_LCASE_E 'operator EQV
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result EQV @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
CASE %ASCII_LCASE_I 'operator IMP
@sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN] = result IMP @sp[%SE_EVAL_STACK OF 4, ids OF %SE_MAXEXPRLEN]
END SELECT
END SELECT
NEXT
dbcprint(" processnumber Input : " + stmp2 + " [" + stmp3 + "]" + "(" + FORMAT$(start) + "-" + FORMAT$(ends) + ")")
dbcprint(" processnumber Prefix: " + stmp1)
IF (ids > 1) THEN
@ses.errcode = %SE_ERROR_MATHMODULE
ELSE
'all right, result is first on stack (and should be the only one...)
result = @sp[%SE_EVAL_STACK OF 4, ids - 1 OF %SE_MAXEXPRLEN]
dbcprint(" processnumber Result: " + stmp1)
dbcprint(" processnumber Result value: " + FORMAT$(result))
FUNCTION = result
END IF
END FUNCTION
'must improve this one...processes print statement argument
FUNCTION processprint(BYVAL ses AS ses_type PTR, BYVAL start AS LONG, BYVAL ends AS LONG) AS STRING
LOCAL count AS LONG, stmp1, result AS STRING
LOCAL tmp1, tmp2, tmp3, xpc, nested, ope AS LONG, olen AS DWORD
count = ends - start
dbcprint(" processprint input: (" + FORMAT$(start) + "-" + FORMAT$(ends) + ")"))
IF (count < 0) THEN EXIT FUNCTION
tmp1 = start
tmp3 = %ASCII_COMMA
ope = %ASCII_SEMICOLON
WHILE tmp3
tmp2 = lookfor(ses, tmp1, %SE_LOOK4_COMMA)
IF ISFALSE(tmp2) THEN
tmp2 = lookfor(ses, tmp1, %SE_LOOK4_SEMICOLON)
tmp3 = %ASCII_SEMICOLON
END IF
IF ISFALSE(tmp2) THEN
tmp2 = lookfor(ses, tmp1, %SE_LOOK4_EOL)
tmp3 = 0
END IF
stmp1 = processstring(ses, tmp1, tmp2 - 1)
SELECT CASE AS CONST ope
CASE %ASCII_COMMA
tmp1 = 10 - olen
WHILE (tmp1 < 0)
INCR count
tmp1 = (10 * count) - olen
WEND
result = result + SPACE$(tmp1) + extdq(stmp1)
CASE %ASCII_PLUS, %ASCII_SEMICOLON
result = result + extdq(stmp1)
END SELECT
tmp1 = tmp2 + 1
olen = LEN(stmp1)
ope = tmp3
WEND
dbcprint(" processprint result: " + result)
FUNCTION = result
END FUNCTION
'processes an string expression, replaces vars by its values, solves string functions and evaluations
FUNCTION processstring(BYVAL ses AS ses_type PTR, BYVAL start AS LONG, BYVAL ends AS LONG) AS STRING
ifdbgx(TRACE PRINT FUNCNAME$)
ifdbgx(TRACE PRINT CALLSTK$(1))
LOCAL count AS LONG, stmp1, result, comp AS STRING
LOCAL tmp1, tmp2, xpc, nested, ope, alpha AS LONG, plus AS DWORD
count = ends - start
IF (count < 0) THEN EXIT FUNCTION
#IF %DEBUG_FLAG
stmp1 = ""
FOR xpc = start TO ends
SELECT CASE AS CONST @ses.@ct[xpc].tktype
CASE %SE_TOKEN_ALPHA
SELECT CASE AS LONG @ses.@ct[xpc].cmd
CASE %SE_TOKENCMD_GNUMVAR
stmp1 = stmp1 + "N"
CASE %SE_TOKENCMD_GSTRVAR
stmp1 = stmp1 + "V"
CASE ELSE
stmp1 = stmp1 + "F"
END SELECT
CASE %SE_TOKEN_STRING
stmp1 = stmp1 + "S"
CASE ELSE
stmp1 = stmp1 + CHR$(@ses.@ct[xpc].tktype)
END SELECT
NEXT
dbcprint(" processstring input: [" + stmp1 + "]" + "(" + FORMAT$(start) + "-" + FORMAT$(ends) + ")"))
#ENDIF
'replace vars and solve built in functions
FOR xpc = start TO ends
IF ((@ses.@ct[xpc].tktype = %ASCII_PARENTHESES_OPEN) AND(alpha))THEN
INCR nested
ITERATE
ELSEIF ((@ses.@ct[xpc].tktype = %ASCII_PARENTHESES_CLOSE) AND(alpha)) THEN
DECR nested
ITERATE
END IF
IF (nested = 0) THEN
IF plus THEN
SELECT CASE AS CONST @ses.@ct[xpc].tktype
CASE %ASCII_SPACE, %SE_TOKEN_UNDEFINED
CASE %ASCII_PLUS
plus = 0
alpha = 0
CASE %ASCII_LESS, %ASCII_MORE, %ASCII_EQUAL, %ASCII_LCASE_A, _
%ASCII_LCASE_B, %ASCII_LCASE_C
ope = @ses.@ct[xpc].tktype
comp = result
result = ""
plus = 0
CASE ELSE
@ses.errcode = %SE_ERROR_PLUSEXPECTED
END SELECT
ELSE
SELECT CASE AS CONST @ses.@ct[xpc].tktype
CASE %SE_TOKEN_ALPHA
plus = 1
alpha = 1
tmp1 = @ses.@ct[xpc].arg1
tmp2 = @ses.@ct[xpc].arg2
SELECT CASE AS LONG @ses.@ct[xpc].cmd
CASE %SE_TOKENCMD_GNUMVAR
@ses.errcode = %SE_ERROR_STREXPECTED
CASE %SE_TOKENCMD_GSTRVAR
dbcprint(" processstring: %SE_TOKENCMD_GSTRVAR " + FORMAT$(xpc) + " " + FORMAT$(@ses.@ct[xpc].arg1) + " " + FORMAT$(@ses.ubs))
stmp1 = @ses.@svars[@ses.@ct[xpc].arg1]
dbcprint(" processstring: %SE_TOKENCMD_GSTRVAR ok " + FORMAT$(xpc) + " " + FORMAT$(@ses.@ct[xpc].arg1) + "[" + stmp1 + "]")
result = result + stmp1
dbcprint(" processstring: %SE_TOKENCMD_GSTRVAR ok " + FORMAT$(xpc) + " " + FORMAT$(@ses.@ct[xpc].arg1))
CASE %SE_TOKENCMD_STR
dbcprint(" processstring: %SE_TOKENCMD_STR ")
result = result + STR$(processnumber(ses, tmp1 + 1, tmp2 - 1))
dbcprint(" processstring: %SE_TOKENCMD_STR " + result)
CASE %SE_TOKENCMD_CHR
dbcprint(" processstring: %SE_TOKENCMD_CHR ")
result = result + CHR$(processnumber(ses, tmp1 + 1, tmp2 - 1))
CASE %SE_TOKENCMD_SPACE
result = result + SPACE$(processnumber(ses, tmp1 + 1, tmp2 - 1))
CASE %SE_TOKENCMD_STRING
result = result + STRING$(procargn(ses, tmp1, 1), procargs(ses, tmp1, 2))
CASE %SE_TOKENCMD_RIGHT
result = result + RIGHT$(procargs(ses, tmp1, 1), procargn(ses, tmp1, 2))
CASE %SE_TOKENCMD_LEFT
result = result + LEFT$(procargs(ses, tmp1, 1), procargn(ses, tmp1, 2))
CASE %SE_TOKENCMD_MID
result = result + MID$(procargs(ses, tmp1, 1), procargn(ses, tmp1, 2), procargn(ses, tmp1, 3))
CASE %SE_TOKENCMD_TRIM
result = result + TRIM$(processstring(ses, tmp1 + 1, tmp2 - 1))
CASE %SE_TOKENCMD_LCASE
result = result + LCASE$(processstring(ses, tmp1 + 1, tmp2 - 1))
CASE %SE_TOKENCMD_UCASE
result = result + UCASE$(processstring(ses, tmp1 + 1, tmp2 - 1))
CASE %SE_TOKENCMD_MCASE
result = result + MCASE$(processstring(ses, tmp1 + 1, tmp2 - 1))
CASE %SE_TOKENCMD_HCASE
stmp1 = (processstring(ses, tmp1 + 1, tmp2 - 1))
FOR tmp1 = 1 TO LEN(stmp1)
IF (tmp1 AND 1) THEN
MID$(stmp1, tmp1, 1) = UCASE$(MID$(stmp1, tmp1, 1))
ELSE
MID$(stmp1, tmp1, 1) = LCASE$(MID$(stmp1, tmp1, 1))
END IF
NEXT
result = result + stmp1
CASE %SE_TOKENCMD_HEX
result = result + HEX$(processnumber(ses, tmp1 + 1, tmp2 - 1))
CASE %SE_TOKENCMD_OCT
result = result + OCT$(processnumber(ses, tmp1 + 1, tmp2 - 1))
CASE %SE_TOKENCMD_BIN
result = result + BIN$(processnumber(ses, tmp1 + 1, tmp2 - 1))
CASE %SE_TOKENCMD_NUL
result = result + NUL$(processnumber(ses, tmp1 + 1, tmp2 - 1))
CASE %SE_TOKENCMD_DATE
result = result + DATE$
CASE %SE_TOKENCMD_TIME
result = result + TIME$
CASE %SE_TOKENCMD_ACODE
result = result + ACODE$(processstring(ses, tmp1 + 1, tmp2 - 1))
CASE %SE_TOKENCMD_UCODE
result = result + UCODE$(processstring(ses, tmp1 + 1, tmp2 - 1))
CASE %SE_TOKENCMD_STDIN
result = result + stdin
CASE %SE_TOKENCMD_TAB
result = result + TAB$(procargs(ses, tmp1, 1), procargn(ses, tmp1, 2))
CASE ELSE
'IF (ISTRUE(@ses.@ct[xpc].cmd AND %SE_FDEF_RETSTR) AND ISTRUE(isusrfun(@ses.@ct[xpc].cmd))) THEN
' 'funcall
'ELSE
@ses.errcode = %SE_ERROR_STREXPECTED
'END IF
END SELECT
CASE %SE_TOKEN_STRING
result = result + extdq((@ses.@tk[@ses.@ct[xpc].token].token))
dbcprint(" processstring: %SE_TOKEN_STRING " + result)
plus = 1
CASE %ASCII_SPACE, %SE_TOKEN_UNDEFINED
CASE ELSE
IF (@ses.@ct[xpc].cmd AND %SE_FDEF_RETNUM) THEN
@ses.errcode = %SE_ERROR_STREXPECTED
END IF
END SELECT
END IF
END IF
IF @ses.errcode THEN EXIT FUNCTION
NEXT
SELECT CASE AS CONST ope
CASE %ASCII_LESS '<
IF (comp < result) THEN result = "true" ELSE result = "false"
CASE %ASCII_MORE '>
IF (comp > result) THEN result = "true" ELSE result = "false"
CASE %ASCII_EQUAL '=
IF (comp = result) THEN result = "true" ELSE result = "false"
CASE %ASCII_LCASE_A '<>
IF (comp = result) THEN result = "false" ELSE result = "true"
CASE %ASCII_LCASE_B '<=
IF (comp = result) THEN result = "true": EXIT SELECT
IF (comp < result) THEN result = "true" ELSE result = "false"
CASE %ASCII_LCASE_C '=>
IF (comp = result) THEN result = "true": EXIT SELECT
IF (comp > result) THEN result = "true" ELSE result = "false"
END SELECT
dbcprint(" processstring result: " + result)
FUNCTION = result
END FUNCTION
'this code actually 'executes' the script
FUNCTION execfun(BYVAL ses AS ses_type PTR) AS DWORD
ifdbgx(TRACE PRINT FUNCNAME$)
ifdbgx(TRACE PRINT CALLSTK$(1))
LOCAL stmp1, dbg AS STRING
LOCAL tmp1, tmp2 AS LONG
DO
IF (@ses.@ct[@ses.pc].tktype = %SE_TOKEN_ALPHA) THEN
ifdbgx(dbg = " CT:" + FORMAT$(@ses.pc, "000") + " LN:" + FORMAT$(@ses.@ct[@ses.pc].lncnt, "000") + " SN:" + FORMAT$(@ses.@ct[@ses.pc].secnt, "000") + IIF$(@ses.@ct[@ses.pc].cmd, " exec: " + funtext(@ses.@ct[@ses.pc].cmd), ""))
dbcprint(dbg)
SELECT CASE AS LONG @ses.@ct[@ses.pc].cmd
CASE %SE_TOKENCMD_JUMPTO, %SE_TOKENCMD_GOTO, %SE_TOKENCMD_LOOP, %SE_TOKENCMD_WEND, _
%SE_TOKENCMD_EXITIF, %SE_TOKENCMD_EXITDO, %SE_TOKENCMD_EXITWHI, _
%SE_TOKENCMD_EXITFOR, %SE_TOKENCMD_EXITSEL
'a jump is in @ses.@ct[pc].arg1
IF @ses.@ct[@ses.pc].arg1 THEN
dbcprint(" jump from " + FORMAT$(@ses.pc) + " to " + FORMAT$(@ses.@ct[@ses.pc].arg1))
@ses.pc = @ses.@ct[@ses.pc].arg1
END IF
CASE %SE_TOKEN_UNDEFINED, %SE_TOKENCMD_ENDIF, %SE_TOKENCMD_ELSE, %SE_TOKENCMD_DO
'just ignore these
EXIT SELECT
CASE %SE_TOKENCMD_IF, %SE_TOKENCMD_ELSEIF
'arg1 true branch
'arg2 elseif/else branch, or 0 if none
'arg3 endif
'arg4 end condition
'false branch = arg2 or arg3 if arg2 = 0
'IF evalcond(ses, pc) THEN
IF processnumber(ses, @ses.pc + 1, @ses.@ct[@ses.pc].arg4) THEN
ifdbgx(stmp1 = " if cond TRUE jump from " + FORMAT$(@ses.pc) + " to " + FORMAT$(@ses.@ct[@ses.pc].arg1))
@ses.pc = @ses.@ct[@ses.pc].arg1
ELSE
ifdbgx(stmp1 = " if cond FALSE jump from " + FORMAT$(@ses.pc) + " to " + FORMAT$(@ses.@ct[@ses.pc].arg2))
@ses.pc = IIF&(@ses.@ct[@ses.pc].arg2, @ses.@ct[@ses.pc].arg2, @ses.@ct[@ses.pc].arg3)
END IF
dbcprint(stmp1)
CASE %SE_TOKENCMD_IFS, %SE_TOKENCMD_ELSEIFS
stmp1 = processstring(ses, @ses.pc + 1, @ses.@ct[@ses.pc].arg4)
IF stmp1 = "true" THEN
ifdbgx(stmp1 = " ifs cond TRUE jump from " + FORMAT$(@ses.pc) + " to " + FORMAT$(@ses.@ct[@ses.pc].arg1))
@ses.pc = @ses.@ct[@ses.pc].arg1
ELSE
ifdbgx(stmp1 = " ifs cond FALSE jump from " + FORMAT$(@ses.pc) + " to " + FORMAT$(@ses.@ct[@ses.pc].arg2))
@ses.pc = IIF&(@ses.@ct[@ses.pc].arg2, @ses.@ct[@ses.pc].arg2, @ses.@ct[@ses.pc].arg3)
END IF
dbcprint(stmp1)
CASE %SE_TOKENCMD_DOW, %SE_TOKENCMD_WHILE, %SE_TOKENCMD_LOOPW
'do/dow/dou
'loop/loopw/loopu
'arg1 = after do (true branch)
'arg2 = after loop (false branch)
'arg3 = start condition (after while/until if any)
'arg4 = end condition
IF processnumber(ses, @ses.@ct[@ses.pc].arg3, @ses.@ct[@ses.pc].arg4) THEN
ifdbgx(stmp1 = " dow cond TRUE jump from " + FORMAT$(@ses.pc) + " to " + FORMAT$(@ses.@ct[@ses.pc].arg1))
@ses.pc = @ses.@ct[@ses.pc].arg1
ELSE
ifdbgx(stmp1 = " dow cond FALSE jump from " + FORMAT$(@ses.pc) + " to " + FORMAT$(@ses.@ct[@ses.pc].arg2))
@ses.pc = @ses.@ct[@ses.pc].arg2
END IF
dbcprint(stmp1)
CASE %SE_TOKENCMD_DOU, %SE_TOKENCMD_LOOPU
IF ISFALSE(processnumber(ses, @ses.@ct[@ses.pc].arg3, @ses.@ct[@ses.pc].arg4)) THEN
ifdbgx(stmp1 = " dow cond TRUE branch jump from " + FORMAT$(@ses.pc) + " to " + FORMAT$(@ses.@ct[@ses.pc].arg1))
@ses.pc = @ses.@ct[@ses.pc].arg1
ELSE
ifdbgx(stmp1 = " dow cond FALSE branch jump from " + FORMAT$(@ses.pc) + " to " + FORMAT$(@ses.@ct[@ses.pc].arg2))
@ses.pc = @ses.@ct[@ses.pc].arg2
END IF
dbcprint(stmp1)
CASE %SE_TOKENCMD_FOR
'complex one, missed a match of my favorite soccer team solving this one :@
'for
' arg1 = equal + 1 start = arg1 : arg2 - 1
' arg2 = to addr max = arg2 + 1 : step/eol
' arg3 = step/eol step = arg3 + 1 : eol
' arg4 = var idx
' pre = step value
'to
' arg1 = step addr if any
' arg2 = false branch
' arg3 = next addr
' arg4 = eol
'step
' arg1 = eol
'next
' arg1 = for addr
' arg2 = to addr
' arg3 = true branch
' arg4 = false branch
'for/next setup
dbcprint(" for loop setup " + FORMAT$(@ses.pc))
'assign var with start
@ses.@nvars[@ses.@ct[@ses.pc].arg4] = processnumber(ses, @ses.@ct[@ses.pc].arg1, _
@ses.@ct[@ses.pc].arg2 - 1)
dbcprint(" for start: " + FORMAT$(@ses.@nvars[@ses.@ct[@ses.pc].arg4]))
'to pre = max
@ses.@ct[@ses.@ct[@ses.pc].arg2].pre = processnumber(ses, @ses.@ct[@ses.pc].arg2 + 1, _
@ses.@ct[@ses.pc].arg3 - 1)
dbcprint(" for max : " + FORMAT$(@ses.@ct[@ses.@ct[@ses.pc].arg2].pre))
'if step, for pre = step
IF @ses.@ct[@ses.@ct[@ses.pc].arg2].arg1 THEN
@ses.@ct[@ses.pc].pre = processnumber(ses, @ses.@ct[@ses.@ct[@ses.pc].arg2].arg1 + 1, _
@ses.@ct[@ses.@ct[@ses.pc].arg2].arg4 - 1)
ELSE
@ses.@ct[@ses.pc].pre = 1
END IF
dbcprint(" for step : " + FORMAT$(@ses.@ct[@ses.pc].pre))
'initial evaluation
'positive step?
IF (@ses.@ct[@ses.pc].pre => 0) THEN
IF (@ses.@nvars[@ses.@ct[@ses.pc].arg4] <= @ses.@ct[@ses.@ct[@ses.pc].arg2].pre) THEN
@ses.pc = @ses.@ct[@ses.pc].arg3 '+ 1
dbcprint(" for true branch jumpto " + FORMAT$(@ses.pc))
ELSE
@ses.pc = @ses.@ct[@ses.@ct[@ses.pc].arg2].arg2
dbcprint(" for false branch jumpto " + FORMAT$(@ses.pc))
END IF
ELSE
'negative step, compare backwards
IF (@ses.@nvars[@ses.@ct[@ses.pc].arg4] => @ses.@ct[@ses.@ct[@ses.pc].arg2].pre) THEN
@ses.pc = @ses.@ct[@ses.pc].arg3 '+ 1
dbcprint(" for true branch jumpto " + FORMAT$(@ses.pc))
ELSE
@ses.pc = @ses.@ct[@ses.@ct[@ses.pc].arg2].arg2
dbcprint(" for false branch jumpto " + FORMAT$(@ses.pc))
END IF
END IF
CASE %SE_TOKENCMD_NEXT
'next evaluation
'add step to var
dbcprint(" next var = " + FORMAT$(@ses.@nvars[@ses.@ct[@ses.@ct[@ses.pc].arg1].arg4]))
@ses.@nvars[@ses.@ct[@ses.@ct[@ses.pc].arg1].arg4] = @ses.@nvars[@ses.@ct[@ses.@ct[@ses.pc].arg1].arg4] + @ses.@ct[@ses.@ct[@ses.pc].arg1].pre
dbcprint(" next step = " + FORMAT$(@ses.@ct[@ses.@ct[@ses.pc].arg1].pre))
dbcprint(" next result = " + FORMAT$(@ses.@nvars[@ses.@ct[@ses.@ct[@ses.pc].arg1].arg4]))
dbcprint(" next max = " + FORMAT$(@ses.@ct[@ses.@ct[@ses.pc].arg2].pre))
'check step sign
IF (@ses.@ct[@ses.@ct[@ses.pc].arg1].pre => 0) THEN
IF (@ses.@nvars[@ses.@ct[@ses.@ct[@ses.pc].arg1].arg4] <= @ses.@ct[@ses.@ct[@ses.pc].arg2].pre) THEN
@ses.pc = @ses.@ct[@ses.pc].arg3
dbcprint(" next true branch jumpto " + FORMAT$(@ses.pc))
ELSE
@ses.pc = @ses.@ct[@ses.pc].arg4
dbcprint(" next false branch jumpto " + FORMAT$(@ses.pc))
END IF
ELSE
IF (@ses.@nvars[@ses.@ct[@ses.@ct[@ses.pc].arg1].arg4] => @ses.@ct[@ses.@ct[@ses.pc].arg2].pre) THEN
@ses.pc = @ses.@ct[@ses.pc].arg3
dbcprint(" next true branch jumpto " + FORMAT$(@ses.pc))
ELSE
@ses.pc = @ses.@ct[@ses.pc].arg4
dbcprint(" next false branch jumpto " + FORMAT$(@ses.pc))
END IF
END IF
CASE %SE_TOKENCMD_INCR
'global var
IF ISTRUE(@ses.@ct[@ses.pc].arg1) THEN INCR @ses.@nvars[@ses.@ct[@ses.pc].arg1]
CASE %SE_TOKENCMD_DECR
'global var
IF ISTRUE(@ses.@ct[@ses.pc].arg1) THEN DECR @ses.@nvars[@ses.@ct[@ses.pc].arg1]
CASE %SE_TOKENCMD_GLETNUM
'global numeric var assignment
'arg1 = var index
'arg2 = after '='
'arg3 = eol - 1
@ses.@nvars[@ses.@ct[@ses.pc].arg1] = processnumber(ses, @ses.@ct[@ses.pc].arg2, @ses.@ct[@ses.pc].arg3)
CASE %SE_TOKENCMD_GLETSTR
'global string var assignment
'arg1 = var
'arg2 = start expr
'arg3 = end expr
stmp1 = processstring(ses, @ses.@ct[@ses.pc].arg2, @ses.@ct[@ses.pc].arg3)
tmp1 = @ses.@ct[@ses.pc].arg1
dbcprint(" string " + stmp1 + " arg1: " + FORMAT$(tmp1) + " ubs: " + FORMAT$(@ses.ubs))
@ses.@svars[tmp1] = stmp1
CASE %SE_TOKENCMD_PRINT
tprint processprint(ses, @ses.@ct[@ses.pc].arg1, @ses.@ct[@ses.pc].arg2 - 1)
CASE %SE_TOKENCMD_STDOUT
stmp1 = processstring(ses, @ses.@ct[@ses.pc].arg1 + 1, @ses.@ct[@ses.pc].arg2 - 1)
'cprint stmp1
stdout stmp1
CASE %SE_TOKENCMD_STDERR
CASE %SE_TOKENCMD_BEEP
'BEEP!
BEEP
CASE %SE_TOKENCMD_RANDOM
'always use timer as seed
RANDOMIZE TIMER
CASE %SE_TOKENCMD_WAITKEY
waitkey
CASE %SE_TOKENCMD_MSGBOX
MSGBOX procargs(ses, @ses.@ct[@ses.pc].arg1, 1), procargn(ses, @ses.@ct[@ses.pc].arg1, 2), procargs(ses, @ses.@ct[@ses.pc].arg1, 3)
CASE %SE_TOKENCMD_ENDSCR
'script finished, it is a miracle it went so far
dbcprint(" Finished " + FORMAT$(@ses.pc))
EXIT DO
CASE ELSE
END SELECT
END IF
IF @ses.errcode THEN
dbcprint(" execfun error " + FORMAT$(@ses.pc))
FUNCTION = 0
EXIT FUNCTION
END IF
INCR @ses.pc
LOOP UNTIL thstop
dbcprint(" Execfun exiting..." + FORMAT$(@ses.pc))
END FUNCTION
'guess what it does
FUNCTION checkvalidname(BYVAL ses AS ses_type PTR, BYVAL x AS STRING) AS LONG
LOCAL tmp1 AS LONG
IF ISFALSE(LEN(x)) THEN EXIT FUNCTION 'must have len...
x = LCASE$(x)
IF fundefs(x) THEN EXIT FUNCTION 'can't be a reserved word
IF VERIFY(x, $ALLOWEDCHARS) THEN EXIT FUNCTION 'must contain just these
IF VERIFY(MID$(x, 1, 1), $ALLOWEDFIRSTCHAR) THEN EXIT FUNCTION 'must start with one of these
'check here for user function names
FUNCTION = 1 'everything seems ok
END FUNCTION
'looks for a matching codetoken as if/elseif/else/end if/endif/do/loop/while/wend/...and friends
'used by tokenizer and others to find some things addresses
FUNCTION lookfor(BYVAL ses AS ses_type PTR, BYVAL start AS LONG, BYVAL match AS DWORD) AS DWORD
LOCAL stmp1, stmp2 AS STRING, tmp1, nested AS DWORD, pc AS LONG
SELECT CASE AS LONG match
CASE %SE_LOOK4_EOL, %SE_LOOK4_ALPHA, %SE_LOOK4_NUM, %SE_TOKEN_STRING, _
%SE_LOOK4_PAROPEN, %SE_LOOK4_PARCLOSE, %SE_LOOK4_EQUAL
FOR pc = start TO @ses.ctks - 1
IF (@ses.@ct[pc].tktype = match) THEN
FUNCTION = pc
EXIT FUNCTION
END IF
IF (@ses.@ct[pc].tktype = %SE_TOKEN_EOL) THEN EXIT FUNCTION
NEXT
CASE %SE_LOOK4_COMMA
FOR pc = start TO @ses.ctks - 1
SELECT CASE AS CONST @ses.@ct[pc].tktype
CASE %ASCII_COMMA
IF ISFALSE(nested) THEN
FUNCTION = pc
EXIT FUNCTION
END IF
CASE %ASCII_PARENTHESES_CLOSE
IF ISFALSE(nested) THEN
FUNCTION = pc
EXIT FUNCTION
ELSE
DECR nested
END IF
CASE %ASCII_PARENTHESES_OPEN
INCR nested
CASE %SE_TOKEN_EOL
EXIT FUNCTION
END SELECT
NEXT
CASE %SE_LOOK4_SEMICOLON
FOR pc = start TO @ses.ctks - 1
SELECT CASE AS CONST @ses.@ct[pc].tktype
CASE %ASCII_SEMICOLON
IF ISFALSE(nested) THEN
FUNCTION = pc
EXIT FUNCTION
END IF
CASE %ASCII_PARENTHESES_CLOSE
IF ISFALSE(nested) THEN
FUNCTION = pc
EXIT FUNCTION
ELSE
DECR nested
END IF
CASE %ASCII_PARENTHESES_OPEN
INCR nested
CASE %SE_TOKEN_EOL
EXIT FUNCTION
END SELECT
NEXT
CASE %SE_LOOK4_MATCHPAR
INCR start
FOR pc = start TO @ses.ctks - 1
IF (@ses.@ct[pc].tktype = %SE_TOKEN_EOL) THEN EXIT FUNCTION
IF (@ses.@ct[pc].tktype = %ASCII_PARENTHESES_CLOSE) THEN
IF ISFALSE(nested) THEN
FUNCTION = pc
EXIT FUNCTION
ELSE
DECR nested
END IF
END IF
IF (@ses.@ct[pc].tktype = %ASCII_PARENTHESES_OPEN) THEN INCR nested
NEXT
CASE %SE_LOOK4_STEP, %SE_LOOK4_TO, %SE_LOOK4_THEN, %SE_LOOK4_DOWHILE, %SE_LOOK4_DOUNTIL
FOR pc = start TO @ses.ctks - 1
IF (@ses.@ct[pc].tktype = %SE_TOKEN_EOL) THEN EXIT FUNCTION
IF (@ses.@ct[pc].cmd = match) THEN
FUNCTION = pc
EXIT FUNCTION
END IF
NEXT
CASE %SE_LOOK4_ELSEIF, %SE_LOOK4_ELSE, %SE_LOOK4_ENDIF
FOR pc = start TO @ses.ctks - 1
SELECT CASE @ses.@ct[pc].cmd
CASE %SE_TOKENCMD_IF, %SE_TOKENCMD_IFS
INCR nested
'dbcprint (" if nested + 1: " + FORMAT$(nested))
CASE %SE_TOKENCMD_ELSE
IF (nested = 0) THEN
IF (match = %SE_LOOK4_ELSE) THEN FUNCTION = pc: EXIT FUNCTION
END IF
CASE %SE_TOKENCMD_ELSEIF, %SE_TOKENCMD_ELSEIFS
IF (nested = 0) THEN
IF (match = %SE_LOOK4_ELSEIF) THEN FUNCTION = pc: EXIT FUNCTION
END IF
CASE %SE_TOKENCMD_ENDIF
IF (nested = 0) THEN
IF (match = %SE_LOOK4_ENDIF) THEN FUNCTION = pc: EXIT FUNCTION
END IF
DECR nested
'dbcprint (" if nested - 1: " + FORMAT$(nested))
CASE %SE_TOKENCMD_ENDFUN, %SE_TOKENCMD_ENDSUB, %SE_TOKENCMD_FUNCTION, %SE_TOKENCMD_SUB
EXIT FUNCTION
END SELECT
NEXT
CASE %SE_LOOK4_LOOP
FOR pc = start TO @ses.ctks - 1
SELECT CASE AS LONG @ses.@ct[pc].cmd
CASE %SE_TOKENCMD_LOOP, %SE_TOKENCMD_LOOPW, %SE_TOKENCMD_LOOPU
IF (nested = 0) THEN
FUNCTION = pc
EXIT FUNCTION
END IF
DECR nested
CASE %SE_TOKENCMD_DO, %SE_TOKENCMD_DOW, %SE_TOKENCMD_DOU
INCR nested
CASE %SE_TOKENCMD_ENDFUN, %SE_TOKENCMD_ENDSUB, %SE_TOKENCMD_FUNCTION, %SE_TOKENCMD_SUB
EXIT FUNCTION
END SELECT
NEXT
CASE %SE_LOOK4_WEND
FOR pc = start TO @ses.ctks - 1
SELECT CASE AS LONG @ses.@ct[pc].cmd
CASE %SE_TOKENCMD_WHILE
IF (@ses.@ct[pc].secnt = 1) THEN 'no 'do while'/'loop while'
INCR nested
END IF
CASE %SE_TOKENCMD_WEND
IF (nested = 0) THEN
FUNCTION = pc 'lookfor(ses, pc + 1, %SE_LOOK4_EOL) + 1
EXIT FUNCTION
END IF
DECR nested
CASE %SE_TOKENCMD_ENDFUN, %SE_TOKENCMD_ENDSUB, %SE_TOKENCMD_FUNCTION, %SE_TOKENCMD_SUB
EXIT FUNCTION
END SELECT
NEXT
CASE %SE_LOOK4_NEXT
FOR pc = start TO @ses.ctks - 1
SELECT CASE AS LONG @ses.@ct[pc].cmd
CASE %SE_TOKENCMD_FOR
INCR nested
CASE %SE_TOKENCMD_NEXT
IF (nested = 0) THEN
FUNCTION = pc 'lookfor(ses, pc + 1, %SE_LOOK4_EOL) + 1
EXIT FUNCTION
END IF
DECR nested
CASE %SE_TOKENCMD_ENDFUN, %SE_TOKENCMD_ENDSUB, %SE_TOKENCMD_FUNCTION, %SE_TOKENCMD_SUB
EXIT FUNCTION
END SELECT
NEXT
CASE %SE_LOOK4_ENDFUNC
FOR pc = start TO @ses.ctks - 1
IF @ses.@ct[pc].cmd = %SE_TOKENCMD_ENDFUN THEN
FUNCTION = pc
EXIT FUNCTION
ELSEIF @ses.@ct[pc].cmd = %SE_TOKENCMD_FUNCTION THEN
EXIT FUNCTION
ELSEIF @ses.@ct[pc].cmd = %SE_TOKENCMD_SUB THEN
EXIT FUNCTION
ELSEIF @ses.@ct[pc].cmd = %SE_TOKENCMD_ENDSUB THEN
EXIT FUNCTION
END IF
NEXT
CASE %SE_LOOK4_ENDSEL
FOR pc = start TO @ses.ctks - 1
SELECT CASE AS LONG @ses.@ct[pc].cmd
CASE %SE_TOKENCMD_SELECT
INCR nested
CASE %SE_TOKENCMD_ENDSEL
IF (nested = 0) THEN
FUNCTION = lookfor(ses, pc + 1, %SE_LOOK4_EOL) + 1
EXIT FUNCTION
END IF
DECR nested
CASE %SE_TOKENCMD_ENDFUN, %SE_TOKENCMD_ENDSUB, %SE_TOKENCMD_FUNCTION, %SE_TOKENCMD_SUB
EXIT FUNCTION
END SELECT
NEXT
END SELECT
END FUNCTION
'count arguments from a list like (n1,n2,n3...st4), ignore args inside parenthesis
FUNCTION countargs(BYVAL ses AS ses_type PTR, BYVAL start AS LONG, BYVAL ends AS LONG) AS DWORD
LOCAL count, nested, something AS DWORD, pc AS LONG
INCR start
DECR ends
FOR pc = start TO ends
SELECT CASE AS CONST @ses.@ct[pc].tktype
CASE %SE_TOKEN_EOL : EXIT FUNCTION
CASE %ASCII_PARENTHESES_CLOSE : DECR nested
CASE %ASCII_PARENTHESES_OPEN : INCR nested
CASE %ASCII_COMMA
INCR something
IF ISFALSE(nested) THEN INCR count
CASE %ASCII_SPACE
CASE %SE_TOKEN_UNDEFINED
CASE ELSE
INCR something
END SELECT
NEXT
FUNCTION = IIF&(something, count + 1, 0)
END FUNCTION
'This code takes the input string cointaining the whole script and parses its contents
'filling an array of se_codetoken structs and another of se_token_type. Alpha strings
'are checked, if identified as keywords they are not stored as tokens but loaded with
'a function definition code. Then builtin functions are scanned, its arguments counted
'and checked. Also all loops and if/then structs jumps are pre-calculated. Finally the
'processed script is executed. Most errors are reported before that.
'This routine could be improved to have less pass but I keep it this way for clarity.
'Operators precedence is set here, and can be changed.
'
FUNCTION tokenizer(BYVAL inscript AS STRING PTR) AS DWORD
IF ISFALSE(LEN(@inscript)) THEN EXIT FUNCTION
LOCAL pcnt, lcnt, secnt, dqflag, alflag, numflag, comflag, eolflag, labcnt AS DWORD
LOCAL last, this, tkcnt, buffcnt, lastk, pc AS DWORD
LOCAL bptr, optr AS BYTE PTR
LOCAL tokens() AS se_token_type, codetk() AS se_codetoken
LOCAL tmp1, tmp2, tmp3, tmp4 AS LONG
LOCAL buffout AS ASCIIZ * %SE_MAXTOKENLEN
LOCAL script, stmp1, stmp2 AS STRING
LOCAL strvar() AS STRING 'actual script global strings content
LOCAL numvar() AS SINGLE ' " " global numbers "
LOCAL strvarn() AS DWORD 'points to global strings name token
LOCAL numvarn() AS DWORD ' " " numbers " "
LOCAL ses AS ses_type 'main struct
LOCAL sesptr AS DWORD 'main struct pointer
LOCAL var AS LONG 'tmp
LOCAL mstack() AS SINGLE 'math stack
REDIM mstack(0 TO 4, 0 TO %SE_MAXEXPRLEN)
REDIM strvar(0), numvar(0), strvarn(0), numvarn(0)
REDIM tokens(%SE_MAXTOKENS) 'tokens array
REDIM codetk(%SE_MAXCODETOKENS) 'codetokens array
ses.msp = VARPTR(mstack(0, 0)) 'math stack pointer
ses.tk = VARPTR(tokens(0)) 'tokens pointer
ses.ct = VARPTR(codetk(0)) 'codetokens pointer
'ses.funname = 0
sesptr = VARPTR(ses) 'main struct pointer
script = @inscript + $CRLF 'ensure end
optr = VARPTR(buffout) 'two byte pointers to scan the input script
bptr = STRPTR(script) '
dbcprint("")
dbcprint("##################################################")
dbcprint("Tokenizing...")
INCR pc
INCR lcnt
INCR secnt
INCR tkcnt
last = %SE_TOKEN_UNDEFINED
this = %SE_TOKEN_UNDEFINED
'start checking the script, byte by byte
FOR pcnt = 0 TO LEN(script) - 1
SELECT CASE AS LONG @bptr[pcnt]
CASE %ASCII_DOUBLEQUOTE
dbcprint("%ASCII_DOUBLEQUOTE")
dbcprint("%ASCII_STRING")
dqflag = NOT(dqflag)
this = %SE_TOKEN_STRING
CASE %ASCII_PARENTHESES_OPEN, %ASCII_PARENTHESES_CLOSE
dbcprint("%ASCII_PAR_()")
IF dqflag THEN
this = %SE_TOKEN_STRING
ELSE
'parflag = NOT(parflag)
this = %SE_TOKEN_DELIMITER
END IF
CASE %ASCII_MUL, %ASCII_PLUS, %ASCII_MINUS, _
%ASCII_BRACKETOPEN, %ASCII_BRACKETCLOSE, %ASCII_CARET, %ASCII_INTDIV, _
%ASCII_DIV, %ASCII_TAB, %ASCII_SPACE, %ASCII_COMMA, %ASCII_SEMICOLON
dbcprint("%ASCII_SPACE_ETC")
IF dqflag THEN
this = %SE_TOKEN_STRING
ELSE
this = %SE_TOKEN_DELIMITER
END IF
CASE %ASCII_LESS, %ASCII_MORE, %ASCII_EQUAL
dbcprint("%ASCII_SPACE_PAR_ETC")
IF dqflag THEN
this = %SE_TOKEN_STRING
ELSE
this = %SE_TOKEN_DELIMITER
SELECT CASE @bptr[pcnt]
CASE %ASCII_LESS
SELECT CASE @bptr[pcnt + 1]
CASE %ASCII_MORE
@bptr[pcnt] = 97 '<> a
@bptr[pcnt + 1] = 32
CASE %ASCII_EQUAL
@bptr[pcnt] = 98 '<= b
@bptr[pcnt + 1] = 32
END SELECT
CASE %ASCII_MORE
SELECT CASE @bptr[pcnt + 1]
CASE %ASCII_LESS
@bptr[pcnt] = 97 '<> a
@bptr[pcnt + 1] = 32
CASE %ASCII_EQUAL
@bptr[pcnt] = 99 '>= c
@bptr[pcnt + 1] = 32
END SELECT
CASE %ASCII_EQUAL
SELECT CASE @bptr[pcnt + 1]
CASE %ASCII_LESS
@bptr[pcnt] = 98 '<= b
@bptr[pcnt + 1] = 32
CASE %ASCII_MORE
@bptr[pcnt] = 99 '>= c
@bptr[pcnt + 1] = 32
END SELECT
END SELECT
END IF
CASE %ASCII_COLON
IF dqflag THEN
this = %SE_TOKEN_STRING
dbcprint("%ASCII_STRING")
ELSE
this = %SE_TOKEN_COLON
dbcprint("%ASCII_COLON")
END IF
CASE %ASCII_LINEFEED, %ASCII_ENTER
dbcprint("%ASCII_CRLF")
this = %SE_TOKEN_CRLF
comflag = 0
CASE %ASCII_QUESTION
IF dqflag THEN
this = %SE_TOKEN_STRING
dbcprint("%ASCII_STRING")
ELSE
this = %SE_TOKEN_PRINT
dbcprint("%ASCII_QUESTION")
END IF
CASE %ASCII_APOSTROPHE
IF dqflag THEN
this = %SE_TOKEN_STRING
dbcprint("%ASCII_STRING")
ELSE
comflag = 1
this = %SE_TOKEN_CRLF
dbcprint("%ASCII_APOSTROPHE")
END IF
CASE %ASCII_NUM0 TO %ASCII_NUM9, %ASCII_PERIOD
IF dqflag THEN
this = %SE_TOKEN_STRING
dbcprint("%ASCII_STRING")
ELSE
numflag = IIF&((last = %SE_TOKEN_ALPHA), 0, 1)
dbcprint("NUMFLAG =" + IIF$(numflag, "1", "0"))
'this = %SE_TOKEN_ALPHA
this = IIF&(numflag, %SE_TOKEN_NUMBER, %SE_TOKEN_ALPHA)
dbcprint(IIF$(numflag, "%SE_TOKEN_NUMBER","%ASCII_ALPHA"))
END IF
CASE ELSE
' dbcprint("%ASCII_???"
' this = %SE_TOKEN_UNDEFINED
'CASE %ASCII_UCASE_A TO %ASCII_UCASE_Z, %ASCII_LCASE_A TO %ASCII_LCASE_Z, _
' %ASCII_QUESTION
IF dqflag THEN
this = %SE_TOKEN_STRING
dbcprint("%ASCII_STRING")
ELSE
numflag = 0
this = %SE_TOKEN_ALPHA
dbcprint("%ASCII_ALPHA")
END IF
END SELECT
IF (last <> this) THEN
IF (buffcnt > 0) THEN
SELECT CASE AS CONST last
CASE %SE_TOKEN_UNDEFINED
dbcprint("%SE_TOKEN_UNDEFINED")
eolflag = 0
CASE %SE_TOKEN_CRLF, %SE_TOKEN_COLON
eolflag = 1
dbcprint("%SE_TOKEN_CRLF")
codetk(pc).tktype = %SE_TOKEN_EOL
codetk(pc).lncnt = lcnt
codetk(pc).secnt = secnt
secnt = 1
INCR pc
IF (last <> %SE_TOKEN_COLON)THEN INCR lcnt
'IF (this = %SE_TOKEN_DELIMITER) THEN ITERATE
CASE %SE_TOKEN_DELIMITER
eolflag = 0
stmp1 = buffout
stmp2 = TRIM$(stmp1, ANY $SPC + CHR$(0))
'must be at least 1 char outside parenthessis
'if isfalse(parflag) then
'stmp2 = IIF$(LEN(stmp2), stmp2, $SPC)
FOR tmp1 = 1 TO LEN(stmp2)
stmp1 = MID$(stmp2, tmp1, 1)
dbcprint("%SE_TOKEN_DELIMITER " + stmp1 + " len: " + FORMAT$(LEN(stmp1)))
codetk(pc).tktype = ASC(stmp1)
codetk(pc).lncnt = lcnt
codetk(pc).secnt = secnt
codetk(pc).cmd = %SE_FDEF_OPERATOR
'weight precedence m & | x o i
SELECT CASE codetk(pc).tktype
CASE %ASCII_CARET : tmp2 = 7 '^
CASE %ASCII_MUL : tmp2 = 5 '*
CASE %ASCII_DIV : tmp2 = 5 '/
CASE %ASCII_INTDIV : tmp2 = 4 '\
CASE %ASCII_PLUS : tmp2 = 2 '+
CASE %ASCII_MINUS : tmp2 = 2 '-
CASE %ASCII_PARENTHESES_OPEN : tmp2 = 0 '(
CASE %ASCII_PARENTHESES_CLOSE : tmp2 = 0 ')
CASE %ASCII_LCASE_A, _ '<>
%ASCII_LCASE_B, _ '<=
%ASCII_LCASE_C, _ '=>
%ASCII_MORE, _ '>
%ASCII_LESS, _ '<
%ASCII_EQUAL : tmp2 = 1 '=
END SELECT
codetk(pc).arg1 = tmp2 '<- precedence
INCR pc
NEXT
CASE %SE_TOKEN_ALPHA, %SE_TOKEN_STRING, %SE_TOKEN_NUMBER, %SE_TOKEN_PRINT
dbcprint(IIF$(numflag, "%SE_TOKEN_NUMBER" ,"%SE_TOKEN_OTHER"))
codetk(pc).lncnt = lcnt
codetk(pc).secnt = secnt
IF last = %SE_TOKEN_PRINT THEN last = %SE_TOKEN_ALPHA
tmp1 = 1
IF last = %SE_TOKEN_ALPHA THEN
'check if label
IF (this = %SE_TOKEN_COLON) THEN
IF (eolflag) THEN
dbcprint ("label at: " + FORMAT$(pc) + " " + buffout)
codetk(pc).cmd = %SE_TOKENCMD_LABEL
INCR labcnt
END IF
END IF
stmp1 = buffout
stmp1 = LCASE$(TRIM$(stmp1, ANY $SPC + CHR$(0)))
'replace operators and weight precedence
SELECT CASE stmp1
CASE "mod" : tmp1 = 0: tmp2 = 3: stmp1 = "m" 'm'
CASE "and" : tmp1 = 0: tmp2 = 10: stmp1 = "&" '&'
CASE "or" : tmp1 = 0: tmp2 = 11: stmp1 = "|" '|'
CASE "xor" : tmp1 = 0: tmp2 = 11: stmp1 = "x" 'x'
CASE "eqv" : tmp1 = 0: tmp2 = 12: stmp1 = "e" 'e'
CASE "imp" : tmp1 = 0: tmp2 = 13: stmp1 = "i" 'i'
CASE "?" : buffout = "print": buffcnt = 5
codetk(pc).tktype = %SE_TOKEN_ALPHA
END SELECT
IF tmp1 THEN
codetk(pc).tktype = %SE_TOKEN_ALPHA
tmp2 = fundefs(LCASE$(buffout)) 'identify built in functions and statements
IF tmp2 THEN 'set fundef and don't save token
SELECT CASE tmp2 'insert a jumpto just before these
CASE %SE_TOKENCMD_ELSE, %SE_TOKENCMD_ELSEIF
codetk(pc).tktype = %SE_TOKEN_ALPHA
codetk(pc).cmd = %SE_TOKENCMD_JUMPTO
INCR pc
CASE %SE_TOKENCMD_LET '
DECR secnt
END SELECT
codetk(pc).tktype = %SE_TOKEN_ALPHA
codetk(pc).lncnt = lcnt
codetk(pc).secnt = secnt
codetk(pc).cmd = tmp2 '
INCR secnt
tmp1 = 0
END IF
ELSE
codetk(pc).tktype = ASC(stmp1)
codetk(pc).arg1 = tmp2 '<- precedence
codetk(pc).cmd = %SE_FDEF_OPERATOR
INCR secnt
END IF
END IF 'do not save token for these
IF tmp1 THEN
'codetk(pc).tktype = IIF&(numflag, %SE_TOKEN_NUMBER, last)
IF numflag THEN
codetk(pc).tktype = %SE_TOKEN_NUMBER
codetk(pc).cmd = %SE_TOKENCMD_NUMCONST
codetk(pc).pre = VAL(buffout)
ELSE
codetk(pc).tktype = last
IF (last = %SE_TOKEN_STRING) THEN codetk(pc).cmd = %SE_TOKENCMD_STRCONST
END IF
INCR secnt
FOR tmp1 = 1 TO tkcnt - 1
IF (tokens(tmp1).token = buffout) THEN
IF (codetk(pc).cmd = %SE_TOKENCMD_LABEL)THEN
tokens(tmp1).addrs = pc
codetk(pc).arg1 = pc
END IF
codetk(pc).token = tmp1
dbcprint(" token old " + buffout)
tmp1 = -4
EXIT FOR
END IF
NEXT
IF (tmp1 <> -4) THEN
dbcprint(" token new " + buffout)
IF (codetk(pc).cmd = %SE_TOKENCMD_LABEL)THEN
tokens(tkcnt).addrs = pc
END IF
codetk(pc).token = tkcnt
tokens(tkcnt).tktype = IIF&(numflag, %SE_TOKEN_NUMBER, last)
'tokens(tkcnt).tklen = buffcnt
tokens(tkcnt).token = LEFT$(buffout, buffcnt)
INCR tkcnt
END IF
END IF
numflag = 0
INCR pc
CASE ELSE
eolflag = 0
END SELECT
RESET buffout
buffcnt = 0
END IF
last = this
END IF
IF (ISFALSE(comflag) AND (buffcnt < %SE_MAXTOKENLEN)) THEN
@optr[buffcnt] = @bptr[pcnt]
INCR buffcnt
END IF
NEXT
'script scanned and tokenized, process it
'add an EOL
codetk(pc).tktype = %SE_TOKEN_EOL
codetk(pc).lncnt = lcnt
codetk(pc).secnt = secnt
INCR pc
'add a ENDSCRIPT token
codetk(pc).lncnt = lcnt
codetk(pc).secnt = secnt
codetk(pc).cmd = %SE_TOKENCMD_ENDSCR
codetk(pc).tktype = %SE_TOKEN_ALPHA
dbcprint(FORMAT$(pc) + " codetoken/s"))
dbcprint(FORMAT$(tkcnt - 1) + " token/s"))
dbcprint(FORMAT$(labcnt) + " label/s"))
REDIM PRESERVE codetk(pc) 'free some mem
ses.tks = tkcnt
ses.ctks = pc
ses.pc = 1
'start analizing
dbcprint("Analizing...pass 1")
'replace some inconvenient secuences for easy handling ie. 'end if', 'do while', 'exit if', etc
'also search for global var declares and 'dim' them
DO
IF codetk(ses.pc).tktype = %SE_TOKEN_ALPHA THEN
tmp2 = 0
SELECT CASE AS LONG codetk(ses.pc).cmd
CASE %SE_TOKENCMD_END
IF codetk(ses.pc + 1).cmd = %SE_TOKENCMD_IF THEN tmp2 = %SE_TOKENCMD_ENDIF
IF codetk(ses.pc + 1).cmd = %SE_TOKENCMD_SUB THEN tmp2 = %SE_TOKENCMD_ENDSUB: alflag = 0
IF codetk(ses.pc + 1).cmd = %SE_TOKENCMD_FUNCTION THEN tmp2 = %SE_TOKENCMD_ENDFUN: alflag = 0
IF codetk(ses.pc + 1).cmd = %SE_TOKENCMD_SELECT THEN tmp2 = %SE_TOKENCMD_ENDSEL
CASE %SE_TOKENCMD_EXIT
IF codetk(ses.pc + 1).cmd = %SE_TOKENCMD_IF THEN tmp2 = %SE_TOKENCMD_EXITIF
IF codetk(ses.pc + 1).cmd = %SE_TOKENCMD_SUB THEN tmp2 = %SE_TOKENCMD_EXITSUB
IF codetk(ses.pc + 1).cmd = %SE_TOKENCMD_FUNCTION THEN tmp2 = %SE_TOKENCMD_EXITFUN
IF codetk(ses.pc + 1).cmd = %SE_TOKENCMD_FOR THEN tmp2 = %SE_TOKENCMD_EXITFOR
IF codetk(ses.pc + 1).cmd = %SE_TOKENCMD_DO THEN tmp2 = %SE_TOKENCMD_EXITDO
IF codetk(ses.pc + 1).cmd = %SE_TOKENCMD_WHILE THEN tmp2 = %SE_TOKENCMD_EXITWHI
IF codetk(ses.pc + 1).cmd = %SE_TOKENCMD_WEND THEN tmp2 = %SE_TOKENCMD_EXITWHI
IF codetk(ses.pc + 1).cmd = %SE_TOKENCMD_LOOP THEN tmp2 = %SE_TOKENCMD_EXITDO
IF codetk(ses.pc + 1).cmd = %SE_TOKENCMD_SELECT THEN tmp2 = %SE_TOKENCMD_EXITSEL
CASE %SE_TOKENCMD_DO
IF codetk(ses.pc + 1).cmd = %SE_TOKENCMD_WHILE THEN tmp2 = %SE_TOKENCMD_DOW
IF codetk(ses.pc + 1).cmd = %SE_TOKENCMD_UNTIL THEN tmp2 = %SE_TOKENCMD_DOU
CASE %SE_TOKENCMD_LOOP
IF codetk(ses.pc + 1).cmd = %SE_TOKENCMD_WHILE THEN tmp2 = %SE_TOKENCMD_LOOPW
IF codetk(ses.pc + 1).cmd = %SE_TOKENCMD_UNTIL THEN tmp2 = %SE_TOKENCMD_LOOPU
CASE %SE_TOKENCMD_STRINGS
'dim global 'strings' type vars
dbcprint("strings")
tmp1 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_ALPHA)
IF tmp1 THEN
WHILE tmp1
IF checkvalidname(sesptr, (tokens(codetk(tmp1).token).token)) THEN
ARRAY SCAN strvarn(), = codetk(tmp1).token, TO var
ARRAY SCAN numvarn(), = codetk(tmp1).token, TO tmp3
IF (ISTRUE(var) OR ISTRUE(tmp3)) THEN
dbcprint("duplicated string var " + tokens(codetk(tmp1).token).token)
ses.errcode = %SE_ERROR_DUPLICATEDECL
EXIT, EXIT
ELSE
dbcprint("new string var " + tokens(codetk(tmp1).token).token)
REDIM PRESERVE strvar(UBOUND(strvar) + 1)
REDIM PRESERVE strvarn(UBOUND(strvarn) + 1)
ses.ubs = UBOUND(strvar)
strvar(ses.ubs) = ""
strvarn(ses.ubs) = codetk(tmp1).token
dbcprint("strings " + tokens(codetk(tmp1).token).token)
END IF
ELSE
'stmp1 = tokens(codetk(tmp1).token).token
'dbcprint("name:" + stmp1)
ses.errcode = %SE_ERROR_ILLEGALNAME
EXIT, EXIT
END IF
tmp1 = lookfor(sesptr, tmp1 + 1, %SE_LOOK4_ALPHA)
WEND
WHILE (codetk(ses.pc).tktype <> %SE_TOKEN_EOL)
codetk(ses.pc).tktype = %ASCII_SPACE
INCR ses.pc
WEND
ELSE
ses.errcode = %SE_ERROR_SYNTAXERROR
END IF
dbcprint("strings ok")
CASE %SE_TOKENCMD_NUMBERS
'dim global 'numbers' type vars
dbcprint("numbers")
tmp1 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_ALPHA)
IF tmp1 THEN
WHILE tmp1
IF checkvalidname(sesptr, (tokens(codetk(tmp1).token).token)) THEN
ARRAY SCAN numvarn(), = codetk(tmp1).token, TO var
ARRAY SCAN strvarn(), = codetk(tmp1).token, TO tmp3
IF (var OR tmp3) THEN
ses.errcode = %SE_ERROR_DUPLICATEDECL
EXIT, EXIT
ELSE
REDIM PRESERVE numvar(UBOUND(numvar) + 1)
REDIM PRESERVE numvarn(UBOUND(numvar) + 1)
ses.ubn = UBOUND(numvar)
numvar(ses.ubn) = 0
numvarn(ses.ubn) = codetk(tmp1).token
dbcprint("numbers " + tokens(codetk(tmp1).token).token)
END IF
ELSE
ses.errcode = %SE_ERROR_ILLEGALNAME
EXIT, EXIT
END IF
tmp1 = lookfor(sesptr, tmp1 + 1, %SE_LOOK4_ALPHA)
WEND
WHILE (codetk(ses.pc).tktype <> %SE_TOKEN_EOL)
codetk(ses.pc).tktype = %ASCII_SPACE
INCR ses.pc
WEND
dbcprint("numbers ok")
ELSE
ses.errcode = %SE_ERROR_SYNTAXERROR
END IF
END SELECT
IF ses.errcode THEN EXIT DO
IF tmp2 THEN
codetk(ses.pc).cmd = tmp2
codetk(ses.pc + 1).tktype = %ASCII_SPACE
codetk(ses.pc + 1).cmd = %SE_TOKEN_UNDEFINED
END IF
END IF
'preview results for debug
#IF %DEBUG_FLAG
stmp1 = ""
SELECT CASE codetk(ses.pc).tktype
'case %SE_TOKEN_UNDEFINED: stmp1 = stmp1 + "<%SE_TOKEN_UNDEFINED>"
CASE %SE_TOKEN_EOL
stmp1 = "<%SE_TOKEN_EOL >"
CASE %SE_TOKEN_DELIMITER
stmp1 = "<%SE_TOKEN_DELIM> = ?"
CASE %SE_TOKEN_NUMBER
stmp1 = "<%SE_TOKEN_NUMBE> = " + tokens(codetk(ses.pc).token).token
CASE %SE_TOKEN_ALPHA
IF codetk(ses.pc).cmd THEN
stmp1 = "<%SE_TOKEN_KEYWD> = " + FORMAT$((codetk(ses.pc).cmd AND &hff), "000") + " " + funtext(codetk(ses.pc).cmd)
ELSE
stmp1 = "<%SE_TOKEN_ALPHA> = " + tokens(codetk(ses.pc).token).token
END IF
CASE %SE_TOKEN_STRING
stmp1 = "<%SE_TOKEN_STRIN> = " + tokens(codetk(ses.pc).token).token
CASE %SE_TOKEN_CRLF
stmp1 = "<%SE_TOKEN_CRLF >"
CASE > %ASCII_ESCAPE
stmp1 = "<%SE_TOKEN_DELIM> = " + CHR$(codetk(ses.pc).tktype)
END SELECT
stmp1 = "nl: " + FORMAT$(codetk(ses.pc).lncnt, "000") + " tk: " + FORMAT$(ses.pc, "000") + " -> " + stmp1 ' + " " + FORMAT$(codetk(ses.pc).cmd, "000")
dbcprint (stmp1)
#ENDIF
INCR ses.pc
LOOP WHILE ses.pc <= ses.ctks
IF ses.errcode THEN
'exit if some error
dbcprint(se_errortext(sesptr))
tprint se_errortext(sesptr)
EXIT FUNCTION
END IF
'delete all generated spaces from codetokens
dbcprint("Analizing...pass 2")
tmp1 = 1
FOR pc = 1 TO ses.ctks
IF (codetk(pc).tktype = %ASCII_SPACE) THEN
ELSE
POKE$ VARPTR(codetk(tmp1)), PEEK$(VARPTR(codetk(pc)), SIZEOF(se_codetoken))
INCR tmp1
END IF
NEXT
ses.ctks = tmp1 - 1
'load ses, the main struct, with pointers to vars storage
ses.nvarsn = VARPTR(numvarn(0))
ses.nvars = VARPTR(numvar(0))
ses.svarsn = VARPTR(strvarn(0))
ses.svars = VARPTR(strvar(0))
dbcprint("Analizing...pass 3")
'all global vars declared, so set global vars references, saves many array scan
'all vars .arg1 = var index and .cmd = %SE_TOKENCMD_GNUMVAR or %SE_TOKENCMD_GSTRVAR
'also, check built in functions arguments, count them and set parenthesis positions arg1, arg2, arg3
FOR pc = 1 TO ses.ctks - 1
ses.pc = pc
IF (codetk(pc).tktype = %SE_TOKEN_ALPHA) THEN
IF (codetk(pc).cmd = 0) THEN '<- avoid assignments
dbcprint("checking alpha " + tokens(codetk(pc).token).token)
ARRAY SCAN numvarn(), = codetk(pc).token, TO var
IF var THEN
dbcprint("is %SE_TOKENCMD_GNUMVAR " + tokens(codetk(pc).token).token)
codetk(pc).cmd = %SE_TOKENCMD_GNUMVAR
codetk(pc).arg1 = var - 1
ELSE
ARRAY SCAN strvarn(), = codetk(pc).token, TO var
IF var THEN
dbcprint("is %SE_TOKENCMD_GSTRVAR " + tokens(codetk(pc).token).token)
codetk(pc).cmd = %SE_TOKENCMD_GSTRVAR
codetk(pc).arg1 = var - 1
ELSE
dbcprint("not found... " + tokens(codetk(pc).token).token)
'?
END IF
END IF
ELSE
'just set arguments bounds and count, we will check each arg later and will need these bounds
SELECT CASE AS LONG codetk(pc).cmd
CASE %SE_TOKENCMD_BIN, %SE_TOKENCMD_OCT, %SE_TOKENCMD_HEX, %SE_TOKENCMD_CHR, _
%SE_TOKENCMD_SPACE, %SE_TOKENCMD_STR, %SE_TOKENCMD_NUL, _
%SE_TOKENCMD_LCASE, %SE_TOKENCMD_MCASE, %SE_TOKENCMD_HCASE, %SE_TOKENCMD_UCODE, %SE_TOKENCMD_UCASE, _
%SE_TOKENCMD_ACODE, %SE_TOKENCMD_TRIM, %SE_TOKENCMD_MID, %SE_TOKENCMD_RND, _
%SE_TOKENCMD_INT, %SE_TOKENCMD_ROUND, %SE_TOKENCMD_FIX, %SE_TOKENCMD_FRAC, %SE_TOKENCMD_ABS, _
%SE_TOKENCMD_CEIL, %SE_TOKENCMD_CINT, %SE_TOKENCMD_EVEN, %SE_TOKENCMD_ATN, %SE_TOKENCMD_TAN, _
%SE_TOKENCMD_COS, %SE_TOKENCMD_SGN, %SE_TOKENCMD_SQR, %SE_TOKENCMD_EXP2, %SE_TOKENCMD_EXP10, _
%SE_TOKENCMD_LOG, %SE_TOKENCMD_LOG2, %SE_TOKENCMD_LOG10, %SE_TOKENCMD_EXP, _
%SE_TOKENCMD_MIN, %SE_TOKENCMD_MAX, %SE_TOKENCMD_ISTRUE, %SE_TOKENCMD_ISFALSE, %SE_TOKENCMD_NOT, _
%SE_TOKENCMD_LEFT, %SE_TOKENCMD_RIGHT, %SE_TOKENCMD_STRING, %SE_TOKENCMD_INSTR, %SE_TOKENCMD_MSGBOX, _
%SE_TOKENCMD_LEN, %SE_TOKENCMD_VAL, %SE_TOKENCMD_ASC, %SE_TOKENCMD_STDOUT
'arg1 = (
'arg2 = )
'arg3 = number of parameters
'cmd = function index and definition
IF funargs(codetk(pc).cmd) THEN 'function has arguments?
IF parargs(codetk(pc).cmd) THEN 'are they parenthised?
codetk(pc).arg1 = lookfor(sesptr, pc, %SE_LOOK4_PAROPEN)
IF codetk(pc).arg1 THEN 'look for bounds
codetk(pc).arg2 = lookfor(sesptr, codetk(pc).arg1, %SE_LOOK4_MATCHPAR)
IF codetk(pc).arg2 THEN
codetk(pc).arg3 = countargs(sesptr, codetk(pc).arg1, codetk(pc).arg2)
IF (codetk(pc).arg3 <> funargs(codetk(pc).cmd)) THEN
dbcprint (" parameter mismatch: 12 " + FORMAT$(codetk(pc).arg3) + " " + FORMAT$(funargs(codetk(pc).cmd)) + " " + FORMAT$(pc) + " " + funtext(codetk(pc).cmd))
ses.errcode = %SE_ERROR_PARMISMATCH
EXIT FOR
END IF
ELSE
dbcprint (" here ): " + funtext(codetk(pc).cmd) + " ln:" + FORMAT$(codetk(pc).lncnt))
ses.errcode = %SE_ERROR_PARCLOSEEXPECTED
EXIT FOR
END IF
ELSE
dbcprint (" here (: " + funtext(codetk(pc).cmd) + " ln:" + FORMAT$(codetk(pc).lncnt))
ses.errcode = %SE_ERROR_PAROPENEEXPECTED
EXIT FOR
END IF
END IF
END IF
CASE %SE_TOKENCMD_PRINT
codetk(pc).arg1 = pc + 1
codetk(pc).arg2 = lookfor(sesptr, codetk(pc).arg1, %SE_LOOK4_EOL)
END SELECT
END IF
END IF
NEXT
IF ses.errcode THEN
'exit if some error
dbcprint(se_errortext(sesptr))
tprint se_errortext(sesptr)
EXIT FUNCTION
END IF
dbcprint(" num vars: " + FORMAT$(ses.ubn))
dbcprint(" str vars: " + FORMAT$(ses.ubs))
dbcprint("Analizing...pass 4")
'finally, precalculate all jumps and loops, check functions arguments types, etc
ses.pc = 1
DO
IF codetk(ses.pc).tktype = %SE_TOKEN_EOL THEN
INCR ses.pc
ITERATE DO
END IF
IF codetk(ses.pc).tktype = %SE_TOKEN_ALPHA THEN
'if (last <> codetk(ses.pc).lncnt) then secnt codetk(ses.pc).secnt
dbcprint("analizing line " + FORMAT$(codetk(ses.pc).lncnt) + " of " + FORMAT$(lcnt) + " ctk: " + FORMAT$(ses.pc) + " of " + FORMAT$(ses.ctks))
SELECT CASE AS LONG codetk(ses.pc).cmd
CASE %SE_TOKENCMD_JUMPTO
'ses.pc = ses.@ct[ses.pc].arg1
CASE %SE_TOKENCMD_IF, %SE_TOKENCMD_ELSEIF
'if/elseif
'arg1 = true branch, if/elseif eol
'arg2 = false branch, next elseif/else or 0
'arg3 = endif
'arg4 = end condition (then - 1)
tmp2 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_ENDIF)
dbcprint (" endif " + FORMAT$(tmp2))
IF tmp2 THEN 'endif?
codetk(tmp2).arg1 = ses.pc 'mark owner
tmp1 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_ELSEIF)
dbcprint (" elseif " + FORMAT$(tmp1))
IF ISFALSE(tmp1) THEN 'elseif?
tmp1 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_ELSE) 'else?
IF tmp1 THEN codetk(tmp1).arg1 = ses.pc 'mark owner
END IF
dbcprint (" else " + FORMAT$(tmp1))
codetk(ses.pc).arg1 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_EOL)
IF tmp1 THEN codetk(tmp1 - 1).arg1 = tmp2 'set jumpto endif
DECR tmp1
codetk(ses.pc).arg2 = IIF&(tmp1, tmp1, 0) 'tmp2)
tmp1 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_THEN)
dbcprint (" then " + FORMAT$(tmp1))
IF tmp1 THEN 'then?
codetk(ses.pc).arg3 = tmp2 'endif address
codetk(ses.pc).arg4 = tmp1 - 1 'end condition
'ses.pc = tmp1 + 1 'jump after 'then'
ELSE
'err then expected
ses.errcode = %SE_ERROR_EXITDOWDO
dbcprint (" no then")
END IF
IF ISTRUE(checkarg(sesptr, ses.pc, 1) AND %SE_FDEF_RETSTR) THEN
codetk(ses.pc).cmd = IIF&((codetk(ses.pc).cmd = %SE_TOKENCMD_IF), %SE_TOKENCMD_IFS, %SE_TOKENCMD_ELSEIFS)
END IF
ELSE
'err end if expected
ses.errcode = %SE_ERROR_ENDIFEXPECTED
dbcprint (" no endif")
END IF
CASE %SE_TOKENCMD_ELSE, %SE_TOKENCMD_ENDIF 'just check these
IF ISFALSE(codetk(ses.pc).arg1) THEN
ses.errcode = %SE_ERROR_IFEXPECTED
END IF
CASE %SE_TOKENCMD_EXITDO
tmp1 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_LOOP)
IF ISFALSE(tmp1) THEN
ses.errcode = %SE_ERROR_EXITDOWDO
END IF
codetk(ses.pc).arg1 = tmp1 + 1
CASE %SE_TOKENCMD_EXITWHI
tmp1 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_WEND)
IF ISFALSE(tmp1) THEN
ses.errcode = %SE_ERROR_EXITWHILEWWHILE
END IF
codetk(ses.pc).arg1 = tmp1 + 1
CASE %SE_TOKENCMD_EXITIF
tmp1 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_ENDIF)
IF ISFALSE(tmp1) THEN
ses.errcode = %SE_ERROR_EXITIFWIF
END IF
codetk(ses.pc).arg1 = tmp1
CASE %SE_TOKENCMD_EXITFOR
tmp1 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_NEXT)
IF ISFALSE(tmp1) THEN
ses.errcode = %SE_ERROR_EXITFORWFOR
END IF
codetk(ses.pc).arg1 = tmp1 + 1
CASE %SE_TOKENCMD_EXITSEL
tmp1 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_ENDSEL)
IF ISFALSE(tmp1) THEN
ses.errcode = %SE_ERROR_EXITSELWSEL
END IF
codetk(ses.pc).arg1 = tmp1 + 1
CASE %SE_TOKENCMD_DO, %SE_TOKENCMD_DOW, %SE_TOKENCMD_DOU
'do/dow/dou
'loop/loopw/loopu
'arg1 = after do (true branch)
'arg2 = after loop (false branch)
'arg3 = start condition (after while/until if any)
'arg4 = end condition
tmp2 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_LOOP)
IF tmp2 THEN
dbcprint (" loop " + FORMAT$(tmp2))
IF ((codetk(ses.pc).cmd <> %SE_TOKENCMD_DO) AND (codetk(tmp2).cmd <> %SE_TOKENCMD_LOOP)) THEN
ses.errcode = %SE_ERROR_SYNTAXERROR
ELSE
tmp3 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_EOL)
tmp4 = lookfor(sesptr, tmp2 + 1, %SE_LOOK4_EOL)
codetk(ses.pc).arg1 = tmp3 'after do
codetk(ses.pc).arg2 = tmp4 'after loop
codetk(tmp2).arg1 = ses.pc - 1'codetk(ses.pc).arg1
codetk(tmp2).arg2 = codetk(ses.pc).arg2
IF (codetk(ses.pc).cmd <> %SE_TOKENCMD_DO) THEN 'dow/dou?
dbcprint (" do while/until " + FORMAT$(ses.pc))
codetk(ses.pc).arg3 = ses.pc + 1 'start codition
codetk(ses.pc).arg4 = tmp3 - 1 'end codition
ELSEIF (codetk(tmp2).cmd <> %SE_TOKENCMD_LOOP) THEN 'loopw/loopu?
dbcprint (" loop while/until " + FORMAT$(tmp2))
codetk(tmp2).arg3 = tmp2 + 1 'start codition
codetk(tmp2).arg4 = tmp4 - 1 'end codition
END IF
END IF
ELSE
dbcprint ("err do wo/loop " + FORMAT$(ses.pc))
ses.errcode = %SE_ERROR_LOOPEXPECTED
END IF
CASE %SE_TOKENCMD_LOOP, %SE_TOKENCMD_LOOPW, %SE_TOKENCMD_LOOPU, %SE_TOKENCMD_WEND
IF ISFALSE(codetk(ses.pc).arg2) THEN
ses.errcode = %SE_ERROR_DOEXPECTED
END IF
CASE %SE_TOKENCMD_WHILE
'arg1 = after while eol (true branch)
'arg2 = after wend eol (false branch)
'arg3 = start condition (after while)
'arg4 = end condition (before eol)
tmp2 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_WEND)
tmp3 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_EOL)
IF tmp2 THEN
dbcprint (" wend " + FORMAT$(tmp2))
codetk(ses.pc).arg1 = tmp3 + 1 'after while
codetk(ses.pc).arg2 = lookfor(sesptr, tmp2 + 1, %SE_LOOK4_EOL) + 1 'after wend
codetk(tmp2).arg1 = ses.pc - 1 'before wend
codetk(tmp2).arg2 = codetk(ses.pc).arg2 '
codetk(ses.pc).arg3 = ses.pc + 1 'start codition
codetk(ses.pc).arg4 = tmp3 - 1 'end codition
ELSE
ses.errcode = %SE_ERROR_WENDEXPECTED
END IF
CASE %SE_TOKENCMD_FOR
'for
' arg1 = equal + 1 start = arg1 : arg2 - 1
' arg2 = to addr max = arg2 + 1 : step/eol
' arg3 = step/eol step = arg3 + 1 : eol
' arg4 = var idx
'to
' arg1 = step addr if any
' arg2 = false branch
' arg3 = next addr
' arg4 = eol (true branch)
'step
' arg1 = eol
'next
' arg1 = for addr
' arg2 = to addr
' arg3 = true branch
' arg4 = false branch
tmp1 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_ALPHA)
dbcprint (" for var " + FORMAT$(tmp1))
'IF tmp1 AND ISTRUE(codetk(tmp1).cmd = %SE_TOKENCMD_GNUMVAR) THEN 'num var?
'IF tmp1 THEN
IF isnumvar(codetk(tmp1).cmd) THEN 'num var?
tmp2 = lookfor(sesptr, tmp1, %SE_LOOK4_EQUAL)
dbcprint (" for = " + FORMAT$(tmp2))
IF tmp2 THEN
tmp3 = lookfor(sesptr, tmp2, %SE_LOOK4_TO)
dbcprint (" for to " + FORMAT$(tmp3))
IF tmp3 THEN
tmp4 = lookfor(sesptr, tmp3, %SE_LOOK4_STEP)
dbcprint (" for step " + FORMAT$(tmp4))
IF tmp4 THEN
codetk(tmp3).arg1 = tmp4
codetk(tmp4).arg1 = tmp1 = lookfor(sesptr, tmp3, %SE_LOOK4_EOL)
ELSE
tmp4 = lookfor(sesptr, tmp3 + 1, %SE_LOOK4_EOL)
END IF
'for setup
codetk(ses.pc).arg1 = tmp2 + 1
codetk(ses.pc).arg2 = tmp3
codetk(ses.pc).arg3 = tmp4
'to setup
codetk(ses.pc).arg4 = codetk(tmp1).arg1
codetk(tmp3).arg2 = lookfor(sesptr, tmp3, %SE_LOOK4_NEXT)
codetk(tmp3).arg3 = codetk(tmp3).arg2
codetk(tmp3).arg4 = lookfor(sesptr, tmp3, %SE_LOOK4_EOL)
dbcprint (" for next " + FORMAT$(codetk(tmp3).arg2))
'next setup
codetk(codetk(tmp3).arg2).arg1 = ses.pc
codetk(codetk(tmp3).arg2).arg2 = tmp3
codetk(codetk(tmp3).arg2).arg3 = codetk(tmp3).arg4
codetk(codetk(tmp3).arg2).arg4 = codetk(tmp3).arg2
ELSE
ses.errcode = %SE_ERROR_TOEXPECTED
END IF
ELSE
ses.errcode = %SE_ERROR_SYNTAXERROR
END IF
ELSE
dbcprint("cmd: " + BIN$(codetk(tmp1).cmd))
ses.errcode = %SE_ERROR_NUMVAREXPECTED
END IF
'END IF
CASE %SE_TOKENCMD_NEXT
IF ISFALSE(codetk(ses.pc).arg2) THEN
ses.errcode = %SE_ERROR_FOREXPECTED
END IF
CASE %SE_TOKENCMD_LET, %SE_TOKENCMD_GNUMVAR, %SE_TOKENCMD_GSTRVAR
'arg1 = var index
'arg2 = after '='
'arg3 = eol - 1
dbcprint("let")
IF (codetk(ses.pc).cmd = %SE_TOKENCMD_LET) THEN INCR ses.pc
IF (codetk(ses.pc).secnt = 1) THEN
IF (codetk(ses.pc + 1).tktype = %ASCII_EQUAL) THEN
SELECT CASE codetk(ses.pc).cmd
CASE %SE_TOKENCMD_GNUMVAR
codetk(ses.pc).cmd = %SE_TOKENCMD_GLETNUM
CASE %SE_TOKENCMD_GSTRVAR
codetk(ses.pc).cmd = %SE_TOKENCMD_GLETSTR
CASE ELSE
ses.errcode = %SE_ERROR_SYNTAXERROR
END SELECT
tmp3 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_EOL)
IF ISTRUE(tmp3) THEN
codetk(ses.pc).arg2 = ses.pc + 2 'after =
codetk(ses.pc).arg3 = tmp3 - 1 'eol - 1
'ses.pc = tmp3
dbcprint (" var: " + FORMAT$(codetk(ses.pc).arg1))
dbcprint (" =: " + FORMAT$(ses.pc + 1))
dbcprint (" EOL: " + FORMAT$(tmp3))
dbcprint("let ok")
ELSE
'?...
ses.errcode = %SE_ERROR_SYNTAXERROR
dbcprint(se_errortext(sesptr))
END IF
ELSE
ses.errcode = %SE_ERROR_SYNTAXERROR
END IF
END IF
CASE %SE_TOKENCMD_INCR, %SE_TOKENCMD_DECR
'tmp1 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_ALPHA)
dbcprint("incr/decr ")
tmp1 = ses.pc + 1
SELECT CASE codetk(tmp1).cmd
CASE %SE_TOKENCMD_GNUMVAR
codetk(ses.pc).arg1 = codetk(tmp1).arg1
CASE ELSE
dbcprint("incr/decr error")
ses.errcode = %SE_ERROR_VAREXPECTED
END SELECT
CASE %SE_TOKENCMD_GOTO
tmp1 = lookfor(sesptr, ses.pc + 1, %SE_LOOK4_ALPHA)
IF tmp1 THEN
IF tokens(codetk(tmp1).token).addrs THEN
codetk(ses.pc).arg1 = tokens(codetk(tmp1).token).addrs
ELSE
'undefined equate
dbcprint("goto 1 " + tokens(codetk(tmp1).token).token)
ses.errcode = %SE_ERROR_UNDEFEQUATE
END IF
ELSE
'syntax error
dbcprint("goto 2 " + tokens(codetk(tmp1).token).token)
ses.errcode = %SE_ERROR_SYNTAXERROR
END IF
CASE %SE_TOKENCMD_RESET
'codetk(ses.pc).cmd = %SE_TOKENCMD_RSTNUM '/ STR
CASE %SE_TOKENCMD_ERASE
'codetk(ses.pc).cmd = %SE_TOKENCMD_ERNUM '/ STR
CASE %SE_TOKENCMD_STDERR
CASE %SE_TOKENCMD_STDIN
CASE %SE_TOKENCMD_ENDSCR, %SE_TOKENCMD_END
EXIT DO
CASE %SE_TOKENCMD_PRGLINES, %SE_TOKENCMD_PI, %SE_TOKENCMD_BEEP
'0 arg, returns number, static
CASE %SE_TOKENCMD_TIMER
'0 arg, returns number, dynamic
CASE %SE_TOKENCMD_DATE, %SE_TOKENCMD_TIME
'0 arg, returns string, dynamic
CASE %SE_TOKENCMD_LEN, %SE_TOKENCMD_VAL, %SE_TOKENCMD_ASC, %SE_TOKENCMD_LEFT, %SE_TOKENCMD_RIGHT, _
%SE_TOKENCMD_SPACE, %SE_TOKENCMD_STR, _
%SE_TOKENCMD_LCASE, %SE_TOKENCMD_MCASE, %SE_TOKENCMD_HCASE, %SE_TOKENCMD_UCODE, %SE_TOKENCMD_UCASE, _
%SE_TOKENCMD_BIN, %SE_TOKENCMD_OCT, %SE_TOKENCMD_HEX, %SE_TOKENCMD_CHR, _
%SE_TOKENCMD_ACODE, %SE_TOKENCMD_TRIM, %SE_TOKENCMD_INSTR, %SE_TOKENCMD_NUL, _
%SE_TOKENCMD_INT, %SE_TOKENCMD_ROUND, %SE_TOKENCMD_FIX, %SE_TOKENCMD_FRAC, %SE_TOKENCMD_ABS, _
%SE_TOKENCMD_CEIL, %SE_TOKENCMD_CINT, %SE_TOKENCMD_EVEN, %SE_TOKENCMD_ATN, %SE_TOKENCMD_TAN, _
%SE_TOKENCMD_COS, %SE_TOKENCMD_SGN, %SE_TOKENCMD_SQR, %SE_TOKENCMD_EXP2, %SE_TOKENCMD_EXP10, _
%SE_TOKENCMD_LOG, %SE_TOKENCMD_LOG2, %SE_TOKENCMD_LOG10, %SE_TOKENCMD_EXP, %SE_TOKENCMD_MID, _
%SE_TOKENCMD_MIN, %SE_TOKENCMD_MAX, %SE_TOKENCMD_ISTRUE, %SE_TOKENCMD_ISFALSE, %SE_TOKENCMD_NOT, _
%SE_TOKENCMD_STRING, %SE_TOKENCMD_MSGBOX, _
%SE_TOKENCMD_STDOUT, %SE_TOKENCMD_RND
'arg1 = (
'arg2 = )
'arg3 = arguments count
'cmd = function index and definition
IF funargs(codetk(ses.pc).cmd) THEN 'function has arguments?
IF parargs(codetk(ses.pc).cmd) THEN 'are they parenthised?
FOR tmp1 = 1 TO codetk(ses.pc).arg3 'check all them
tmp2 = checkarg(sesptr, codetk(ses.pc).arg1, tmp1)
IF ISFALSE(tmp2 AND codetk(ses.pc).cmd) THEN
dbcprint (" parameter mismatch type : " + HEX$(codetk(ses.pc).cmd) + " " + HEX$(tmp2)))
dbcprint (" parameter mismatch count: " + FORMAT$(codetk(ses.pc).arg3) + " " + FORMAT$(funargs(codetk(ses.pc).cmd)) + " " + FORMAT$(ses.pc))
ses.errcode = %SE_ERROR_PARMISMATCH
END IF
NEXT
END IF
END IF
CASE %SE_TOKENCMD_PRINT
CASE ELSE
END SELECT
END IF
IF ses.errcode THEN EXIT DO
INCR ses.pc
IF (ses.pc => ses.ctks) THEN EXIT DO
LOOP
dbcprint("Printing...")
ifdbgx(prtcode(sesptr, 1, ses.ctks))
ifdbgx(FOR tmp1 = 1 TO ses.ubs: dbcprint("strings " + tokens(strvarn(tmp1)).token + " = " + strvar(tmp1)): NEXT)
IF ses.errcode THEN
'report error if any
dbcprint (se_errortext(sesptr))
tprint se_errortext(sesptr)
EXIT FUNCTION
END IF
ses.errcode = %SE_ERROR_EXECUTING
ifdbgx(stdout(se_errortext(sesptr)))
'tprint se_errortext(sesptr)
ses.errcode = %SE_ERROR_NOERROR
'all done, exec the code!
ses.pc = 1
execfun sesptr
'script exited, finished or had an error
ifdbgx(stdout (se_errortext(sesptr)))
'tprint se_errortext(sesptr)
ses.errcode = %SE_ERROR_EXITING
ifdbgx(stdout (se_errortext(sesptr)))
'tprint se_errortext(sesptr)
ifdbgx(TRACE CLOSE)
FUNCTION = ses.errcode
END FUNCTION
'prints all formated codetokens to a textbox, for debug
FUNCTION prtcode(BYVAL ses AS ses_type PTR, BYVAL start AS LONG, BYVAL ends AS LONG) AS DWORD
LOCAL stmp1 AS STRING, tmp1 AS LONG
stdout "########################################################"
FOR tmp1 = start TO ends
stmp1 = "CT:" + FORMAT$(tmp1, "000") + " LN:" + FORMAT$(@ses.@ct[tmp1].lncnt, "000") + " SN:" + FORMAT$(@ses.@ct[tmp1].secnt, "000")
SELECT CASE @ses.@ct[tmp1].tktype
CASE %SE_TOKEN_ALPHA : stmp1 = stmp1 + " A " + FORMAT$((@ses.@ct[tmp1].cmd AND &hff), "000") + " "
stmp1 = stmp1 + "a1:" + FORMAT$(@ses.@ct[tmp1].arg1, "000") + " "
stmp1 = stmp1 + "a2:" + FORMAT$(@ses.@ct[tmp1].arg2, "000") + " "
stmp1 = stmp1 + "a3:" + FORMAT$(@ses.@ct[tmp1].arg3, "000") + " "
stmp1 = stmp1 + "a4:" + FORMAT$(@ses.@ct[tmp1].arg4, "000") + " "
stmp1 = stmp1 + funtext(@ses.@ct[tmp1].cmd)
CASE %SE_TOKEN_NUMBER : stmp1 = stmp1 + " N "
CASE %SE_TOKEN_EOL : stmp1 = stmp1 + "EOL"
CASE %SE_TOKEN_STRING : stmp1 = stmp1 + " S "
CASE %SE_TOKEN_DELIMITER: stmp1 = stmp1 + " D "
CASE > %ASCII_ESCAPE : stmp1 = stmp1 + " " + CHR$(@ses.@ct[tmp1].tktype)+ " "
END SELECT
IF (@ses.@ct[tmp1].cmd = %SE_TOKENCMD_PRENUM) THEN
stmp1 = stmp1 + " " + FORMAT$(@ses.@ct[tmp1].pre)
END IF
dbcprint(stmp1)
NEXT
END FUNCTION
'takes function cmd and return function text name, for debug
FUNCTION funtext(code AS LONG) AS STRING
SELECT CASE AS LONG code
CASE %SE_TOKENCMD_ABS
FUNCTION = "%SE_TOKENCMD_ABS "
CASE %SE_TOKENCMD_AND
FUNCTION = "%SE_TOKENCMD_AND "
CASE %SE_TOKENCMD_ACODE
FUNCTION = "%SE_TOKENCMD_ACODE "
CASE %SE_TOKENCMD_ASC
FUNCTION = "%SE_TOKENCMD_ASC "
CASE %SE_TOKENCMD_ATN
FUNCTION = "%SE_TOKENCMD_ATN "
CASE %SE_TOKENCMD_BEEP
FUNCTION = "%SE_TOKENCMD_BEEP "
CASE %SE_TOKENCMD_BIN
FUNCTION = "%SE_TOKENCMD_BIN "
CASE %SE_TOKENCMD_CASE
FUNCTION = "%SE_TOKENCMD_CASE "
CASE %SE_TOKENCMD_CEIL
FUNCTION = "%SE_TOKENCMD_CEIL "
CASE %SE_TOKENCMD_CHR
FUNCTION = "%SE_TOKENCMD_CHR "
CASE %SE_TOKENCMD_CINT
FUNCTION = "%SE_TOKENCMD_CINT "
CASE %SE_TOKENCMD_COS
FUNCTION = "%SE_TOKENCMD_COS "
CASE %SE_TOKENCMD_DATE
FUNCTION = "%SE_TOKENCMD_DATE "
CASE %SE_TOKENCMD_DECR
FUNCTION = "%SE_TOKENCMD_DECR "
CASE %SE_TOKENCMD_DO
FUNCTION = "%SE_TOKENCMD_DO "
CASE %SE_TOKENCMD_END
FUNCTION = "%SE_TOKENCMD_END "
CASE %SE_TOKENCMD_ELSE
FUNCTION = "%SE_TOKENCMD_ELSE "
CASE %SE_TOKENCMD_ELSEIF
FUNCTION = "%SE_TOKENCMD_ELSEIF "
CASE %SE_TOKENCMD_EQV
FUNCTION = "%SE_TOKENCMD_EQV "
CASE %SE_TOKENCMD_ERASE
FUNCTION = "%SE_TOKENCMD_ERASE "
CASE %SE_TOKENCMD_EVEN
FUNCTION = "%SE_TOKENCMD_EVEN "
CASE %SE_TOKENCMD_EXP
FUNCTION = "%SE_TOKENCMD_EXP "
CASE %SE_TOKENCMD_EXP2
FUNCTION = "%SE_TOKENCMD_EXP2 "
CASE %SE_TOKENCMD_EXP10
FUNCTION = "%SE_TOKENCMD_EXP10 "
CASE %SE_TOKENCMD_EXIT
FUNCTION = "%SE_TOKENCMD_EXIT "
CASE %SE_TOKENCMD_FIX
FUNCTION = "%SE_TOKENCMD_FIX "
CASE %SE_TOKENCMD_FOR
FUNCTION = "%SE_TOKENCMD_FOR "
CASE %SE_TOKENCMD_FUNCTION
FUNCTION = "%SE_TOKENCMD_FUNCTION "
CASE %SE_TOKENCMD_FRAC
FUNCTION = "%SE_TOKENCMD_FRAC "
CASE %SE_TOKENCMD_GOTO
FUNCTION = "%SE_TOKENCMD_GOTO "
CASE %SE_TOKENCMD_GOSUB
FUNCTION = "%SE_TOKENCMD_GOSUB "
CASE %SE_TOKENCMD_HCASE
FUNCTION = "%SE_TOKENCMD_HCASE "
CASE %SE_TOKENCMD_HEX
FUNCTION = "%SE_TOKENCMD_HEX "
CASE %SE_TOKENCMD_IF
FUNCTION = "%SE_TOKENCMD_IF "
CASE %SE_TOKENCMD_IMP
FUNCTION = "%SE_TOKENCMD_IMP "
CASE %SE_TOKENCMD_INCR
FUNCTION = "%SE_TOKENCMD_INCR "
CASE %SE_TOKENCMD_INSTR
FUNCTION = "%SE_TOKENCMD_INSTR "
CASE %SE_TOKENCMD_INT
FUNCTION = "%SE_TOKENCMD_INT "
CASE %SE_TOKENCMD_ISTRUE
FUNCTION = "%SE_TOKENCMD_ISTRUE "
CASE %SE_TOKENCMD_ISFALSE
FUNCTION = "%SE_TOKENCMD_ISFALSE "
CASE %SE_TOKENCMD_MAX
FUNCTION = "%SE_TOKENCMD_MAX "
CASE %SE_TOKENCMD_MSGBOX
FUNCTION = "%SE_TOKENCMD_MSGBOX "
CASE %SE_TOKENCMD_MCASE
FUNCTION = "%SE_TOKENCMD_MCASE "
CASE %SE_TOKENCMD_MID
FUNCTION = "%SE_TOKENCMD_MID "
CASE %SE_TOKENCMD_MIN
FUNCTION = "%SE_TOKENCMD_MIN "
CASE %SE_TOKENCMD_MOD
FUNCTION = "%SE_TOKENCMD_MOD "
CASE %SE_TOKENCMD_NEXT
FUNCTION = "%SE_TOKENCMD_NEXT "
CASE %SE_TOKENCMD_NOT
FUNCTION = "%SE_TOKENCMD_NOT "
CASE %SE_TOKENCMD_NUMBERS
FUNCTION = "%SE_TOKENCMD_NUMBERS "
CASE %SE_TOKENCMD_LCASE
FUNCTION = "%SE_TOKENCMD_LCASE "
CASE %SE_TOKENCMD_LEFT
FUNCTION = "%SE_TOKENCMD_LEFT "
CASE %SE_TOKENCMD_LEN
FUNCTION = "%SE_TOKENCMD_LEN "
CASE %SE_TOKENCMD_LOG
FUNCTION = "%SE_TOKENCMD_LOG "
CASE %SE_TOKENCMD_LOG2
FUNCTION = "%SE_TOKENCMD_LOG2 "
CASE %SE_TOKENCMD_LOG10
FUNCTION = "%SE_TOKENCMD_LOG10 "
CASE %SE_TOKENCMD_LOOP
FUNCTION = "%SE_TOKENCMD_LOOP "
CASE %SE_TOKENCMD_LET
FUNCTION = "%SE_TOKENCMD_LET "
CASE %SE_TOKENCMD_OCT
FUNCTION = "%SE_TOKENCMD_OCT "
CASE %SE_TOKENCMD_OR
FUNCTION = "%SE_TOKENCMD_OR "
CASE %SE_TOKENCMD_PRGLINES
FUNCTION = "%SE_TOKENCMD_PRGLINES "
CASE %SE_TOKENCMD_PI
FUNCTION = "%SE_TOKENCMD_PI "
CASE %SE_TOKENCMD_RANDOM
FUNCTION = "%SE_TOKENCMD_RANDOM "
CASE %SE_TOKENCMD_RESET
FUNCTION = "%SE_TOKENCMD_RESET "
CASE %SE_TOKENCMD_RETURN
FUNCTION = "%SE_TOKENCMD_RETURN "
CASE %SE_TOKENCMD_RIGHT
FUNCTION = "%SE_TOKENCMD_RIGHT "
CASE %SE_TOKENCMD_RND
FUNCTION = "%SE_TOKENCMD_RND "
CASE %SE_TOKENCMD_ROUND
FUNCTION = "%SE_TOKENCMD_ROUND "
CASE %SE_TOKENCMD_SGN
FUNCTION = "%SE_TOKENCMD_SGN "
CASE %SE_TOKENCMD_SPACE
FUNCTION = "%SE_TOKENCMD_SPACE "
CASE %SE_TOKENCMD_SQR
FUNCTION = "%SE_TOKENCMD_SQR "
CASE %SE_TOKENCMD_STDERR
FUNCTION = "%SE_TOKENCMD_STDERR "
CASE %SE_TOKENCMD_STDIN
FUNCTION = "%SE_TOKENCMD_STDIN "
CASE %SE_TOKENCMD_STDOUT
FUNCTION = "%SE_TOKENCMD_STDOUT "
CASE %SE_TOKENCMD_STR
FUNCTION = "%SE_TOKENCMD_STR "
CASE %SE_TOKENCMD_STRING
FUNCTION = "%SE_TOKENCMD_STRING "
CASE %SE_TOKENCMD_SUB
FUNCTION = "%SE_TOKENCMD_SUB "
CASE %SE_TOKENCMD_SELECT
FUNCTION = "%SE_TOKENCMD_SELECT "
CASE %SE_TOKENCMD_STRINGS
FUNCTION = "%SE_TOKENCMD_STRINGS "
CASE %SE_TOKENCMD_TAN
FUNCTION = "%SE_TOKENCMD_TAN "
CASE %SE_TOKENCMD_TIME
FUNCTION = "%SE_TOKENCMD_TIME "
CASE %SE_TOKENCMD_THEN
FUNCTION = "%SE_TOKENCMD_THEN "
CASE %SE_TOKENCMD_TIMER
FUNCTION = "%SE_TOKENCMD_TIMER "
CASE %SE_TOKENCMD_TO
FUNCTION = "%SE_TOKENCMD_TO "
CASE %SE_TOKENCMD_TRIM
FUNCTION = "%SE_TOKENCMD_TRIM "
CASE %SE_TOKENCMD_UCASE
FUNCTION = "%SE_TOKENCMD_UCASE "
CASE %SE_TOKENCMD_UCODE
FUNCTION = "%SE_TOKENCMD_UCODE "
CASE %SE_TOKENCMD_UNTIL
FUNCTION = "%SE_TOKENCMD_UNTIL "
CASE %SE_TOKENCMD_VAL
FUNCTION = "%SE_TOKENCMD_VAL "
CASE %SE_TOKENCMD_WEND
FUNCTION = "%SE_TOKENCMD_WEND "
CASE %SE_TOKENCMD_WHILE
FUNCTION = "%SE_TOKENCMD_WHILE "
CASE %SE_TOKENCMD_XOR
FUNCTION = "%SE_TOKENCMD_XOR "
CASE %SE_TOKENCMD_FUNSTR
FUNCTION = "%SE_TOKENCMD_FUNSTR "
CASE %SE_TOKENCMD_ENDIF
FUNCTION = "%SE_TOKENCMD_ENDIF "
CASE %SE_TOKENCMD_DOW
FUNCTION = "%SE_TOKENCMD_DOW "
CASE %SE_TOKENCMD_DOU
FUNCTION = "%SE_TOKENCMD_DOU "
CASE %SE_TOKENCMD_ENDFUN
FUNCTION = "%SE_TOKENCMD_ENDFUN "
CASE %SE_TOKENCMD_EXITIF
FUNCTION = "%SE_TOKENCMD_EXITIF "
CASE %SE_TOKENCMD_EXITDO
FUNCTION = "%SE_TOKENCMD_EXITDO "
CASE %SE_TOKENCMD_EXITWHI
FUNCTION = "%SE_TOKENCMD_EXITWHI "
CASE %SE_TOKENCMD_EXITFOR
FUNCTION = "%SE_TOKENCMD_EXITFOR "
CASE %SE_TOKENCMD_EXITFUN
FUNCTION = "%SE_TOKENCMD_EXITFUN "
CASE %SE_TOKENCMD_EXITSUB
FUNCTION = "%SE_TOKENCMD_EXITSUB "
CASE %SE_TOKENCMD_EXITSEL
FUNCTION = "%SE_TOKENCMD_EXITSEL "
CASE %SE_TOKENCMD_FAC
FUNCTION = "%SE_TOKENCMD_FAC "
CASE %SE_TOKENCMD_LOOPW
FUNCTION = "%SE_TOKENCMD_LOOPW "
CASE %SE_TOKENCMD_LOOPU
FUNCTION = "%SE_TOKENCMD_LOOPU "
CASE %SE_TOKENCMD_GLETNUM
FUNCTION = "%SE_TOKENCMD_GLETNUM "
CASE %SE_TOKENCMD_GLETSTR
FUNCTION = "%SE_TOKENCMD_GLETSTR "
CASE %SE_TOKENCMD_RSTNUM
FUNCTION = "%SE_TOKENCMD_RSTNUM "
CASE %SE_TOKENCMD_RSTSTR
FUNCTION = "%SE_TOKENCMD_RSTSTR "
CASE %SE_TOKENCMD_ERNUM
FUNCTION = "%SE_TOKENCMD_ERNUM "
CASE %SE_TOKENCMD_ERSTR
FUNCTION = "%SE_TOKENCMD_ERSTR "
CASE %SE_TOKENCMD_LABEL
FUNCTION = "%SE_TOKENCMD_LABEL "
CASE %SE_TOKENCMD_PRENUM
FUNCTION = "%SE_TOKENCMD_PRENUM "
CASE %SE_TOKENCMD_PRESTR
FUNCTION = "%SE_TOKENCMD_PRESTR "
CASE %SE_TOKENCMD_GNUMVAR
FUNCTION = "%SE_TOKENCMD_GNUMVAR "
CASE %SE_TOKENCMD_GSTRVAR
FUNCTION = "%SE_TOKENCMD_GSTRVAR "
CASE %SE_TOKENCMD_STEP
FUNCTION = "%SE_TOKENCMD_STEP "
CASE %SE_TOKENCMD_FUNNUM
FUNCTION = "%SE_TOKENCMD_FUNNUM "
CASE %SE_TOKENCMD_ENDSUB
FUNCTION = "%SE_TOKENCMD_ENDSUB "
CASE %SE_TOKENCMD_ENDSEL
FUNCTION = "%SE_TOKENCMD_ENDSEL "
CASE %SE_TOKENCMD_ENDSCR
FUNCTION = "%SE_TOKENCMD_ENDSCR "
CASE %SE_TOKENCMD_JUMPTO
FUNCTION = "%SE_TOKENCMD_JUMPTO "
CASE %SE_TOKENCMD_LABEL
FUNCTION = "%SE_TOKENCMD_LABEL "
CASE %SE_TOKENCMD_OPERAT
FUNCTION = "%SE_TOKENCMD_OPERAT "
CASE %SE_TOKENCMD_NUMCONST
FUNCTION = "%SE_TOKENCMD_NUMCONST "
CASE %SE_TOKENCMD_STRCONST
FUNCTION = "%SE_TOKENCMD_STRCONST "
CASE %SE_TOKENCMD_WAITKEY
FUNCTION = "%SE_TOKENCMD_WAITKEY "
CASE %SE_TOKENCMD_CMD
FUNCTION = "%SE_TOKENCMD_CMD "
CASE %SE_TOKENCMD_STRREV
FUNCTION = "%SE_TOKENCMD_STRREV "
CASE %SE_TOKENCMD_STRDEL
FUNCTION = "%SE_TOKENCMD_STRDEL "
CASE %SE_TOKENCMD_STRINGS
FUNCTION = "%SE_TOKENCMD_STRINGS "
CASE %SE_TOKENCMD_STRING
FUNCTION = "%SE_TOKENCMD_STRING "
CASE %SE_TOKENCMD_MAXS
FUNCTION = "%SE_TOKENCMD_MAXS "
CASE %SE_TOKENCMD_MINS
FUNCTION = "%SE_TOKENCMD_MINS "
CASE %SE_TOKENCMD_RETAIN
FUNCTION = "%SE_TOKENCMD_RETAIN "
CASE %SE_TOKENCMD_REMAIN
FUNCTION = "%SE_TOKENCMD_REMAIN "
CASE %SE_TOKENCMD_REMOVE
FUNCTION = "%SE_TOKENCMD_REMOVE "
CASE %SE_TOKENCMD_REPEAT
FUNCTION = "%SE_TOKENCMD_REPEAT "
CASE %SE_TOKENCMD_RTRIM
FUNCTION = "%SE_TOKENCMD_RTRIM "
CASE %SE_TOKENCMD_JOIN
FUNCTION = "%SE_TOKENCMD_JOIN "
CASE %SE_TOKENCMD_NUL
FUNCTION = "%SE_TOKENCMD_NUL "
CASE %SE_TOKENCMD_ENVGET
FUNCTION = "%SE_TOKENCMD_ENVGET "
CASE %SE_TOKENCMD_ENVSET
FUNCTION = "%SE_TOKENCMD_ENVSET "
CASE %SE_TOKENCMD_FORMAT
FUNCTION = "%SE_TOKENCMD_FORMAT "
CASE %SE_TOKENCMD_EXTRACT
FUNCTION = "%SE_TOKENCMD_EXTRACT "
CASE %SE_TOKENCMD_TAB
FUNCTION = "%SE_TOKENCMD_TAB "
CASE %SE_TOKENCMD_PRINT
FUNCTION = "%SE_TOKENCMD_PRINT "
CASE %SE_TOKENCMD_IFS
FUNCTION = "%SE_TOKENCMD_IFS "
CASE %SE_TOKENCMD_ELSEIFS
FUNCTION = "%SE_TOKENCMD_ELSEIFS "
CASE ELSE
FUNCTION = "????????? [" + HEX$(code) + "] " + BIN$(code)
END SELECT
END FUNCTION
'test a string, if a keyword return function name and definition constant
FUNCTION fundefs(code AS STRING) AS LONG
SELECT CASE AS CONST$ code
CASE "as"
FUNCTION = %SE_TOKENCMD_AS
CASE "abs"
FUNCTION = %SE_TOKENCMD_ABS
CASE "and"
FUNCTION = %SE_TOKENCMD_AND
CASE "acode"
FUNCTION = %SE_TOKENCMD_ACODE
CASE "asc"
FUNCTION = %SE_TOKENCMD_ASC
CASE "atn"
FUNCTION = %SE_TOKENCMD_ATN
CASE "beep"
FUNCTION = %SE_TOKENCMD_BEEP
CASE "bin"
FUNCTION = %SE_TOKENCMD_BIN
CASE "case"
FUNCTION = %SE_TOKENCMD_CASE
CASE "ceil"
FUNCTION = %SE_TOKENCMD_CEIL
CASE "chr"
FUNCTION = %SE_TOKENCMD_CHR
CASE "cint"
FUNCTION = %SE_TOKENCMD_CINT
CASE "cos"
FUNCTION = %SE_TOKENCMD_COS
CASE "command"
FUNCTION = %SE_TOKENCMD_CMD
CASE "date"
FUNCTION = %SE_TOKENCMD_DATE
CASE "decr"
FUNCTION = %SE_TOKENCMD_DECR
CASE "do"
FUNCTION = %SE_TOKENCMD_DO
CASE "end"
FUNCTION = %SE_TOKENCMD_END
CASE "else"
FUNCTION = %SE_TOKENCMD_ELSE
CASE "elseif"
FUNCTION = %SE_TOKENCMD_ELSEIF
CASE "eqv"
FUNCTION = %SE_TOKENCMD_EQV
CASE "erase"
FUNCTION = %SE_TOKENCMD_ERASE
CASE "even"
FUNCTION = %SE_TOKENCMD_EVEN
CASE "exp"
FUNCTION = %SE_TOKENCMD_EXP
CASE "exp2"
FUNCTION = %SE_TOKENCMD_EXP2
CASE "exp10"
FUNCTION = %SE_TOKENCMD_EXP10
CASE "exit"
FUNCTION = %SE_TOKENCMD_EXIT
CASE "fac"
FUNCTION = %SE_TOKENCMD_FAC
CASE "fix"
FUNCTION = %SE_TOKENCMD_FIX
CASE "for"
FUNCTION = %SE_TOKENCMD_FOR
CASE "function"
FUNCTION = %SE_TOKENCMD_FUNCTION
CASE "frac"
FUNCTION = %SE_TOKENCMD_FRAC
CASE "goto"
FUNCTION = %SE_TOKENCMD_GOTO
CASE "gosub"
FUNCTION = %SE_TOKENCMD_GOSUB
CASE "hcase"
FUNCTION = %SE_TOKENCMD_HCASE
CASE "hex"
FUNCTION = %SE_TOKENCMD_HEX
CASE "if"
FUNCTION = %SE_TOKENCMD_IF
CASE "imp"
FUNCTION = %SE_TOKENCMD_IMP
CASE "incr"
FUNCTION = %SE_TOKENCMD_INCR
CASE "instr"
FUNCTION = %SE_TOKENCMD_INSTR
CASE "int"
FUNCTION = %SE_TOKENCMD_INT
CASE "istrue"
FUNCTION = %SE_TOKENCMD_ISTRUE
CASE "isfalse"
FUNCTION = %SE_TOKENCMD_ISFALSE
CASE "max"
FUNCTION = %SE_TOKENCMD_MAX
CASE "msgbox"
FUNCTION = %SE_TOKENCMD_MSGBOX
CASE "mcase"
FUNCTION = %SE_TOKENCMD_MCASE
CASE "mid"
FUNCTION = %SE_TOKENCMD_MID
CASE "min"
FUNCTION = %SE_TOKENCMD_MIN
CASE "mod"
FUNCTION = %SE_TOKENCMD_MOD
CASE "next"
FUNCTION = %SE_TOKENCMD_NEXT
CASE "not"
FUNCTION = %SE_TOKENCMD_NOT
CASE "numbers"
FUNCTION = %SE_TOKENCMD_NUMBERS
CASE "lcase"
FUNCTION = %SE_TOKENCMD_LCASE
CASE "left"
FUNCTION = %SE_TOKENCMD_LEFT
CASE "len"
FUNCTION = %SE_TOKENCMD_LEN
CASE "log"
FUNCTION = %SE_TOKENCMD_LOG
CASE "log2"
FUNCTION = %SE_TOKENCMD_LOG2
CASE "log10"
FUNCTION = %SE_TOKENCMD_LOG10
CASE "loop"
FUNCTION = %SE_TOKENCMD_LOOP
CASE "let"
FUNCTION = %SE_TOKENCMD_LET
CASE "oct"
FUNCTION = %SE_TOKENCMD_OCT
CASE "or"
FUNCTION = %SE_TOKENCMD_OR
CASE "prglines"
FUNCTION = %SE_TOKENCMD_PRGLINES
CASE "pi"
FUNCTION = %SE_TOKENCMD_PI
CASE "randomize"
FUNCTION = %SE_TOKENCMD_RANDOM
CASE "reset"
FUNCTION = %SE_TOKENCMD_RESET
CASE "return"
FUNCTION = %SE_TOKENCMD_RETURN
CASE "right"
FUNCTION = %SE_TOKENCMD_RIGHT
CASE "rnd"
FUNCTION = %SE_TOKENCMD_RND
CASE "round"
FUNCTION = %SE_TOKENCMD_ROUND
CASE "sgn"
FUNCTION = %SE_TOKENCMD_SGN
CASE "space"
FUNCTION = %SE_TOKENCMD_SPACE
CASE "sqr"
FUNCTION = %SE_TOKENCMD_SQR
CASE "stderr"
FUNCTION = %SE_TOKENCMD_STDERR
CASE "step"
FUNCTION = %SE_TOKENCMD_STEP
CASE "stdin"
FUNCTION = %SE_TOKENCMD_STDIN
CASE "stdout"
FUNCTION = %SE_TOKENCMD_STDOUT
CASE "str"
FUNCTION = %SE_TOKENCMD_STR
CASE "string"
FUNCTION = %SE_TOKENCMD_STRING
CASE "select"
FUNCTION = %SE_TOKENCMD_SELECT
CASE "strings"
FUNCTION = %SE_TOKENCMD_STRINGS
CASE "tan"
FUNCTION = %SE_TOKENCMD_TAN
CASE "time"
FUNCTION = %SE_TOKENCMD_TIME
CASE "then"
FUNCTION = %SE_TOKENCMD_THEN
CASE "timer"
FUNCTION = %SE_TOKENCMD_TIMER
CASE "to"
FUNCTION = %SE_TOKENCMD_TO
CASE "trim"
FUNCTION = %SE_TOKENCMD_TRIM
CASE "ucase"
FUNCTION = %SE_TOKENCMD_UCASE
CASE "ucode"
FUNCTION = %SE_TOKENCMD_UCODE
CASE "until"
FUNCTION = %SE_TOKENCMD_UNTIL
CASE "val"
FUNCTION = %SE_TOKENCMD_VAL
CASE "wend"
FUNCTION = %SE_TOKENCMD_WEND
CASE "while"
FUNCTION = %SE_TOKENCMD_WHILE
CASE "xor"
FUNCTION = %SE_TOKENCMD_XOR
CASE "waitkey"
FUNCTION = %SE_TOKENCMD_WAITKEY
CASE "funstr"
FUNCTION = %SE_TOKENCMD_FUNSTR
CASE "endif"
FUNCTION = %SE_TOKENCMD_ENDIF
CASE "dow"
FUNCTION = %SE_TOKENCMD_DOW
CASE "dou"
FUNCTION = %SE_TOKENCMD_DOU
CASE "endfun"
FUNCTION = %SE_TOKENCMD_ENDFUN
CASE "exitif"
FUNCTION = %SE_TOKENCMD_EXITIF
CASE "exitdo"
FUNCTION = %SE_TOKENCMD_EXITDO
CASE "exitwhi"
FUNCTION = %SE_TOKENCMD_EXITWHI
CASE "exitfor"
FUNCTION = %SE_TOKENCMD_EXITFOR
CASE "exitfun"
FUNCTION = %SE_TOKENCMD_EXITFUN
CASE "exitsub"
FUNCTION = %SE_TOKENCMD_EXITSUB
CASE "exitsel"
FUNCTION = %SE_TOKENCMD_EXITSEL
CASE "loopw"
FUNCTION = %SE_TOKENCMD_LOOPW
CASE "loopu"
FUNCTION = %SE_TOKENCMD_LOOPU
CASE "strreverse"
FUNCTION = %SE_TOKENCMD_STRREV
CASE "strdelete"
FUNCTION = %SE_TOKENCMD_STRDEL
CASE "strinsert"
FUNCTION = %SE_TOKENCMD_STRINS
CASE "max"
FUNCTION = %SE_TOKENCMD_MAX
CASE "max$"
FUNCTION = %SE_TOKENCMD_MAXS
CASE "min"
FUNCTION = %SE_TOKENCMD_MIN
CASE "min$"
FUNCTION = %SE_TOKENCMD_MINS
CASE "retain"
FUNCTION = %SE_TOKENCMD_RETAIN
CASE "remain"
FUNCTION = %SE_TOKENCMD_REMAIN
CASE "remove"
FUNCTION = %SE_TOKENCMD_REMOVE
CASE "repeat"
FUNCTION = %SE_TOKENCMD_REPEAT
CASE "rtrim"
FUNCTION = %SE_TOKENCMD_RTRIM
CASE "join"
FUNCTION = %SE_TOKENCMD_JOIN
CASE "nul"
FUNCTION = %SE_TOKENCMD_NUL
CASE "environ"
FUNCTION = %SE_TOKENCMD_ENVGET
CASE "environ$"
FUNCTION = %SE_TOKENCMD_ENVSET
CASE "format"
FUNCTION = %SE_TOKENCMD_FORMAT
CASE "extract"
FUNCTION = %SE_TOKENCMD_EXTRACT
CASE "tab"
FUNCTION = %SE_TOKENCMD_TAB
CASE "print"
FUNCTION = %SE_TOKENCMD_PRINT
END SELECT
END FUNCTION
Code:
%SE_ERROR_FIRST = 150
%SE_ERROR_NOERROR = 0
%SE_ERROR_IFEXPECTED = %SE_ERROR_FIRST + 1
%SE_ERROR_ENDIFEXPECTED = %SE_ERROR_FIRST + 2
%SE_ERROR_DOEXPECTED = %SE_ERROR_FIRST + 3
%SE_ERROR_LOOPEXPECTED = %SE_ERROR_FIRST + 4
%SE_ERROR_WENDEXPECTED = %SE_ERROR_FIRST + 5
%SE_ERROR_WHILEEXPECTED = %SE_ERROR_FIRST + 6
%SE_ERROR_FOREXPECTED = %SE_ERROR_FIRST + 7
%SE_ERROR_NEXTEXPECTED = %SE_ERROR_FIRST + 8
%SE_ERROR_STREXPECTED = %SE_ERROR_FIRST + 9
%SE_ERROR_NUMEXPECTED = %SE_ERROR_FIRST + 10
%SE_ERROR_STATEXPECTED = %SE_ERROR_FIRST + 11
%SE_ERROR_TOEXPECTED = %SE_ERROR_FIRST + 12
%SE_ERROR_NUMVAREXPECTED = %SE_ERROR_FIRST + 13
%SE_ERROR_STRVAREXPECTED = %SE_ERROR_FIRST + 14
%SE_ERROR_QUOTEEXPECTED = %SE_ERROR_FIRST + 15
%SE_ERROR_PARENEXPECTED = %SE_ERROR_FIRST + 16
%SE_ERROR_EXITDOWDO = %SE_ERROR_FIRST + 17
%SE_ERROR_EXITFORWFOR = %SE_ERROR_FIRST + 18
%SE_ERROR_EXITIFWIF = %SE_ERROR_FIRST + 19
%SE_ERROR_EXITWHILEWWHILE = %SE_ERROR_FIRST + 20
%SE_ERROR_ASEXPECTED = %SE_ERROR_FIRST + 21
%SE_ERROR_BYPASSEXPECTED = %SE_ERROR_FIRST + 22
%SE_ERROR_ASTYPEEXPECTED = %SE_ERROR_FIRST + 23
%SE_ERROR_FUNNAMEEXPECTED = %SE_ERROR_FIRST + 24
%SE_ERROR_NESTEDFUN = %SE_ERROR_FIRST + 25
%SE_ERROR_ONLYINFUN = %SE_ERROR_FIRST + 26
%SE_ERROR_NOSE_MAIN = %SE_ERROR_FIRST + 27
%SE_ERROR_FUNSUBEXPECTED = %SE_ERROR_FIRST + 28
%SE_ERROR_MISSINGDECL = %SE_ERROR_FIRST + 30
%SE_ERROR_ILLEGALNAME = %SE_ERROR_FIRST + 31
%SE_ERROR_ALREADYDECL = %SE_ERROR_FIRST + 32
%SE_ERROR_DUPLICATEDECL = %SE_ERROR_FIRST + 33
%SE_ERROR_MATHMODULE = %SE_ERROR_FIRST + 34
%SE_ERROR_FORSTEPZERO = %SE_ERROR_FIRST + 35
%SE_ERROR_PLUSEXPECTED = %SE_ERROR_FIRST + 36
%SE_ERROR_EXITING = %SE_ERROR_FIRST + 37
%SE_ERROR_STARTING = %SE_ERROR_FIRST + 38
%SE_ERROR_PARSING = %SE_ERROR_FIRST + 39
%SE_ERROR_EXECUTING = %SE_ERROR_FIRST + 40
%SE_ERROR_EXPRTOOCOMPLEX = %SE_ERROR_FIRST + 41
%SE_ERROR_SYNTAXERROR = %SE_ERROR_FIRST + 42
%SE_ERROR_EXITSELWSEL = %SE_ERROR_FIRST + 43
%SE_ERROR_ENDFUNEXPECTED = %SE_ERROR_FIRST + 44
%SE_ERROR_VAREXPECTED = %SE_ERROR_FIRST + 45
%SE_ERROR_PARMISMATCH = %SE_ERROR_FIRST + 46
%SE_ERROR_PARCLOSEEXPECTED = %SE_ERROR_FIRST + 47
%SE_ERROR_PAROPENEEXPECTED = %SE_ERROR_FIRST + 48
%SE_ERROR_OVERFLOW = %SE_ERROR_FIRST + 49
%SE_ERROR_UNDEFEQUATE = %SE_ERROR_FIRST + 50
'takes the main struct containing all the info and returns a descriptive error string
FUNCTION se_errortext(BYVAL ses AS ses_type PTR) AS STRING
LOCAL stmp1 AS STRING
SELECT CASE AS LONG @ses.errcode
CASE %SE_ERROR_NOERROR
stmp1 = "no error"
CASE %SE_ERROR_IFEXPECTED
stmp1 = "syntax error 'if' expected"
CASE %SE_ERROR_ENDIFEXPECTED
stmp1 = "syntax error 'end if' expected"
CASE %SE_ERROR_DOEXPECTED
stmp1 = "syntax error 'do' without 'loop'"
CASE %SE_ERROR_LOOPEXPECTED
stmp1 = "syntax error 'loop' without 'do'"
CASE %SE_ERROR_WENDEXPECTED
stmp1 = "syntax error 'wend' without 'while'"
CASE %SE_ERROR_WHILEEXPECTED
stmp1 = "syntax error 'while' without 'wend'"
CASE %SE_ERROR_FOREXPECTED
stmp1 = "syntax error 'for' without 'next'"
CASE %SE_ERROR_NEXTEXPECTED
stmp1 = "syntax error 'next' without 'for'"
CASE %SE_ERROR_STREXPECTED
stmp1 = "error string operand expected"
CASE %SE_ERROR_NUMEXPECTED
stmp1 = "error numeric operand expected"
CASE %SE_ERROR_STATEXPECTED
stmp1 = "error statment expected"
CASE %SE_ERROR_TOEXPECTED
stmp1 = "syntax error 'to' expected"
CASE %SE_ERROR_NUMVAREXPECTED
stmp1 = "error numeric variable expected"
CASE %SE_ERROR_STRVAREXPECTED
stmp1 = "error string variable expected"
CASE %SE_ERROR_QUOTEEXPECTED
stmp1 = "error quote expected"
CASE %SE_ERROR_PARENEXPECTED
stmp1 = "error parenthessis expected"
CASE %SE_ERROR_EXITDOWDO
stmp1 = "error exit 'do' without 'do'"
CASE %SE_ERROR_EXITFORWFOR
stmp1 = "error exit 'for' without 'for'"
CASE %SE_ERROR_EXITIFWIF
stmp1 = "error exit 'if' without 'if'"
CASE %SE_ERROR_EXITWHILEWWHILE
stmp1 = "error exit 'while' without 'while'"
CASE %SE_ERROR_MISSINGDECL
stmp1 = "error missing declaration"
CASE %SE_ERROR_ILLEGALNAME
stmp1 = "error illegal name"
CASE %SE_ERROR_ALREADYDECL
stmp1 = "error variable already declared"
CASE %SE_ERROR_DUPLICATEDECL
stmp1 = "error duplicated declaration"
CASE %SE_ERROR_MATHMODULE
stmp1 = "some obscure math module error happened"
CASE %SE_ERROR_FORSTEPZERO
stmp1 = "error 'step' can't be zero"
CASE %SE_ERROR_PLUSEXPECTED
stmp1 = "error '+' expected "
CASE %SE_ERROR_EXITING
stmp1 = "exiting"
CASE %SE_ERROR_STARTING
stmp1 = "starting"
CASE %SE_ERROR_PARSING
stmp1 = "parsing"
CASE %SE_ERROR_EXECUTING
stmp1 = "executing"
CASE %SE_ERROR_EXPRTOOCOMPLEX
stmp1 = "expression too complex"
CASE %SE_ERROR_SYNTAXERROR
stmp1 = "syntax error"
CASE %SE_ERROR_EXITSELWSEL
stmp1 = "'exit select' w/o 'select'"
CASE %SE_ERROR_ENDFUNEXPECTED
stmp1 = "'end function' expected"
CASE %SE_ERROR_VAREXPECTED
stmp1 = "var name expected"
CASE %SE_ERROR_PARMISMATCH
stmp1 = "parameter mismatch"
CASE %SE_ERROR_PARCLOSEEXPECTED
stmp1 = "')' expected"
CASE %SE_ERROR_PAROPENEEXPECTED
stmp1 = "'(' expected"
CASE %SE_ERROR_OVERFLOW
stmp1 = "overflow"
CASE %SE_ERROR_UNDEFEQUATE
stmp1 = "undefined equate"
CASE %SE_ERROR_BYPASSEXPECTED
stmp1 = "'byval/byref/bycopy' expected"
CASE %SE_ERROR_ASTYPEEXPECTED
stmp1 = "'as long/single/dword/string' expected"
CASE %SE_ERROR_FUNNAMEEXPECTED
stmp1 = "function name expected"
CASE %SE_ERROR_NESTEDFUN
stmp1 = "'function/sub' can't be nested"
CASE %SE_ERROR_ONLYINFUN
stmp1 = "'function=' allowed only in functions"
CASE %SE_ERROR_NOSE_MAIN
stmp1 = "'se_main' not found..."
CASE ELSE
stmp1 = "unknown error code"
END SELECT
FUNCTION = "CT:" + FORMAT$(@ses.pc, "00000") + " LN:" + _
FORMAT$(@ses.@ct[@ses.pc].lncnt, "00000") + " SE:" + _
FORMAT$(@ses.@ct[@ses.pc].secnt, "00") + " FN:" + _
" :" + stmp1 + " [" + FORMAT$(@ses.errcode, "000") + "] "
END FUNCTION
'I GOT THIS ROUTINES FROM THE FORUM, THANKS TO THE AUTHORS
FUNCTION STDOUT (Z AS STRING) AS LONG
' returns TRUE (non-zero) on success
LOCAL hStdOut AS LONG, nCharsWritten AS LONG
LOCAL w AS STRING
STATIC CSInitialized AS LONG, CS AS CRITICAL_SECTION
IF ISFALSE CSInitialized THEN
InitializeCriticalSection CS
CSInitialized = 1
END IF
EntercriticalSection Cs
hStdOut = GetStdHandle (%STD_OUTPUT_HANDLE)
SELECT CASE AS LONG hStdOut
CASE %NULL, -1&
AllocConsole
hStdOut = GetStdHandle (%STD_OUTPUT_HANDLE)
END SELECT
LeaveCriticalSection CS
w = Z & $CRLF
FUNCTION = WriteFile(hStdOut, BYVAL STRPTR(W), LEN(W), nCharsWritten, BYVAL %NULL)
END FUNCTION
MACRO dbcprint (stext)
#IF %DEBUG_FLAG
stdout stext
#ENDIF
END MACRO
FUNCTION stdin() AS STRING
DIM hInput AS LONG
DIM iRead AS LONG
DIM iResult AS LONG
DIM sBuffer AS STRING
DIM sOutBuffer AS STRING
hInput = GetStdHandle(%STD_INPUT_HANDLE)
IF hInput THEN
DO
sBuffer = SPACE$(32000)
iResult = ReadFile(hInput, BYVAL STRPTR(sBuffer), LEN(sBuffer), iRead, BYVAL %NULL)
'- If there was an error, return nothing
IF iResult = 0 THEN
EXIT DO
'- We're done if iRead is 0
ELSEIF iRead = 0 THEN
EXIT DO
'- Otherwise, accumulate the buffer
ELSE
sOutBuffer = sOutBuffer + LEFT$(sBuffer, iRead)
END IF
'- Bail if there's nothing left to read.
IF iRead < LEN(sBuffer) THEN
EXIT DO
END IF
LOOP
END IF
FUNCTION = sOutBuffer
END FUNCTION
SUB WaitKey()
LOCAL hStdIn AS DWORD
LOCAL dwBytesRead AS DWORD
LOCAL dwConsoleMode AS DWORD
LOCAL lpBuffer AS INPUT_RECORD
hStdIn = GetStdHandle(%STD_INPUT_HANDLE)
IF hStdIn <> %NULL AND hStdIn <> %INVALID_HANDLE_VALUE THEN
GetConsoleMode(hStdIn, dwConsoleMode)
SetConsoleMode(hStdIn, %ENABLE_LINE_INPUT OR %ENABLE_ECHO_INPUT OR %ENABLE_PROCESSED_INPUT)
FlushConsoleInputBuffer(hStdIn)
dwBytesRead = 0
DO
PeekConsoleInput(hStdIn, lpBuffer, 1, dwBytesRead)
SLEEP 0
LOOP WHILE dwBytesRead = 0
FlushConsoleInputBuffer(hStdIn)
SetConsoleMode(hStdIn, dwConsoleMode)
END IF
END SUB
Code:
#PBFORMS CREATED V1.51
'------------------------------------------------------------------------------
' The first line in this file is a PB/Forms metastatement.
' It should ALWAYS be the first line of the file. Other
' PB/Forms metastatements are placed at the beginning and
' end of "Named Blocks" of code that should be edited
' with PBForms only. Do not manually edit or delete these
' metastatements or PB/Forms will not be able to reread
' the file correctly. See the PB/Forms documentation for
' more information.
' Named blocks begin like this: #PBFORMS BEGIN ...
' Named blocks end like this: #PBFORMS END ...
' Other PB/Forms metastatements such as:
' #PBFORMS DECLARATIONS
' are used by PB/Forms to insert additional code.
' Feel free to make changes anywhere else in the file.
'------------------------------------------------------------------------------
#COMPILE EXE
#DIM ALL
#DEBUG ERROR ON
#STACK 1024 * 1024 * 4
#TOOLS OFF
'------------------------------------------------------------------------------
' ** Includes **
'------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES
#IF NOT %DEF(%WINAPI)
#INCLUDE "WIN32API.INC"
#ENDIF
#INCLUDE "PBForms.INC"
#PBFORMS END INCLUDES
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Constants **
'------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%IDD_DIALOG1 = 101
%IDC_TxSource = 1001
%IDC_txTokenizer = 1003
%IDR_MENU1 = 102
%IDM_FILE_OPEN = 1008
%IDM_FILE_SAVE = 1009
%IDM_FILE_EXIT = 1010
%IDM_EDIT_COPY = 1011
%IDM_FILE_NEW = 1012
%IDM_RUN_RUN = 1013
%IDM_RUN_STOP = 1016
%IDM_RUN_DEBUG = 1017
%IDM_EDIT_RESETSOURCE = 1018
%IDM_EDIT_RESETRESULT = 1019
%IDM_HELP_HELP = 1020
%IDM_HELP_ABOUT = 1021
%IDD_dlgHelp = 130
%IDC_txHelp = 1030
%IDM_FILE_SAVEAS = 1031
#PBFORMS END CONSTANTS
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Declarations **
'------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
DECLARE FUNCTION AttachMENU1(BYVAL hDlg AS DWORD) AS DWORD
DECLARE CALLBACK FUNCTION ShowdlgHelpProc()
DECLARE FUNCTION ShowdlgHelp(BYVAL hDlg AS DWORD) AS LONG
#PBFORMS DECLARATIONS
'------------------------------------------------------------------------------
GLOBAL g_hwnd AS LONG
GLOBAL scriptstring AS STRING
GLOBAL thstop AS LONG
GLOBAL DEBUG_FLAG AS LONG
FUNCTION tprint(BYVAL stext AS STRING) AS LONG
LOCAL stmp1, stmp2, param AS STRING
CONTROL GET TEXT g_hwnd, %IDC_txTokenizer TO stmp1
stmp1 = stmp1 + $CRLF + stext
CONTROL SET TEXT g_hwnd, %IDC_txTokenizer, stmp1
END FUNCTION
#INCLUDE "se_engine.INC"
#INCLUDE "comdlg32.inc"
'------------------------------------------------------------------------------
' ** Main Application Entry Point **
'------------------------------------------------------------------------------
FUNCTION PBMAIN()
ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
LOCAL hthread AS DWORD
LOCAL txt, file, stmp1 AS STRING, frr AS LONG
STATIC filename AS STRING
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
' Initialization handler
g_hwnd = CBHNDL
TRY
frr = FREEFILE
file = "testcode2.txt"
OPEN file FOR INPUT AS frr
WHILE NOT EOF(frr)
LINE INPUT #frr, txt
stmp1 = stmp1 + txt + $CRLF
WEND
CLOSE frr
CONTROL SET TEXT CBHNDL, %IDC_TxSource, stmp1
filename = file
DIALOG SET TEXT CBHNDL, filename
CATCH
END TRY
settimer CBHNDL, 205, 100, %null
CASE %WM_NCACTIVATE
STATIC hWndSaveFocus AS DWORD
IF ISFALSE CBWPARAM THEN
' Save control focus
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
' Restore control focus
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
CASE %WM_DESTROY
thstop = 1
CASE %WM_TIMER
killtimer CBHNDL, 205
CONTROL HANDLE CBHNDL, %IDC_TxSource TO frr
sendmessage frr, %EM_SETSEL, 0, 0
CASE %WM_COMMAND
' Process control notifications
SELECT CASE AS LONG CBCTL
CASE %IDC_TxSource
IF CBCTLMSG = %EN_SETFOCUS THEN
'sendmessage getdlgitem(g_hwnd, %IDC_TxSource), %EM_SETSEL, 0, 0
END IF
CASE %IDC_Txtokenizer
IF CBCTLMSG = %EN_SETFOCUS THEN
sendmessage getdlgitem(g_hwnd, %IDC_TxSource), %WM_SETFOCUS, 0, 0
END IF
CASE %IDM_FILE_OPEN
File = ""
txt = "Select a script file"
OpenFileDialog (0, txt, File , "", "*.*", "", 0)
IF LEN(File) THEN
TRY
frr = FREEFILE
OPEN file FOR INPUT AS frr
WHILE NOT EOF(frr)
LINE INPUT #frr, txt
stmp1 = stmp1 + txt + $CRLF
WEND
CLOSE frr
CONTROL SET TEXT CBHNDL, %IDC_TxSource, stmp1
filename = file
DIALOG SET TEXT CBHNDL, filename
CATCH
END TRY
END IF
CASE %IDM_FILE_SAVE
IF LEN(filename) THEN
TRY
frr = FREEFILE
file = filename
OPEN file FOR BINARY AS frr
CONTROL GET TEXT CBHNDL, %IDC_TxSource TO stmp1
SEEK frr, 1
PUT$ frr, stmp1
SETEOF frr
CATCH
MSGBOX "Error ocurred while saving " + file
END TRY
CLOSE frr
ELSE
DIALOG SEND CBHNDL, %WM_COMMAND, MAK(DWORD, %IDM_FILE_SAVEAS, 0), 0
END IF
CASE %IDM_FILE_SAVEAS
File = ""
txt = "Save file"
OpenFileDialog (0, txt, File , "", "*.*", "", 0)
IF LEN(file) THEN
TRY
frr = FREEFILE
OPEN file FOR BINARY AS frr
IF (LOF(frr) > 1) THEN
IF MSGBOX(file + " already exist, overwrite?", %MB_ICONQUESTION OR %MB_YESNO, "Overwrite") = %IDNO THEN
CLOSE frr
EXIT FUNCTION
END IF
END IF
CONTROL GET TEXT CBHNDL, %IDC_TxSource TO stmp1
SEEK frr, 1
PUT$ frr, stmp1
SETEOF frr
filename = file
DIALOG SET TEXT CBHNDL, filename
CATCH
MSGBOX "Error ocurred while saving " + file
END TRY
CLOSE frr
END IF
CASE %IDM_FILE_EXIT
DIALOG END CBHNDL
CASE %IDM_EDIT_COPY
CASE %IDM_FILE_NEW
CASE %IDM_RUN_RUN
CONTROL GET TEXT CBHNDL, %IDC_TxSource TO scriptstring
THREAD CREATE tokenizer (VARPTR(scriptstring)) TO hthread
THREAD CLOSE hthread TO hthread
CASE %IDM_RUN_DEBUG
CASE %IDM_RUN_STOP
thstop = 1
CASE %IDM_EDIT_RESETSOURCE
CONTROL SET TEXT CBHNDL, %IDC_TxSource, ""
CASE %IDM_EDIT_RESETRESULT
CONTROL SET TEXT CBHNDL, %IDC_Txtokenizer, ""
CASE %IDM_HELP_HELP
ShowdlgHelp CBHNDL
CASE %IDM_HELP_ABOUT
END SELECT
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Dialogs **
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
LOCAL lRslt AS LONG
#PBFORMS BEGIN DIALOG %IDD_DIALOG1->%IDR_MENU1->
LOCAL hDlg AS DWORD
LOCAL hFont1 AS DWORD
DIALOG NEW hParent, "SE_ENGINE DEMO", 271, 36, 406, 383, %WS_POPUP OR _
%WS_BORDER OR %WS_DLGFRAME OR %WS_THICKFRAME OR %WS_CAPTION OR _
%WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR _
%WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
%DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT _
OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
CONTROL ADD TEXTBOX, hDlg, %IDC_TxSource, "", 4, 176, 398, 192, %WS_CHILD _
OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_HSCROLL OR %WS_VSCROLL OR _
%ES_LEFT OR %ES_MULTILINE OR %ES_AUTOHSCROLL OR %ES_AUTOVSCROLL OR _
%ES_WANTRETURN, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR _
%WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
CONTROL SET COLOR hDlg, %IDC_TxSource, %CYAN, RGB(0, 0, 128)
CONTROL ADD TEXTBOX, hDlg, %IDC_txTokenizer, "", 4, 4, 398, 168, _
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_HSCROLL OR _
%WS_VSCROLL OR %ES_LEFT OR %ES_MULTILINE OR %ES_AUTOHSCROLL OR _
%ES_AUTOVSCROLL, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR _
%WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
CONTROL SET COLOR hDlg, %IDC_txTokenizer, %CYAN, RGB(0, 0, 128)
hFont1 = PBFormsMakeFont("Swedish", 8, 700, %FALSE, %FALSE, %FALSE, _
%ANSI_CHARSET)
CONTROL SEND hDlg, %IDC_TxSource, %WM_SETFONT, hFont1, 0
CONTROL SEND hDlg, %IDC_txTokenizer, %WM_SETFONT, hFont1, 0
AttachMENU1 hDlg
#PBFORMS END DIALOG
DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
DeleteObject hFont1
#PBFORMS END CLEANUP
FUNCTION = lRslt
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION AttachMENU1(BYVAL hDlg AS DWORD) AS DWORD
#PBFORMS BEGIN MENU %IDR_MENU1->%IDD_DIALOG1
LOCAL hMenu AS DWORD
LOCAL hPopUp1 AS DWORD
MENU NEW BAR TO hMenu
MENU NEW POPUP TO hPopUp1
MENU ADD POPUP, hMenu, "File", hPopUp1, %MF_ENABLED
MENU ADD STRING, hPopUp1, "New", %IDM_FILE_NEW, %MF_ENABLED
MENU ADD STRING, hPopUp1, "Open", %IDM_FILE_OPEN, %MF_ENABLED
MENU ADD STRING, hPopUp1, "Save", %IDM_FILE_SAVE, %MF_ENABLED
MENU ADD STRING, hPopUp1, "Save as...", %IDM_FILE_SAVEAS, %MF_ENABLED
MENU ADD STRING, hPopUp1, "Exit", %IDM_FILE_EXIT, %MF_ENABLED
MENU NEW POPUP TO hPopUp1
MENU ADD POPUP, hMenu, "Edit", hPopUp1, %MF_ENABLED
MENU ADD STRING, hPopUp1, "Reset source", %IDM_EDIT_RESETSOURCE, _
%MF_ENABLED
MENU ADD STRING, hPopUp1, "Reset result", %IDM_EDIT_RESETRESULT, _
%MF_ENABLED
MENU NEW POPUP TO hPopUp1
MENU ADD POPUP, hMenu, "Run", hPopUp1, %MF_ENABLED
MENU ADD STRING, hPopUp1, "Run", %IDM_RUN_RUN, %MF_ENABLED
MENU ADD STRING, hPopUp1, "Stop", %IDM_RUN_STOP, %MF_ENABLED
MENU NEW POPUP TO hPopUp1
MENU ADD POPUP, hMenu, "Help", hPopUp1, %MF_ENABLED
MENU ADD STRING, hPopUp1, "Help", %IDM_HELP_HELP, %MF_ENABLED
MENU ADD STRING, hPopUp1, "About", %IDM_HELP_ABOUT, %MF_ENABLED
MENU ATTACH hMenu, hDlg
#PBFORMS END MENU
FUNCTION = hMenu
END FUNCTION
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowdlgHelpProc()
LOCAL frr AS LONG, stmp1, txt AS STRING
STATIC this AS LONG
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
' Initialization handler
this = CBHNDL
TRY
frr = FREEFILE
OPEN "se_engine.inc" FOR INPUT AS frr
WHILE NOT EOF(frr)
LINE INPUT #frr, txt
IF INSTR(txt, "#ENDIF") THEN EXIT DO
IF ISFALSE(INSTR(txt, "#IF")) THEN
stmp1 = stmp1 + MID$(txt, 2) + $CRLF
END IF
WEND
CONTROL SET TEXT CBHNDL, %IDC_Txhelp, stmp1
CATCH
END TRY
CLOSE frr
CASE %WM_NCACTIVATE
STATIC hWndSaveFocus AS DWORD
IF ISFALSE CBWPARAM THEN
' Save control focus
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
' Restore control focus
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
CASE %WM_COMMAND
' Process control notifications
SELECT CASE AS LONG CBCTL
CASE %IDC_txHelp
IF CBCTLMSG = %EN_SETFOCUS THEN
sendmessage getdlgitem(this, %IDC_txHelp), %EM_SETSEL, 0, 0
END IF
END SELECT
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION ShowdlgHelp(BYVAL hParent AS DWORD) AS LONG
LOCAL lRslt AS LONG
STATIC already AS LONG
IF already THEN EXIT FUNCTION
#PBFORMS BEGIN DIALOG %IDD_dlgHelp->->
LOCAL hDlg AS DWORD
LOCAL hFont1 AS DWORD
DIALOG NEW hParent, "SE Script engine Help", 70, 70, 353, 225, %WS_POPUP _
OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR _
%WS_VISIBLE OR %DS_MODALFRAME OR %DS_CENTER OR %DS_3DLOOK OR _
%DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR _
%WS_EX_TOOLWINDOW OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
%WS_EX_RIGHTSCROLLBAR, TO hDlg
CONTROL ADD TEXTBOX, hDlg, %IDC_txHelp, "", 4, 4, 344, 216, %WS_CHILD OR _
%WS_VISIBLE OR %WS_TABSTOP OR %WS_VSCROLL OR %ES_LEFT OR _
%ES_MULTILINE OR %ES_AUTOHSCROLL OR %ES_READONLY, %WS_EX_CLIENTEDGE _
OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
CONTROL SET COLOR hDlg, %IDC_txHelp, %GREEN, %BLACK
hFont1 = PBFormsMakeFont("Arial", 9, 700, %FALSE, %FALSE, %FALSE, _
%ANSI_CHARSET)
CONTROL SEND hDlg, %IDC_txHelp, %WM_SETFONT, hFont1, 0
#PBFORMS END DIALOG
already = 1
DIALOG SHOW MODAL hDlg, CALL ShowdlgHelpProc TO lRslt
already = 0
#PBFORMS BEGIN CLEANUP %IDD_dlgHelp
DeleteObject hFont1
#PBFORMS END CLEANUP
FUNCTION = lRslt
END FUNCTION
'------------------------------------------------------------------------------
Comment