1. EDB.EXW Database Browser
- Posted by SergioGelli Sep 09, 2010
- 1729 views
Hello Matt
When I run the bellow program,
Name - edb.exw
Purpose - Main file for Euphoria Database Browser
the following error appears.
D:\Download\databaseEds\euscript.e:1 illegal character þw}b#$ ^
euscript.e seems corrupted.
2. Re: EDB.EXW Database Browser
- Posted by dcole Sep 10, 2010
- 1670 views
SergioGelli said...
Hello Matt
When I run the bellow program,
Name - edb.exw
Purpose - Main file for Euphoria Database Browser
the following error appears.
D:\Download\databaseEds\euscript.e:1 illegal character þw}b#$ ^
euscript.e seems corrupted.
If it's any consolation I'm getting the same thing.
This seems to be an old file. It's using onResize (not used anymore).
Don Cole
3. Re: EDB.EXW Database Browser
- Posted by sergelli Sep 11, 2010
- 1679 views
dcole said...
This seems to be an old file. It's using onResize (not used anymore). Don Cole
What really is happening is that the file "euscript.e", is corrupted.
Look out the content of the first line of this file
à ¾ w) b # $ â € ™ â ² â ¹ â 'â € ¹ Å ¡t lka ª r \ a § à ± à £ â ¯ "A" for à ¼ a ² would ° (à ¢ I to ½ y and _a ¹ | à ™ Ã-à · â € ™ à ...' â Å "Do , Å'ÃŽ [à ® pâ "¢ Ã> wing" 3ßà °
This file is part of the work of Matthew Lewis, called "Euphoria Database Browser", on contributions from users.
We need a good review on user contributions and eliminating jobs that do not work anymore?
We should be aware that, this contributions, when downloaded by beginners in Euphoria, bring serious damage to the image of a good programming language
4. Re: EDB.EXW Database Browser
- Posted by ghaberek (admin) Sep 11, 2010
- 1678 views
It seems to me that euscript.e is shrouded in the old Euphoria 2.x encrypted shroud format. Later versions use an "intermediate language" shroud format instead. Perhaps you should look at wxEDB (SourceForge/Archive) instead...
-Greg
5. Re: EDB.EXW Database Browser
- Posted by jimcbrown (admin) Sep 11, 2010
- 1899 views
ghaberek said...
It seems to me that euscript.e is shrouded in the old Euphoria 2.x encrypted shroud format.
Can it be unshrouded?
I have a copy of euscript.e somewhere, if it helps..
with trace ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- --/topic Introduction --/info -- -- EuScript v0.2<br> -- (C) 2003 Matt Lewis -- converted to scripting engine -- -- Euphoria emulator v. 0.3<br> -- (c) 1999 David Cuny up to 0.2b<br> -- (C) Dec, 1999 Delroy Gayle -- --This was originally released as Eu.ex by David Cuny, later taken over by --Delroy Gayle, whose last release was in December of 1999. It was meant --to be a Euphoria interpreter written in Euphoria, and was used in the --same way (i.e., at the command line: "ex eu.ex myapp.ex"). -- --In 2000, Matt Lewis converted Eu.ex in euscript.e, which allows it to be used --as an embedded scripting engine for his Euphoria programs. In 2003, he --cleaned it up and released it to the public. -- --/code --LICENSE: --THIS SOFTWARE IS FREEWARE. YOU MAY DO WHAT YOU WISH WITH IT, BUT YOU MUST --GIVE CREDIT TO THE ORIGINAL AUTHORS. -- --DISCLAIMER: --THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, --INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY --AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE --AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, --OR CONSEQUENTIAL DAMGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF --SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFIT; OR BUSINESS --INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN --CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) --ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE --POSSIBILITY OF SUCH DAMAGE. --/endcode -- Eu.ex -- -- Euphoria emulator v. 0.3 -- (c) 1999 David Cuny up to 0.2b -- (C) Dec, 1999 Delroy Gayle -- (C) 2003 Matt Lewis -- converted to scripting engine --/topic Changes --/info --History of euscript --/code -- -- v0.2 -- 9/2/03 - Fixed include mechanism -- -- v0.1 -- 7/14/03 - Released as euscript -- -- v0.0 --12/12/00 -- EuScript .01 Matt Lewis -- Converting Eu to run Euphoria scripts instead of full programs -- * Put var initialization into init_eu() -- * Added majukscript extensions -- * Commented out non-scriptible routines (ie, print, peek, etc) -- * namespace collisions with Win32Lib (True/False, returnValue) -- -- Eu.ex Change history: -- -- 09.14.99 - DC -- added platform() -- -- 3.12.99 - DG -- Tested Eu with DOS32lib.e ... works fine except for EX06, EX18 & EX15 -- -- While testing, EU found a bug with 'font.e' in conjunction with EX15!! -- via EU typechecking -- font.e line 22 'chars' is 67 when it ought to be a sequence! -- -- It seems that EU has a problem with 'menu-handling' -- -- While testing, EU found a bug with 'dos32lib.e v.4'!! -- via EU routine_id -- line 3496 should be saying -- classShow[ List ] = routine_id( "showListBox" ) -- NOT classShow[ List ] = routine_id( "showList" ) -- -- implemented: -- routine_id - amended 'call_func_', 'call_proc_', 'routine_id_' -- accordingly - 30.10.1999 - Delroy Gayle -- -- SANITY15 (1.5 version) ok ... takes between 2-3 mins on a P150 with EU -- LW15.EX (1.5 version) ok ... with NO SHORT-CIRCUITING -- -- PLEASE NOTE: when testing 'SANITY, LW & DOS32LIB' i.e. graphic programs -- in general; set TRACE_LINES to 0 not 5, -- because of EU's usage of 'position/get_position' -- -- PLEASE NOTE: when testing 'LW15' keep shortCircuitFlag 0 not 1 -- within routine 'parse'; because AND_CIRCUITING was not before 2.1 -- -- While testing, EU found a bug with 'queens.ex'!! -- via EU typechecking -- line 85 should be 'integer r' not 'row r' because r can be > N!! -- you can verify this by switching type-checking ON in queens.ex! -- -- 29.10.99 - DG -- In this version, add the missing features: -- short-circuited 'or' & routine_id -- DG15 DG16 -- -- 'or' must be short-circuited in IF & WHILE -- -- hence CSORT.EX ok -- ALLSORTS.EX ok -- SANITY21.EX ok ... takes between 2-3 mins on a P150 with EU -- LW.EX (2.1 version) ok -- ONLY when type-checking is OFF i.e. typeCheckFlag=0 !!! Because -- there is an actual type/check error in SCREEN.E concerning the -- global type 'image' ... you can reproduce this by switching on -- type-checking on in LW.EX and you will see the error at -- line 221 -- --------- concerning the FOR LOOP bug -- Dear David Cuny - it appears that there is a 'nested FOR loop' bug -- in EUPHORIA!!! -- After fixing the bug that was 'removing' the wrong variables - DG6 -- I attempted to run a simple 'nested FOR loop' and it failed! -- See Test36.ex & Test37.ex - look at the profile files as well -- The inner loop runs 6 times but the outer loop ONLY ONCE!! -- I traced it and there is no logical reason why the outer loop -- should not loop 5 times ... hence a BUG IN EUPHORIA 2.1 !!! -- I have informed RDS -- -- Therefore, changed the FOR Loop into a WHILE LOOP - DG18 -- -- 20.10.99 - DG -- Will commence to 'debug' this program!! -- 1) change all while 1 do ==> while true do -- 'TRUE' already in use! -- 2) automatically supply '.ex' -- 3) show which missing quote (" or ') -- 4) make the scanner TIGHTER for numbers (dec & hex) & identifiers -- 5) 'command_line()' IS A FUNCTION not a procedure! -- 'find(x,s)' s -- sequence! -- 'power(x1,x2)' -- BOTH objects not atoms! -- 'prepend(s1,x)' -- x IS A object not atom! -- 'system_exec(st,i2)' IS A FUNCTION not a procedure! --- 6) FOR Loop bug is fixed - introduced FOR_LOOP_INDEX -- 7) When subscripting, positive decimal numbers CAN BE USED -- which are in turn ROUNDED DOWN (FLOORed) i.e. -- y[2.4]==>y[2] y[1.3]==>y[1] -- 8) return NO_OP as a sequence i.e.{ { NO_OP } } -- since ALL procedures are 'a sequence of a sequence' -- 9) the parser DID NOT reflect that * / had HIGHER precedence than + - etc -- Also, there was an Associativity bug with arithmetic -- 5-1+1==>5 was being parsed as (5-(1+1))==>3 -- The Parser ought to associate to the LEFT -- i.e. reflect LEFT-TO-RIGHT evaluation -- Likewise for multiplication, division and concatenation -- Likewise for the comparison operators -- 10) 'xor_bits_' not 'xor_bit' hence causing an illegal 'routine_id' -- 11) wasn't restoring the 'lineNumber' of the stack! and other -- various 'lineNumber' bugs fixed -- 12) wasn't using the 'current sourceline' to report RunTime Errors -- introduced CURRENT_LINE_INDEX -- 13) Added type-checking to ASSIGNMENTS! -- typeCheckFlag was never ever set! -- 14) 'elsif' and 'while'expressions were NOT being short-circuited! -- it was only being done for 'if' -- -- 29.10.99 - DG -- Will commence to add 'short-circuited OR', 'call_func_' and -- amend 'routine_id_', 'call_proc_' this program!! -- 15) Added short-circuited 'or' for IF & WHILE statements -- 16) Amended 'routine_id_' -- Discovered an interesting feature whilst testing 'routine_id' -- Because the programs PARSES a statement at a time THEN executes it -- if the last line of an INCLUDED file contains the 'routine_id' -- a) it picks up EOF BEFORE execution -- b) hence it resets pVisible[scope] making the routines which really -- are STILL IN SCOPE, INVISIBLE to 'routine_id_' -- hence it returns -1 although it is executing -- the LAST LINE of the INCLUDED File which contains the routine! -- Solution: add the 'fileIndex' to pUser and check -- BOTH name & fileindex when searching for the routine; -- hence need to restore fileIndex's value from stack also! -- -- 17) Bug discovered with the usage of 'parse()' whilst running 'lw.ex' -- This bug occurs where types & variables, etc share THE SAME NAME -- a) Because parse() searches for TYPES before VARS! -- b) But more to the point it will find a TYPE in GLOBAL space -- whilst there may exist a VARIABLE with the same name within MODULE -- space hence EU would fail with such programs as test34 & test35 -- Solution: change the search order when seeking for -- vars/constants/types/procs/funcs -- Hence, when determining the meaning of a 'word' -- i) when applicable search for 'vars' in ROUTINE space first -- ii) else search for vars/constants/types/procs/funcs -- in visible MODULE space -- iii) Otherwise, search vars/constants/types/procs/funcs -- in GLOBAL space -- However, search for vars/constants & types/procs/funcs -- collectively! -- 18) To workaround a 'Euphoria 2.1 nested For loop' bug -- change the FOR loop within 'for_' to a WHILE loop -- --/endcode --without trace without type_check without warning constant Debug = 0 -- display debugging information constant Echo = 0 -- echo lines read constant True = 1 constant False = 0 type boolean(integer x) return x = 0 or x = 1 end type include graphics.e include get.e include file.e include sprint.e constant Version = "EuScript version 0.2 alpha (Eu v0.3)" -- was 0.1 -- parser.ex include wildcard.e sequence words sequence wordPos sequence thisLine atom FOR_LOOP_INDEX object CURRENT_LINE_INDEX object LAST_FOUND,FOUND_INDEX object currentWord words = {} thisLine = {} constant EOF = "<End of File>" ----------------------------------------------------------------------------- -- for include files constant EuPlace = getenv( "EUDIR" ), Place = { "", EuPlace & "\\", EuPlace & "\\INCLUDE\\" } ----------------------------------------------------------------------------- -- variable constant V_NAME = 1, -- variable name V_VALUE = 2, -- value V_TYPE = 3, -- data type V_INIT = 4 -- has it been initialized? -- procedure/function attributes constant P_NAME = 1, -- module name P_TYPE = 2, -- module type (func/proc/type) P_ARGS = 3, -- argument count P_CODE = 4, -- executable code P_VARS = 5, -- variable names P_VTYPE = 6, -- variable data types P_FILEINDEX = 7 -- the index of the file that contains this routine -- scope of an item. these are arranged in search order constant ROUTINE = 1, -- n/a for procedures MODULE = 2, GLOBAL = 3 constant DEBUG = 0, WARNING = 1 constant -- data types OBJECT = -1, -- object data type ATOM = -2, -- atom data type INTEGER = -3, -- integer data type SEQUENCE = -4, -- sequence data type CONSTANT = -5 -- constant, can't assign value global constant -- procedures EUFUNC = 1, -- builtin function PROC = 2 -- builtin procedure constant RETURN_EUFUNC = 3, -- function returns a value RETURN_PROC = 4, -- procedure return, no value FOR = 5, -- for loop EXIT = 6, -- exit from loop IF = 7, -- if statement WHILE = 8, -- while statement USER_PROC = 9, -- user defined procedure USER_EUFUNC = 10, -- user defined function USER_TYPE = 11, -- user defined type NO_OP = 12, -- no op TRUE = 13, -- return true -- for ELSE statements -- fetching values GET_LOCAL = 20, -- fetch local from routine GET_MODULE = 21, -- fetch var from module SET_LOCAL = 22, -- set local in routine SET_MODULE = 24, -- set var in module GET_INDEX_LOCAL = 25, -- fetching from index GET_INDEX_MODULE = 26, -- fetching from index SET_INDEX_LOCAL = 27, -- set an index SET_INDEX_MODULE = 28, -- set an index GET_SLICE_LOCAL = 29, -- set a slice to a value GET_SLICE_MODULE = 30, -- set a slice to a value SET_SLICE_LOCAL = 31, -- set a slice to a value SET_SLICE_MODULE = 32, -- set a slice to a value SET_CONSTANT = 33, -- set a constant -- data operations ADD = 40, -- add (+) SUB = 41, -- subtract (-) MUL = 42, -- multiply (*) DIV = 43, -- divide (/) NEGATE = 44, -- unary minus CONCAT = 45, -- concatenate sequences (&) NOT = 46, -- logical not AND = 47, -- logical and SHORT_AND = 48, -- logical and with short-circuiting OR = 49, -- logical or XOR = 50, -- logical xor EQ = 51, -- equal NE = 52, -- not equal GT = 53, -- greater than GE = 54, -- greater or equal LT = 55, -- less than LE = 56, -- less or equal SHORT_OR = 57, -- logical or with short-circuiting -- embedded constants DATA = 60, -- data in "raw" form SEQ = 62, -- sequence of data EUEMPTY = 63 -- empty sequence constant TRACE_LINES = 10 -- how many lines to show during trace -- set to 0 when testing 'sanity.ex, LW, DOS32LIB, ...' etc. sequence builtin, -- builtin routines pVisible, -- names of all visible routines pUser, -- user defined procs vList, -- names of visible variables, and their indexes vName, -- names of module/global variables vValue, -- list of module/global variable values vType, -- data type of module/global variables vInit, -- holds list of module/global variable init flags uValue, -- current routine's values uInit, -- current routines initialization values stack, -- stack for include files included, -- list of included files source, -- source file traceStack -- stack of trace integer exprRoutineId, -- routine id of expr() parseRoutineId, -- routine id of parse() globalFlag, -- true if keyword "global" was encountered theProc, -- holds index of procedure being defined runProc, -- holds index of procedure being run returnFlag, -- if true, return statement was encountered returnInit, -- if true, returned a value from the function exitFlag, -- if true, exits loop typeCheckFlag, -- if true, type checking is enabled traceFlag, -- if true, trace enabled shortCircuitFlag, -- if true, use short circuiting sourceHandle, -- handle to file being read fileIndex, -- index to included, points to current file name lineNumber, -- current line number topTraceLine, -- prior top line shown on trace screen traceDepth -- depth of tracing allowed object euReturnValue -- value returned from function sequence script ----------------------------------------------------------------------------- function makePrintable( object o ) -- used to make error values printable sequence s if not sequence( o ) then -- return REAL numbers appropriately if not integer( o ) then return sprintf( "%g", {o} ) else return sprintf( "%d", {o} ) end if else s = "{" for i = 1 to length( o ) do if atom( o[i] ) then if o[i] >= 32 and o[i] <= 126 then -- number and printable char s &= sprintf( "%d'%s'", {o[i],o[i]} ) else -- just number s &= sprintf( "%d", {o[i]} ) end if else s &= makePrintable( o[i] ) end if if i != length( o ) then s &= "," end if end for s &= "}" end if return s end function ----------------------------------------------------------------------------- integer err_file err_file = open( "euscript.err", "w" ) procedure debug( sequence s1, sequence s2 ) -- debugging, used in development if Debug then printf( err_file, s1 & "\n", s2 ) end if end procedure ----------------------------------------------------------------------------- global integer err_routine, err_handled err_routine = 0 err_handled = 0 procedure syntaxErr( sequence s1, sequence s2 ) -- report error and abort sequence text if err_routine then err_handled = 1 text = source[length( source )] text = text[3..length(text)] call_proc( err_routine, { s1, s2, text, lineNumber } ) return end if -- error printf( err_file, "Syntax error - %s\n", {sprintf( s1, s2 )} ) if theProc then text = pUser[theProc][P_NAME] else text = "N/A" end if -- location printf( err_file, "Routine: %s Line: %d\n", { text, --included[length(included)], lineNumber} ) -- display offending line text = source[length( source )] text = text[3..length(text)] if length( text ) > 78 then text = text[1..78] end if puts( err_file, text ) -- abort ? 1/0 abort(0) end procedure ----------------------------------------------------------------------------- procedure runErr( sequence s1, sequence s2 ) -- report error and abort sequence text -- error puts( err_file, "\nError - " & sprintf( s1, s2 ) & "\n" ) -- location if err_routine then call_proc( err_routine, {s1, s2, "", CURRENT_LINE_INDEX}) err_handled = 1 return end if CURRENT_LINE_INDEX = source[CURRENT_LINE_INDEX] printf( err_file, "Module: %s Line: %d\n", {included[CURRENT_LINE_INDEX[2]], CURRENT_LINE_INDEX[1]} ) -- offending line text = CURRENT_LINE_INDEX puts( err_file, text[3..length(text)] ) -- abort abort(0) end procedure ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- parsing ----------------------------------------------------------------------------- function isdigit(integer char) return ( char >= '0' and char <= '9' ) end function function isalphanum(integer char) -- short circuit if ( char >= 'A' and char <= 'Z' ) or ( char >= 'a' and char <= 'z' ) or ( char >= '0' and char <= '9' ) or char = '_' then return True else return False end if end function function ishex(integer char) -- short circuit if isdigit(char) or ( char >= 'A' and char <= 'F' ) then return True else return False end if end function procedure accumulate_word(sequence word, atom i) -- add word, if any is accumulated if length( word ) then words = append( words, word ) wordPos = append( wordPos, i ) end if end procedure procedure parseLine( sequence text ) integer char, -- current letter nextChar, -- next letter quoted -- if true, in quotes sequence word -- accumulates characters boolean eflag -- exponent handling atom i,j,len -- clear words words = {} wordPos = {} -- add 2 spaces onto the end, to ensure it's all delimited -- second space prevents nextChar from crashing text = text & " " -- extract the words word = "" quoted = 0 -- scan line i = 0 len = length( text )-1 while True do i += 1 if i > len then exit end if -- read chars char = text[i] nextChar = text[i+1] -- ignore? if char = 0 then -- zapped. had been a special character -- close quote? elsif quoted and char = quoted then -- add end quote word = word & quoted -- check size on single quote if quoted = '\'' then -- special char? if length( word ) = 4 then if word[2] != '\\' then syntaxErr( "character constant is missing a closing '", {} ) end if -- too small? elsif length( word ) != 3 then syntaxErr( "single-quote character is empty", {} ) elsif length( word ) < 1 then syntaxErr( "character constant is missing a closing '", {} ) end if end if if err_handled then err_handled = 0 return end if -- add to words words = append( words, word ) wordPos = append( wordPos, i ) -- clear word word = "" -- clear flag quoted = 0 -- special character elsif char = '\\' then -- must be quoted if not quoted then syntaxErr( "illegal character.", {} ) end if if err_handled then err_handled = 0 return end if -- special character if nextChar = 'n' then char = '\n' elsif nextChar = 'r' then char = '\r' elsif nextChar = 't' then char = '\t' elsif nextChar = '\\' then char = '\\' elsif nextChar = '\'' then char = '\'' elsif nextChar = '\"' then char = '\"' else syntaxErr( "unknown escape character.", {} ) end if -- accumulate word = word & char -- zap the next so it won't be read text[i+1] = 0 -- inside quote elsif quoted then -- accumulate word = word & char -- start of quote elsif ( char = '"' or char = '\'') and not quoted then -- add word, if any is accumulated accumulate_word(word,i) -- start quote word = {char} -- set flag quoted = char -- comment? elsif char = '-' and nextChar = '-' then -- store accumulated word? accumulate_word(word,i) -- ignore rest if line return -- white space? elsif char = ' ' or char = '\n' or char = '\r' -- mwl added 7/22/03 or char = '\t' then -- add to word if length( word ) then words = append( words, word ) wordPos = append( wordPos, i ) word = "" end if -- non-delimiter? -- numbers: elsif ( char >= '0' and char <= '9' ) then accumulate_word(word,i) word = {char} j = i eflag = False for k=i+1 to len do char = text[k] nextChar = text[k+1] if isdigit(char) then word &= char eflag = False elsif char = '.' then -- decimals if nextChar='.' then exit -- e.g. 1..2 elsif not isdigit(nextChar) then syntaxErr("fractional part of the number is " & "missing", {}) else word &= char -- add '.' AND CONTINUE end if elsif find(char,{'e','E'}) then -- exponents if isdigit(nextChar) or find(nextChar,{'-','+'}) then -- e-99, e+99 etc word &= 'e' -- add 'e' AND CONTINUE eflag = True else syntaxErr("number not formed correctly", {}) end if elsif find(char,{'-','+'}) then -- exponents if eflag then -- part of an exponent eflag = False word &= char -- add '-/+' AND CONTINUE else exit -- finish at this point e.g. 123+123 end if else exit -- non-number -- finish end if if err_handled then err_handled = 0 return end if -- keep note of position j = k end for -- accumulate the number and CONTINUE loop with i=j accumulate_word(word,j) word="" i = j -- non-delimiter? -- IDENTIFIERS which can't begin with '_' elsif ( char >= 'A' and char <= 'Z' ) or ( char >= 'a' and char <= 'z' ) then accumulate_word(word,i) word = {char} j = i for k = i+1 to len do char = text[k] if isalphanum(char) then word &= char else exit -- non-alphanumeric -- finish end if -- keep note of position j = k end for -- accumulate the IDENTIFIER and CONTINUE loop with i=j accumulate_word(word,j) word = "" i = j -- non-delimiter? -- hexadecimals! elsif char = '#' then accumulate_word(word,i) -- returned as TWO parts {'#',num} words = append( words, {'#'}) wordPos = append( wordPos, i ) word = "" j = i for k=i+1 to len do char = text[k] if ishex(char) then -- soley CAPITAL A-F & digits! word &= char else exit -- non-hex-LETTER/digit -- finish end if -- keep note of position j = k end for if length(word)=0 then syntaxErr("hex number not formed correctly", {}) end if if err_handled then err_handled = 0 return end if -- accumulate the HEX and CONTINUE loop with i=j accumulate_word(word,j) word = "" i = j elsif char='_' then syntaxErr( "illegal character >> %s <<.", {char} ) if err_handled then err_handled = 0 return end if -- delimiter else -- accumulated word? accumulate_word(word,i) -- special delimiter? if char = '!' and nextChar = '=' then word = "!=" elsif char = '<' and nextChar = '=' then word = "<=" elsif char = '>' and nextChar = '=' then word = ">=" elsif char = '+' and nextChar = '=' then word = "+=" elsif char = '-' and nextChar = '=' then word = "-=" elsif char = '*' and nextChar = '=' then word = "*=" elsif char = '/' and nextChar = '=' then word = "/=" elsif char = '&' and nextChar = '=' then word = "&=" elsif char = '.' and nextChar = '.' then word = ".." else word = {char} end if -- remove next char? if length( word ) = 2 then -- zap it so it won't be read text[i+1] = 0 end if -- add word words = append( words, word ) wordPos = append( wordPos, i ) -- clear it word = "" end if end while -- end for if quoted then syntaxErr( "End of line reached with no closing " & quoted, {} ) end if if err_handled then err_handled = 0 return end if end procedure ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- handle include files ----------------------------------------------------------------------------- function getIncludeName( sequence data ) -- if the statement is an include statement, return the file name integer at -- include statement missing? if not match( "include ", data ) then return "" end if -- trim white space while find( data[1], " \t" ) do data = data[2..length( data ) ] end while -- line feed? if find( '\n', data ) then data = data[1..length(data)-1] end if -- not first statement? if not equal( data[1..8], "include " ) then -- not an include statement return "" else -- remove statement data = data[9..length(data)] end if -- remove data after space at = find( ' ', data ) if at then data = data[1..at-1] end if return data end function ----------------------------------------------------------------------------- procedure includeFile( sequence fName ) -- returns where a file is -- looks in the usual places sequence fullName -- no full name found yet fullName = {} -- look in the usual places for i = 1 to length( Place ) do if sequence( dir( Place[i] & fName ) ) then fullName = Place[i] & fName exit end if end for -- not found? if length( fullName ) = 0 then -- not exactly Euphoria's error message syntaxErr( "Can't locate file %s", {fName} ) end if if err_handled then err_handled = 0 return end if -- already included? if find( fullName, included ) then -- do nothing return else -- add to list included = append( included, fullName ) end if -- store the current module information stack = prepend( stack, { vList[ MODULE ], -- module variables pVisible[ MODULE ], -- module routines sourceHandle, -- file handle lineNumber, -- current line number fileIndex } ) -- index to name -- make the current module invisible vList[ MODULE ] = {} pVisible[ MODULE ] = {} -- open the file sourceHandle = open( fullName, "r" ) if sourceHandle = -1 then syntaxErr( "error opening file %s", {fName} ) end if if err_handled then err_handled = 0 return end if -- clear the line number lineNumber = 0 -- current file fileIndex = length( included ) end procedure ----------------------------------------------------------------------------- procedure readSourceLine() -- read a line of source code -- convert to words integer last -- position of last character in line sequence includeName -- include file name object data -- line from file thisLine = "" -- read -- 9/2/03: fix for include files mwl if sourceHandle > 0 then data = gets( sourceHandle ) trace(1) else if length( script ) then data = script[1] else data = 0 end if if length(script) > 1 then script = script[2..length(script)] else script = {} end if end if -- end of file? if integer( data ) then -- close the file REGARDLESS of whether anything on stack if sourceHandle > 0 then close( sourceHandle ) end if -- is there an file to return to? if length( stack ) then -- pop the stack data = stack[1] stack = stack[2..length(stack)] -- restore data from stack vList[ MODULE ] = data[1] pVisible[ MODULE ] = data[2] sourceHandle = data[3] lineNumber = data[4] -- restore the line no. in order to display the correct location fileIndex = data[5] -- treat as blank line words = {} return else words = { EOF } return end if end if -- ONLY increment the line number IF NOT EOF lineNumber += 1 -- echo text on screen --if Echo then -- puts( 1, ">" & data ) --end if -- remove line feed -- check for \r on unix systems... last = length( data ) if data[last] = '\n' then data = data[1..last-1] -- 9/2/03 added test for length of data. mwl if last > 1 and data[last-1] = '\r' then data = data[1..last-2] end if end if -- add to source listing source = append( source, { lineNumber, fileIndex } & data ) -- is this an include file? includeName = getIncludeName( data ) if length( includeName ) then -- switch to include file includeFile( includeName ) -- treat as a blank line words = {} return end if -- save line for errors thisLine = data -- parse into words parseLine( data ) end procedure ----------------------------------------------------------------------------- function thisWord() -- returns current word being parsed -- if list is empty, reads a new line -- read until non-blank, or eof while not length( words ) do readSourceLine() end while return words[1] end function ----------------------------------------------------------------------------- function isWord( sequence s ) -- true if s matches current word being parsed return equal( thisWord(), s ) end function ----------------------------------------------------------------------------- function isCurWord( sequence s ) -- true if s matches current word being parsed return equal( currentWord, s ) end function ----------------------------------------------------------------------------- function isNumber() -- true if thisWord is a number sequence s s = thisWord() return (s[1] >= '0' and s[1] <= '9') end function ----------------------------------------------------------------------------- function isString() -- true if thisWord is a string sequence s s = thisWord() return (s[1] = '"') end function ----------------------------------------------------------------------------- function isChar() -- true if thisWord is a char sequence s s = thisWord() return (s[1] = '\'') end function ----------------------------------------------------------------------------- procedure checkEOF() -- if eof, issue error if isWord( EOF ) then syntaxErr( "expected to see possibly 'end', not end of file", {} ) end if if err_handled then err_handled = 0 return end if end procedure ----------------------------------------------------------------------------- procedure moveAhead() -- removes word from head of list if length( words ) then -- chop word off beginning of list words = words[2..length(words)] wordPos = wordPos[2..length(wordPos)] end if end procedure ----------------------------------------------------------------------------- procedure require( sequence s ) -- generates error if s does not match -- otherwise, accepts and moves to next word if not isWord( s ) then syntaxErr( "Expected to see possibly '%s', not '%s'.", {s, thisWord()} ) if err_handled then err_handled = 0 return end if else moveAhead() end if end procedure ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- internal structure tracking ----------------------------------------------------------------------------- function findIndex( object index, sequence s ) -- find the index for something for i = 1 to length( s ) do if equal( index, s[i][1] ) then -- save the value FOUND_INDEX = i return i end if end for return False end function ----------------------------------------------------------------------------- -- changed to global. mwl 12/12/00 --/topic Reference --/func findRoutine( sequence name ) -- --Returns 1 if the routine /b name exists within the current --scope of the script, 0 otherwise. This can be used to check --for the existence of a routine within the script. global function findRoutine( sequence name ) -- return true if exists integer at -- look for it in all the scopes for scope = MODULE to GLOBAL do at = findIndex( name, pVisible[scope] ) if at then -- save the value FOUND_INDEX = pVisible[scope][at][2] -- return index return pVisible[scope][at][2] end if end for return False end function ----------------------------------------------------------------------------- function isType( sequence name ) -- returns true if is a routine integer index -- check against builtin types if find( name, {"object", "atom", "integer", "sequence" } ) then return True end if -- is it a routine? index = findRoutine( name ) if index then -- is it a user defined type? if pUser[index][P_TYPE] = USER_TYPE then return True end if end if return False end function ----------------------------------------------------------------------------- function findVar( sequence name ) -- find where the variable is -- returns { scope, index } integer at, index for scope = ROUTINE to GLOBAL do at = findIndex( name, vList[scope] ) if at then -- get index index = vList[scope][at][2] -- return value return { scope, index } end if end for syntaxErr( "%s has not been declared (expected variable)", {name} ) if err_handled then err_handled = 0 return {} end if end function ----------------------------------------------------------------------------- function isVar( sequence name ) -- return true if exists integer at integer index for scope = ROUTINE to GLOBAL do at = findIndex( name, vList[scope] ) if at then -- get index index = vList[scope][at][2] -- save the value LAST_FOUND = { scope, index } return True end if end for return False end function ----------------------------------------------------------------------------- procedure createVar( integer scope, integer typeOf, sequence name ) -- create a variable. negative typeOf indicates a builtin type, -- otherwise it's the index of a user type integer index -- not a stack variable? if scope = ROUTINE then -- add to proc pUser[theProc][P_VARS] = append( pUser[theProc][P_VARS], name ) pUser[theProc][P_VTYPE] = append( pUser[theProc][P_VTYPE], typeOf ) -- index index = length( pUser[theProc][P_VARS] ) else -- create an uninitialized variable vValue = append( vValue, 0 ) vName = append( vName, name ) vType = append( vType, typeOf ) vInit = append( vInit, 0 ) -- get index index = length( vValue ) end if -- add to visible list vList[scope] = append( vList[scope], {name, index} ) -- LOOP INDEX BUG FIX FOR_LOOP_INDEX = length(vList[scope]) end procedure ----------------------------------------------------------------------------- procedure removeVar( sequence name ) -- remove a loop variable integer scope, index sequence info -- find the variable info = findVar( name ) scope = info[1] index = info[2] -- make it invisible vList[scope][FOR_LOOP_INDEX][1] = "" end procedure ----------------------------------------------------------------------------- function expr() -- forward reference -- parses expressions return call_func( exprRoutineId, {} ) end function ----------------------------------------------------------------------------- function parseArgs( sequence name, integer argCount ) -- parse arg list integer args sequence code require( "(" ) -- read the args args = 0 code = {} if not isWord( ")" ) then while TRUE do -- add an argument -- this makes a forward reference call to expr() code = append( code, expr() ) -- increment argument count args += 1 -- exit? if not isWord(",") then exit else require(",") end if end while end if require( ")" ) -- check arg count if args != argCount then syntaxErr( "%s takes %d arguments", {name, argCount} ) end if if err_handled then err_handled = 0 return {} end if return code end function ----------------------------------------------------------------------------- function subExpr() sequence code object a, b, c -- evaluate a single expression, return code if isWord( "(" ) then -- ( <expr> ) moveAhead() code = expr() require( ")" ) elsif isWord( "-" ) then -- - <expr> moveAhead() code = { NEGATE, subExpr() } elsif isWord( "+" ) then -- + <expr> moveAhead() code = subExpr() elsif isWord( "not" ) then -- not <expr> moveAhead() code = { NOT, subExpr() } elsif isWord( "{" ) then -- { <sequence> } moveAhead() code = {} -- need to read expression? if not isWord( "}" ) then -- loop until no more commas while True do -- check eof checkEOF() -- parse next expression code = append( code, expr() ) -- comma? if isWord( "," ) then moveAhead() else exit end if end while end if require( "}" ) -- empty sequence? if length( code ) = 0 then -- empty sequence code = { EUEMPTY } else -- sequence data code = { SEQ } & code end if elsif isNumber() or isWord(".") then -- decimal only if isWord(".") then moveAhead() -- get number after digit if not isNumber() then syntaxErr( "number not formed correctly", {} ) if err_handled then err_handled = 0 return {} end if end if a = "." & thisWord() moveAhead() else -- get the integer portion a = thisWord() moveAhead() -- decimal? if isWord( "." ) then -- move past digit moveAhead() -- anything past decimal point? if isNumber() then a = a & "." & thisWord() moveAhead() end if end if end if -- evaluate number a = value( a ) -- place value in code code = { DATA, a[2] } elsif isWord( "#" ) then -- parse hex word moveAhead() -- evaluate number a = value( "#" & thisWord() ) moveAhead() -- embed data code = { DATA, a[2] } elsif isChar() then -- get literal a = thisWord() -- embed data code = { DATA, a[2] } moveAhead() elsif isString() then -- remove quotes from string a = thisWord() a = a[2..length(a)-1] -- create code code = { DATA, a } moveAhead() elsif isVar( thisWord() ) then a = findVar( thisWord() ) moveAhead() -- allow slicing if isWord( "[" ) then -- indexed fetch if a[1] = ROUTINE then b = GET_INDEX_LOCAL else b = GET_INDEX_MODULE end if -- assignment to slices c = { SEQ } while True do -- opening paren require( "[" ) -- read an index c = append( c, expr() ) if isWord( ".." ) then -- set slice if a[1] = ROUTINE then b = GET_SLICE_LOCAL else b = GET_SLICE_MODULE end if moveAhead() -- read the end slice c = append( c, expr() ) -- better be end require("]") exit end if -- closing paren require("]") -- exit if no more indexes if not isWord( "[" ) then exit end if end while -- either GET_INDEX_xxx or GET_SLICE_xxx code = { b, a[2], c } else -- normal fetch if a[1] = ROUTINE then -- simple fetch code = { GET_LOCAL, a[2] } else code = { GET_MODULE, a[2] } end if end if elsif findRoutine( thisWord() ) then -- user defined function -- get the index a = findRoutine( thisWord() ) moveAhead() -- procedure? if pUser[a][P_TYPE] = PROC then -- error syntaxErr( "expected to see an expression, not a procedure", {} ) if err_handled then err_handled = 0 return {} end if end if -- append EUFUNC, index and arg list code = { USER_EUFUNC, a } & parseArgs( pUser[a][P_NAME], pUser[a][P_ARGS] ) elsif findIndex( thisWord(), builtin ) then -- builtin function -- this follows user-defined functions, so users can redefine code -- it's a builtin procedure a = FOUND_INDEX moveAhead() -- procedure? if builtin[a][P_TYPE] = PROC then -- error syntaxErr( "expected to see an expression, not a procedure", {} ) if err_handled then err_handled = 0 return {} end if end if -- append EUFUNC, index and arg list code = { EUFUNC, a } & parseArgs( builtin[a][P_NAME], builtin[a][P_ARGS] ) else -- no idea what it is syntaxErr( "%s has not been declared (expected expression)", {thisWord()} ) if err_handled then err_handled = 0 return {} end if end if return code end function ----------------------------------------------------------------------------- function binaryExpr_mul_div() -- * / have HIGHER precedence than + - & -- parse a operator expression sequence code,code2 integer operator code = subExpr() -- parse a*b*c as (a*b)*c & a/b/c as (a/b)/c & a/b*c as (a/b)*c etc while True do -- read expression if isWord( "*" ) then operator = MUL elsif isWord( "/" ) then operator = DIV else exit end if moveAhead() code2 = subExpr() code = { operator, code, code2 } end while return code end function ----------------------------------------------------------------------------- function binaryExpr_add_sub() -- parse a operator expression -- + - have HIGHER precedence than & sequence code,code2 integer operator code = binaryExpr_mul_div() -- parse a+b+c as (a+b)+c & a-b+c as (a-b)+c while True do -- read expression if isWord( "+" ) then operator = ADD elsif isWord( "-" ) then operator = SUB else exit end if moveAhead() code2 = binaryExpr_mul_div() code = { operator, code, code2 } end while return code end function ----------------------------------------------------------------------------- function binaryExpr() -- parse a operator expression -- & then has HIGHER precedence than the comparison operators, etc. sequence code code = binaryExpr_add_sub() -- read expression if isWord( "&" ) then moveAhead() code = { CONCAT, code, binaryExpr() } end if return code end function ----------------------------------------------------------------------------- function compExpr() -- parse a comparison operator expression sequence code,code2 integer operator code = binaryExpr() while True do -- read expression if isWord( "=" ) then operator = EQ elsif isWord( "!=" ) then operator = NE elsif isWord( ">" ) then operator = GT elsif isWord( ">=" ) then operator = GE elsif isWord( "<" ) then operator = LT elsif isWord( "<=" ) then operator = LE else exit end if moveAhead() code2 = binaryExpr() code = { operator, code, code2 } end while return code end function ----------------------------------------------------------------------------- function boolExpr() -- parse a logical expression sequence code code = compExpr() -- read expression if isWord("and") then moveAhead() if shortCircuitFlag then -- short-circuiting and code = { SHORT_AND, code, boolExpr() } else -- normal and code = { AND, code, boolExpr() } end if -- 'or' must be short-circuited in IF & WHILE elsif isWord("or") then moveAhead() if shortCircuitFlag then -- short-circuiting and code = { SHORT_OR, code, boolExpr() } else -- normal or code = { OR, code, boolExpr() } end if elsif isWord("xor") then moveAhead() code = { XOR, code, boolExpr() } end if return code end function ----------------------------------------------------------------------------- -- resolve forward reference exprRoutineId = routine_id( "boolExpr" ) ----------------------------------------------------------------------------- procedure procArgList() -- parse an arg list for a new procedure object typeOf sequence name require( "(" ) if not isWord( ")" ) then while True do -- get the type if isWord( "object" ) then typeOf = OBJECT elsif isWord( "atom" ) then typeOf = ATOM elsif isWord( "integer" ) then typeOf = INTEGER elsif isWord( "sequence" ) then typeOf = SEQUENCE else -- user defined type typeOf = findRoutine( thisWord() ) end if moveAhead() -- get the name name = thisWord() moveAhead() -- add to the variable list createVar( ROUTINE, typeOf, name ) -- update the proc pUser[theProc][P_ARGS] += 1 -- comma? if not isWord( "," ) then exit end if -- read past comma moveAhead() end while end if require( ")" ) end procedure ----------------------------------------------------------------------------- function parseBlock() -- read block of code until "end" is encountered sequence code object parsed -- accumulated code code = {} -- read until block end marker: end, elsif or else while not isWord( "end" ) and not isWord( "elsif" ) and not isWord( "else" ) do -- check for end of file checkEOF() -- parse the code; forward reference to parse() parsed = call_func( parseRoutineId, {} ) if atom(parsed) then return {{NO_OP}} end if -- code generated? if length( parsed ) then code = append( code, parsed ) end if end while -- have to put something in block if length( code ) = 0 then code = { { NO_OP } } end if return code end function ----------------------------------------------------------------------------- -- used to find a variable with a given scope(s) function findVar_Scope( sequence name , integer scope1, integer scope2) -- find where the variable is -- returns { scope, index } integer at, index for scope = scope1 to scope2 do at = findIndex( name, vList[scope] ) if at then -- get index index = vList[scope][at][2] -- save the value LAST_FOUND = { scope, index } return True end if end for return False end function ----------------------------------------------------------------------------- -- New ... made the parsing of types into a separate routine function parse_found_type(boolean builtin_type) object a, b sequence code -- elsif isType( thisWord() ) then -- scope if theProc then a = ROUTINE elsif globalFlag then a = GLOBAL else a = MODULE end if -- data type if builtin_type then if isCurWord( "object" ) then b = OBJECT elsif isCurWord( "atom" ) then b = ATOM elsif isCurWord( "integer" ) then b = INTEGER elsif isCurWord( "sequence" ) then b = SEQUENCE end if else -- get index of user type b = FOUND_INDEX end if moveAhead() createVar( a, b, thisWord() ) moveAhead() -- read comma delimited list while isWord( "," ) do -- move past comma moveAhead() -- create a variable createVar( a, b, thisWord() ) moveAhead() end while -- no code generated code = {} -- clear flag globalFlag = 0 return code end function ----------------------------------------------------------------------------- function parse_found_variable(integer sourceLine) object a, b, c, d sequence code -- assignment to variable a = LAST_FOUND -- a = findVar( thisWord() ) - DG17 moveAhead() -- allow slicing if isWord( "[" ) then -- indexed assignment if a[1] = ROUTINE then b = SET_INDEX_LOCAL else b = SET_INDEX_MODULE end if -- assignment to slices c = { SEQ } while True do -- opening paren require( "[" ) -- read an index c = append( c, expr() ) if isWord( ".." ) then -- set slice if a[1] = ROUTINE then b = SET_SLICE_LOCAL else b = SET_SLICE_MODULE end if moveAhead() -- read the end slice c = append( c, expr() ) -- better be end require("]") exit end if -- closing paren require("]") -- exit if no more indexes if not isWord( "[" ) then exit end if end while else -- normal assignment if a[1] = ROUTINE then b = SET_LOCAL else b = SET_MODULE end if end if -- evaluate the operator if isWord("=" ) then d = EQ elsif isWord("+=" ) then d = ADD elsif isWord("-=" ) then d = SUB elsif isWord("*=" ) then d = MUL elsif isWord("/=" ) then d = DIV elsif isWord("&=" ) then d = CONCAT else syntaxErr( "expected to see =, +=, -=, *=, /= or &=", {} ) if err_handled then err_handled = 0 return {} end if end if moveAhead() if b = SET_LOCAL or b = SET_MODULE then -- simple assignment code = { b, sourceLine, d, a[2], expr() } else -- either SET_INDEX_xxx or SET_SLICE_xxx code = { b, sourceLine, d, a[2], c, expr() } end if return code end function ----------------------------------------------------------------------------- function parse_found_routine(integer sourceLine) object a sequence code -- user defined routine -- get routine index a = FOUND_INDEX -- a = findRoutine( thisWord() ) - DG17 moveAhead() -- function? if pUser[a][P_TYPE] = EUFUNC then -- error syntaxErr( "function result must be assigned or used", {} ) if err_handled then err_handled = 0 return {} end if end if -- append PROC, index and arg list code = { USER_PROC, sourceLine, a } & parseArgs( pUser[a][P_NAME], pUser[a][P_ARGS] ) return code end function ----------------------------------------------------------------------------- function parse() integer sourceLine object a, b, c, d, e sequence code integer save_for_index code = {} -- what source line are we on? sourceLine = length( source ) currentWord = thisWord() if isCurWord( "global" ) then -- turn on global flag globalFlag = 1 moveAhead() currentWord = thisWord() -- take note of the NEXT word -- make sure followed by legal word if not isCurWord( "constant" ) and not isCurWord( "procedure" ) and not isCurWord( "type" ) and not isCurWord( "function" ) and not isType( currentWord ) then syntaxErr( "a global must be followed by a constant, " & "procedure, type or function", {} ) if err_handled then err_handled = 0 moveAhead() return 0 end if end if -- no code code = {} elsif isCurWord( "procedure" ) or isCurWord( "function" ) or isCurWord( "type" ) then -- compile a procedure or a function -- is it a procedure or a function? if isCurWord("procedure") then a = PROC elsif isCurWord("function") then a = EUFUNC else a = USER_TYPE end if -- move past keyword moveAhead() -- create an empty procedure -- pUser = append( pUser, repeat( 0, 6 ) ) -- introduce slot 7 for the 'routine's fileindex' pUser = append( pUser, repeat( 0, 7 ) ) theProc = length( pUser ) -- initial values pUser[theProc][P_NAME] = thisWord() pUser[theProc][P_TYPE] = a pUser[theProc][P_ARGS] = 0 pUser[theProc][P_VARS] = {} pUser[theProc][P_VTYPE] = {} pUser[theProc][P_CODE] = {} -- attach the fileIndex for usage by 'routine_id_' pUser[theProc][P_FILEINDEX] = fileIndex -- what's the scope? if globalFlag then b = GLOBAL else b = MODULE end if -- add the proc name and index to list pVisible[b] = append( pVisible[b], { thisWord(), theProc } ) moveAhead() -- process the arg list procArgList() -- type only has 1 arg if a = USER_TYPE and pUser[theProc][P_ARGS] != 1 then syntaxErr( "types must have exactly one parameter", {} ) end if if err_handled then err_handled = 0 moveAhead() return 0 end if -- read the code code = parseBlock() -- end procedure/function require( "end" ) if a = PROC then require( "procedure" ) elsif a = EUFUNC then require( "function" ) else require( "type" ) end if -- store code pUser[theProc][P_CODE] = code -- clear flags theProc = 0 code = {} -- clear flag globalFlag = 0 -- destroy all local variables vList[ROUTINE] = {} -- check against builtin types elsif find( currentWord, {"object", "atom", "integer", "sequence" } ) then code = parse_found_type(True) -- parse the type elsif isCurWord( "constant" ) then -- build code to initialize constants -- { SET_CONSTANT, line, <index1>, <expr1>, <index2>, <expr2> ... } moveAhead() -- what's the scope? if globalFlag then -- global constants a = GLOBAL else -- module level constants a = MODULE end if -- set code code = { SET_CONSTANT, sourceLine } while True do -- read the constant name b = thisWord() moveAhead() -- create it - pass scope, type and name createVar( a, CONSTANT, b ) require( "=" ) -- add to code code = code & { findVar( b ), expr() } -- comma follows? if not isWord( "," ) then -- all done exit else -- move past moveAhead() end if end while -- clear flag globalFlag = 0 elsif isCurWord( "exit" ) then -- exit -- { EXIT, line } moveAhead() code = { EXIT, sourceLine } elsif isCurWord( "return" ) then -- return -- { RETURN_EUFUNC, line, expr } -- { RETURN_PROC, line } moveAhead() -- in a procedure or function? if theProc = 0 then syntaxErr( "return must be inside a procedure or function", {} ) if err_handled then err_handled = 0 moveAhead() return 0 end if end if -- function or procedure if pUser[theProc][P_TYPE] = PROC then code = { RETURN_PROC, sourceLine } else -- function returns a value code = { RETURN_EUFUNC, sourceLine, expr() } end if elsif isCurWord( "with" ) or isCurWord( "without" ) then -- on or off? a = isCurWord( "with" ) moveAhead() currentWord = thisWord() -- take note of the next word -- this is simply ignored if isCurWord( "profile" ) or isCurWord( "profile_time" ) or isCurWord( "warning" ) or isCurWord( "trace" ) or isCurWord( "type_check" ) or isNumber() then -- ignore code = {} else -- error syntaxErr( "unknown with/without option", {} ) if err_handled then err_handled = 0 moveAhead() return 0 end if end if -- move past option moveAhead() elsif isCurWord( "?" ) then -- print statement -- this is an exception to the rule moveAhead() -- find the index of the print statement a = findIndex( "?", builtin ) code = {} -- compile a call to "?" code = { PROC, sourceLine, a, expr() } elsif isCurWord( "if" ) then -- if statement -- { IF, test1, line1, block1, test2, line2, block2 ... } moveAhead() -- activate short-circuit flag shortCircuitFlag = 1 -- when testing 'lw.ex 1.5' set to 0 -- read the expression a = expr() require( "then" ) -- deactivate short-circuit flag shortCircuitFlag = 0 -- start of if clause code = { IF } while True do -- code to execute b = parseBlock() -- append test and code to execute code = code & { a, sourceLine, b } -- elsif if isWord("elsif") then -- next clause sourceLine = length( source ) moveAhead() -- activate short-circuit flag shortCircuitFlag = 1 -- when testing 'lw.ex 1.5' set to 0 -- read the expression a = expr() require("then") -- deactivate short-circuit flag shortCircuitFlag = 0 -- else elsif isWord("else") then -- last clause sourceLine = length( source ) moveAhead() -- true forces execution code = code & { {TRUE}, sourceLine, parseBlock() } -- exit exit -- end if elsif isWord("end") then exit else -- non-euphoria error syntaxErr( "expected elsif, else, or end if", {} ) if err_handled then err_handled = 0 moveAhead() return 0 end if end if end while require("end") require("if") elsif isCurWord( "while" ) then -- while loop -- { WHILE, sourceLine, test, instr1, instr2 ... } moveAhead() -- activate short-circuit flag shortCircuitFlag = 1 -- read the expression a = expr() require("do") -- deactivate short-circuit flag shortCircuitFlag = 0 -- read the block b = parseBlock() require( "end" ) require( "while" ) -- build code code = { WHILE, sourceLine, a, b } elsif isCurWord( "for" ) then -- for loop -- { FOR, line, var, start, end, step, block } moveAhead() -- read the variable a = thisWord() -- is this in a routine? if theProc then -- create with routine createVar( ROUTINE, ATOM, a ) else -- create with module createVar( MODULE, ATOM, a ) end if moveAhead() require( "=" ) -- read the start value b = expr() -- read the end value require( "to" ) c = expr() -- step? if isWord( "by" ) then -- read step moveAhead() d = expr() else -- default step value d = { DATA, 1 } end if -- save the value of 'FOR_LOOP_INDEX' since the block that is -- about to be parsed may contain FOR LOOPs i.e. nested FOR loops save_for_index = FOR_LOOP_INDEX -- accumulated code require( "do" ) e = parseBlock() require( "end" ) require( "for" ) -- build code code = { FOR, sourceLine, findVar(a), b, c, d, e } -- restore FOR_LOOP_INDEX for this current FOR LOOP -- which will ensure that the corres. FOR LOOP variable -- is correctly removed FOR_LOOP_INDEX = save_for_index removeVar( a ) -- NOW determine whether var, constant, type, or routine -- this is checked BEFORE the user defined routines, so -- the user can re-define routines -- 1) Firstly, check if it is a ROUTINE or MODULE VARIABLE -- i.e. defined within a Current ROUTINE or defined within the -- Current MODULE/FILE elsif findVar_Scope(currentWord, ROUTINE, MODULE) then code = parse_found_variable(sourceLine) -- YES - parse it -- 2) check if it is a proc/func/type within the Current ROUTINE or -- defined GLOBALLY elsif findRoutine(currentWord) then -- is it a user-type or func/proc? if pUser[FOUND_INDEX][P_TYPE] = USER_TYPE then code = parse_found_type(False) -- parse the User Type else -- it is a user defined routine - parse it code = parse_found_routine(sourceLine) end if -- 3) check if it is a GLOBALLY defined variable elsif findVar_Scope(currentWord, GLOBAL, GLOBAL) then code = parse_found_variable(sourceLine) -- YES - parse it -- otherwise check for builtin! elsif findIndex( currentWord, builtin ) then -- builtin routine -- this is checked after the user defined routines, so -- the user can re-define routines -- it's a builtin a = FOUND_INDEX -- a = findIndex( thisWord(), builtin ) - DG17 moveAhead() -- function? if builtin[a][P_TYPE] = EUFUNC then -- error syntaxErr( "function result must be assigned or used", {} ) if err_handled then err_handled = 0 moveAhead() return 0 end if end if -- append PROC, index and arg list code = { PROC, sourceLine, a } & parseArgs( builtin[a][P_NAME], builtin[a][P_ARGS] ) else syntaxErr( "%s has not been declared (expected statement)", {thisWord()} ) if err_handled then err_handled = 0 moveAhead() return 0 end if end if return code end function ----------------------------------------------------------------------------- -- resolve forward reference to parse() parseRoutineId = routine_id("parse") ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- The Run Time Portion -- -- sequence opCode, opName opCode = repeat( -1, 100 ) opName = repeat( "", 100 ) integer trace_file trace_file = open( "trace.err", "w" ) ----------------------------------------------------------------------------- procedure traceLine( sequence s ) -- trace a line of code integer index, key sequence at, line CURRENT_LINE_INDEX = s[2] -- current sourceline's index if not traceFlag then return end if -- greater than trace depth? if length( traceStack ) > traceDepth then -- don't display return end if -- save position at = get_position() -- trace stack position( 1, 1 ) puts( 1, repeat( ' ', 80 ) ) position( 1, 1 ) for i = 1 to length( traceStack ) do puts( 1, pUser[traceStack[i]][P_NAME] & " " ) end for -- will it show without moving the line? if s[2] < topTraceLine or s[2] > topTraceLine + TRACE_LINES-2 then topTraceLine = s[2] end if -- display for i = 1 to TRACE_LINES-1 do -- line to display index = topTraceLine + i - 1 -- position cursor position( i+1, 1 ) -- is this a real line? if index > 0 and index <= length( source ) then line = source[index] & repeat( ' ', 80 ) line = line[1..70] if index = s[2] then -- draw with arrow printf( 1, "%3d==> %s", {line[1], line[3..length(line)]} ) else -- normal line printf( 1, "%3d: %s", {line[1], line[3..length(line)]} ) end if else -- blank line puts( 1, repeat( ' ', 80 ) ) end if end for -- wait for a key key = wait_key() -- key = 13 -- escape? if key = 27 or key = '!' then -- abort runErr( "user pressed exit key", {} ) elsif key = 13 then -- allow nesting traceDepth = 9999 elsif key = 'q' then -- cancel trace traceFlag = 0 else -- set trace depth to current depth traceDepth = length( traceStack ) end if -- return to prior position position( at[1], at[2] ) end procedure ----------------------------------------------------------------------------- function opFunc( sequence code ) -- evaluate an expression if not length(code) then return code end if debug( "func opcode %d [%s]", {code[1],opName[code[1]]} ) return call_func( opCode[code[1]], {code} ) end function ----------------------------------------------------------------------------- procedure opProc( sequence code ) -- evaluate an expression debug( "proc opcode %d [%s]", {code[1],opName[code[1]]} ) call_proc( opCode[code[1]], {code} ) end procedure procedure proc_( sequence s ) -- run a built-in procedure -- { PROC, line, proc, arg1, arg2 ... } integer proc sequence args -- trace traceLine( s ) proc = s[3] args = s[4..length(s)] debug( "proc calling %s", {builtin[proc][P_NAME]} ) -- evaluate the arguments for i = 1 to length( args ) do args[i] = opFunc( args[i] ) end for -- run the proc call_proc( builtin[proc][P_CODE], args ) end procedure ----------------------------------------------------------------------------- function func_( sequence s ) -- run a built-in function -- { EUFUNC, function, arg1, arg2 ... } integer proc sequence args proc = s[2] args = s[3..length(s)] debug( "func calling %s", {builtin[proc][P_NAME]} ) -- evaluate the arguments for i = 1 to length( args ) do args[i] = opFunc( args[i] ) end for return call_func( builtin[proc][P_CODE], args ) end function ----------------------------------------------------------------------------- procedure checkType( integer procIndex, integer varIndex, object val ) -- type check a value -- procIndex of 0 = module level integer failed, typeOf sequence name if not typeCheckFlag then return end if -- get type from variable if procIndex = 0 then -- get from local typeOf = vType[ varIndex ] else -- get from procedure typeOf = pUser[procIndex][P_VTYPE][varIndex] end if -- check type if typeOf = OBJECT then failed = 0 elsif typeOf = ATOM then failed = not atom( val ) elsif typeOf = INTEGER then failed = not integer( val ) elsif typeOf = SEQUENCE then failed = not sequence( val ) elsif typeOf = CONSTANT then -- non-euphoria error message runErr( "attempt to assign value to a constant", {} ) else -- synthesize a call to the user function failed = not opFunc( { USER_EUFUNC, typeOf, { DATA, val } } ) end if if failed then -- get type from variable if procIndex then -- get name from procedure locals name = pUser[procIndex][P_VARS][varIndex] else -- get name from module name = vName[varIndex] end if runErr( "type_check error, %s is %s", {name, makePrintable(val)} ) end if end procedure ----------------------------------------------------------------------------- procedure user_proc_( sequence s ) -- run a user defined procedure -- { USER_PROC, line, proc, arg1, arg2 ... } -- { USER_EUFUNC, func, arg1, arg2 ... } integer priorProc, vars, theProc sequence args, priorVals, priorInits, code -- don't trace USER_EUFUNC, it doesn't have a trace line if s[1] = USER_PROC then -- trace traceLine( s ) -- get proc index theProc = s[3] -- get args args = s[4..length(s)] debug( "user proc %s", {pUser[theProc][P_NAME]} ) else -- get proc index theProc = s[2] -- get args args = s[3..length(s)] debug( "user func %s", {pUser[theProc][P_NAME]} ) end if -- add to trace stack traceStack = append( traceStack, theProc ) -- evaluate the arguments -- this is first, because the arguments could reference -- variables from the modules. for i = 1 to length( args ) do -- assign local value args[i] = opFunc( args[i] ) -- type check -- added type checking for 'argument' assignment checkType( theProc, i, args[i] ) end for -- store prior data priorProc = runProc priorVals = uValue priorInits = uInit -- new proc runProc = theProc -- create space vars = length( pUser[runProc][P_VARS] ) uValue = repeat( 0, vars+1 ) uInit = repeat( 0, vars ) -- move the args uValue[1..length(args)] = args uInit[1..length(args)] = 1 returnFlag = 0 -- run the code code = pUser[runProc][P_CODE] for i = 1 to length( code ) do -- run the code opProc( code[i] ) -- exit? if returnFlag then -- exit returnFlag = 0 exit end if end for -- restore runProc = priorProc uValue = priorVals uInit = priorInits -- pop trace stack if length(traceStack) then traceStack = traceStack[1..length(traceStack)-1] end if end procedure ----------------------------------------------------------------------------- function user_func_( sequence s ) -- user defined function -- { USER_EUFUNC, function, arg1, arg2 ... } -- run as if it were a procedure user_proc_( s ) if returnInit = 0 then runErr( "no value returned from %s", {pUser[s[2]][P_NAME]} ) end if -- clear init returnInit = 0 -- return value return euReturnValue end function global procedure euProc( sequence proc, sequence params ) integer proc_id proc_id = findRoutine( proc ) user_proc_( { USER_PROC, 0, proc_id } & params) --opProc( { proc_id, params } ) end procedure --euproc = routine_id( "euProc" ) global function euFunc( sequence func, sequence params ) integer func_id func_id = findRoutine( func ) return user_func_( { USER_EUFUNC, func_id} & params ) end function --eufunc = routine_id( "eufunc" ) ----------------------------------------------------------------------------- function get_local_( sequence s ) -- get a variable -- { GET_LOCAL, index } integer index -- get the index index = s[2] if uInit[ index ] != 0 then -- return value return uValue[ index ] end if -- not initialized runErr( "variable %s has not been assigned", {pUser[runProc][P_VARS][index]} ) end function ----------------------------------------------------------------------------- function get_module_( sequence s ) -- get a variable -- { GET, index } integer index -- get the index index = s[2] if vInit[ index ] != 0 then -- return value return vValue[ index ] end if -- not initialized runErr( "variable %s has not been assigned", {vName[index]} ) return -1 end function ----------------------------------------------------------------------------- procedure set_local_( sequence s ) -- set a local variable -- { SET_LOCAL, line, op, index, expression } integer op, index -- trace traceLine( s ) -- get the scope and index op = s[3] index = s[4] -- not initialized? if op != EQ and uInit[index] = 0 then -- not initialized runErr( "variable %s has not been assigned", {pUser[runProc][P_VARS][index]} ) end if -- should add type checking... if op = EQ then uValue[ index ] = opFunc( s[5] ) elsif op = ADD then uValue[ index ] += opFunc( s[5] ) elsif op = SUB then uValue[ index ] -= opFunc( s[5] ) elsif op = MUL then uValue[ index ] *= opFunc( s[5] ) elsif op = DIV then uValue[ index ] /= opFunc( s[5] ) elsif op = CONCAT then uValue[ index ] &= opFunc( s[5] ) end if -- added type checking for LOCAL assignment checkType( runProc, index, uValue[ index ] ) -- set initialized flag uInit[ index ] = 1 end procedure ----------------------------------------------------------------------------- procedure set_module_( sequence s ) -- set a module variable -- { SET_MODULE, line, op, index, expression } integer op, index -- trace traceLine( s ) -- get the scope and index op = s[3] index = s[4] -- not initialized? if op != EQ and vInit[index] = 0 then -- not initialized runErr( "variable %s has not been assigned", {vName[index]} ) end if -- should add type checking... if op = EQ then vValue[ index ] = opFunc( s[5] ) elsif op = ADD then vValue[ index ] += opFunc( s[5] ) elsif op = SUB then vValue[ index ] -= opFunc( s[5] ) elsif op = MUL then vValue[ index ] *= opFunc( s[5] ) elsif op = DIV then vValue[ index ] /= opFunc( s[5] ) elsif op = CONCAT then vValue[ index ] &= opFunc( s[5] ) end if -- added type checking for MODULE assignment checkType( 0, index, vValue[ index ] ) -- store global and mark vInit[ index ] = 1 end procedure ----------------------------------------------------------------------------- procedure checkIndex( integer index, object o ) -- make sure index is in range -- not a sequence if not sequence( o ) then -- error runErr( "attempt to subscript an atom (reading from it)", {} ) end if -- out of range if index < 0 or index > length( o ) then runErr( "subscript value of %d is out of bounds, " & "reading from sequence of length %d\n%s", {index, length(o), makePrintable( o ) } ) end if end procedure ----------------------------------------------------------------------------- procedure checkSlice( integer i1, integer i2, object o ) -- make sure a slice is good -- not a sequence? if not sequence( o ) then -- error runErr( "attempt to subscript an atom (reading from it)", {} ) end if if i1 < 1 then runErr( "slice lower index is less that 1 (%d)", {i1} ) elsif i1 > length( o ) and i2 > i1 then runErr( "slice starts past end of sequence (%d > %d)", {i1,length(o)} ) elsif i1 > i2 and i1-i2 != 1 then runErr("slice length is less than 0 (%d)", {i2-i1+1}) elsif i2 > length(o) then runErr("slice ends past end of sequence (%d > %d)", {i2,length(o)}) end if end procedure ----------------------------------------------------------------------------- function changeIndex( object s, sequence indexes, object val, integer op, integer thisIndex ) integer index if thisIndex <= length( indexes ) then -- get current index -- FLOOR it because INDEXES can be decimal e.g. 1.5 -- index = indexes[thisIndex] index = floor(indexes[thisIndex]) -- check range checkIndex( index, s ) -- recurse s[index] = changeIndex( s[index], indexes, val, op, thisIndex+1 ) else -- set value if op = EQ then return val elsif op = ADD then return s + val elsif op = SUB then return s - val elsif op = MUL then return s * val elsif op = DIV then return s / val elsif op = CONCAT then return s & val end if end if return s end function ----------------------------------------------------------------------------- function get_index_local_( sequence s ) -- get a value from a local variable -- { GET_INDEX_LOCAL, index, list of indexes } integer index, j sequence indexes object expr -- evaluate index = s[2] indexes = opFunc( s[3] ) -- not initialized? if uInit[index] = 0 then runErr( "variable %s has not been assigned", {pUser[runProc][P_VARS][index]} ) end if -- get value expr = uValue[index] -- extract value for i = 1 to length( indexes ) do -- get index j = indexes[i] -- check range checkIndex( j, expr ) -- get indexed expr = expr[ j ] end for return expr end function ----------------------------------------------------------------------------- function get_index_module_( sequence s ) -- get a value from a local variable -- { GET_INDEX_MODULE, index, list of indexes } integer index, j sequence indexes object expr -- evaluate index = s[2] indexes = opFunc( s[3] ) -- not initialized? if vInit[index] = 0 then runErr( "variable %s has not been assigned", {vName[index]} ) end if -- get value expr = vValue[index] -- extract value for i = 1 to length( indexes ) do -- get index j = indexes[i] -- check range checkIndex( j, expr ) -- get indexed expr = expr[ j ] end for return expr end function ----------------------------------------------------------------------------- procedure set_index_local_( sequence s ) -- set an index in a sequence variable -- { SET_INDEX_LOCAL, sourceLine, op, index, list of indexes, value } integer index, op sequence indexes object expr -- trace -- e.g. loc[1]=routine_id(...) traceLine( s ) -- evaluate op = s[3] index = s[4] indexes = opFunc( s[5] ) expr = opFunc( s[6] ) -- not initialized? if op != EQ and uInit[index] = 0 then runErr( "variable %s has not been assigned", {pUser[runProc][P_VARS][index]} ) end if -- set value and mark as initialized uValue[ index ] = changeIndex( uValue[ index ], indexes, expr, op, 1 ) uInit[ index ] = 1 end procedure ----------------------------------------------------------------------------- procedure set_index_module_( sequence s ) -- set an index in a sequence variable -- { SET_, sourceLine, op, index, list of indexes, value } integer index, op sequence indexes object expr -- trace -- e.g. mod[1]=routine_id(...) traceLine( s ) -- evaluate op = s[3] index = s[4] indexes = opFunc( s[5] ) expr = opFunc( s[6] ) -- not initialized? if op != EQ and vInit[index] = 0 then runErr( "variable %s has not been assigned", {vName[index]} ) end if -- set value and mark as initialized vValue[ index ] = changeIndex( vValue[ index ], indexes, expr, op, 1 ) vInit[ index ] = 1 end procedure ----------------------------------------------------------------------------- function changeSlice( object o, sequence indexes, object val, integer op ) integer i1, i2 -- get first index i1 = indexes[1] if length( indexes ) > 2 then -- check range checkIndex( i1, o ) -- recurse o[i1] = changeSlice( o[i1], indexes[2..length(indexes)], val, op ) else -- get second index i2 = indexes[2] -- check range checkSlice( i1, i2, o ) -- set value if op = EQ then o[i1..i2] = val elsif op = ADD then o[i1..i2] += val elsif op = SUB then o[i1..i2] -= val elsif op = MUL then o[i1..i2] *= val elsif op = DIV then o[i1..i2] /= val elsif op = CONCAT then o[i1..i2] &= val end if end if return o end function ----------------------------------------------------------------------------- function get_slice_local_( sequence s ) -- get a slice from a local -- slice can be indexed, for example: s[1][2..3] --> {1,2,3} -- { GET_SLICE_LOCAL, index, list of indexes } integer index, j, i1, i2 sequence indexes object expr -- evaluate index = s[2] indexes = opFunc( s[3] ) -- not initialized? if uInit[index] = 0 then -- not initialized runErr( "variable %s has not been assigned", {pUser[runProc][P_VARS][index]} ) end if -- expression expr = uValue[index] -- index into for i = 1 to length( indexes ) - 2 do -- get index j = indexes[i] -- check range checkIndex( j, expr ) -- index into expr = expr[j] end for -- slice range i1 = indexes[length(indexes)-1] i2 = indexes[length(indexes)] -- check slice checkSlice( i1, i2, expr ) -- return slice return expr[i1..i2] end function ----------------------------------------------------------------------------- function get_slice_module_( sequence s ) -- get a slice from a local -- slice can be indexed, for example: s[1][2..3] --> {1,2,3} -- { GET_SLICE_LOCAL, index, list of indexes } integer index, j, i1, i2 sequence indexes object expr -- evaluate index = s[2] indexes = opFunc( s[3] ) -- not initialized? if vInit[index] = 0 then -- not initialized runErr( "variable %s has not been assigned", {vName[index]} ) end if -- expression expr = vValue[index] -- index into for i = 1 to length( indexes ) - 2 do -- get index j = indexes[i] -- check range checkIndex( j, expr ) -- index into expr = expr[j] end for -- slice range i1 = indexes[length(indexes)-1] i2 = indexes[length(indexes)] -- check slice checkSlice( i1, i2, expr ) -- return slice return expr[i1..i2] end function ----------------------------------------------------------------------------- procedure set_slice_local_( sequence s ) -- set an index in a sequence variable -- this is slightly different than set_index; the slice value is in -- the last two values. for example, s[1][2..3] -> {1,2,3} -- { SET_SLICE_LOCAL, sourceLine, op, index, list of indexes, value } integer index, op sequence indexes object expr -- trace -- e.g. loc[b..c]=routine_id(...) traceLine( s ) -- evaluate op = s[3] index = s[4] indexes = opFunc( s[5] ) expr = opFunc( s[6] ) -- not initialized? if op != EQ and uInit[index] = 0 then -- not initialized runErr( "variable %s has not been assigned", {pUser[runProc][P_VARS][index]} ) end if -- set value and mark as initialized uValue[ index ] = changeSlice( uValue[ index ], indexes, expr, op ) uInit[ index ] = 1 end procedure ----------------------------------------------------------------------------- procedure set_slice_module_( sequence s ) -- see set_slice_local for details -- { SET_SLICE_module, sourceLine, op, index, list of indexes, value } integer index, op sequence indexes object expr -- trace -- e.g. mod[b..c]=routine_id(...) traceLine( s ) -- evaluate op = s[3] index = s[4] indexes = opFunc( s[5] ) expr = opFunc( s[6] ) -- not initialized? if op != EQ and vInit[index] = 0 then -- not initialized runErr( "variable %s has not been assigned", {vName[index]} ) end if -- set value and mark as initialized vValue[ index ] = changeSlice( vValue[ index ], indexes, expr, op ) vInit[ index ] = 1 end procedure ----------------------------------------------------------------------------- procedure set_constant_( sequence s ) -- set a constant -- { SET_CONSTANT, line, var1, expr1, var2, expr2 ... } integer index -- trace traceLine( s ) -- assign values to each constant for i = 3 to length( s ) by 2 do -- get the index index = s[i][2] -- evaluate, and store constant in module vValue[ index ] = opFunc( s[i+1] ) vInit[ index ] = 1 end for end procedure ----------------------------------------------------------------------------- procedure no_op_( sequence s ) -- do nothing -- { NO_OP } end procedure ----------------------------------------------------------------------------- function true_( sequence s ) -- return true, used in ELSE clauses -- { TRUE } return True end function ----------------------------------------------------------------------------- procedure return_proc_( sequence s ) -- return from a procedure -- { RETURN_PROC, line } -- trace traceLine( s ) -- set the return flag returnFlag = 1 end procedure ----------------------------------------------------------------------------- procedure return_func_( sequence s ) -- return from a function with a value -- { RETURN_EUFUNC, line, expr } -- trace traceLine( s ) -- evaluate expression euReturnValue = opFunc( s[3] ) -- flag a value is returned returnInit = 1 -- flag to exit loop returnFlag = 1 end procedure ----------------------------------------------------------------------------- procedure exit_( sequence s ) -- set exit flag -- { EXIT, line } -- trace traceLine( s ) -- set exit flag exitFlag = 1 end procedure ----------------------------------------------------------------------------- procedure if_( sequence s ) -- run if statement -- { IF, test1, line1, block1, test2, line2, block2 ... } sequence block -- examine each part of the if clause for i = 2 to length( s ) by 3 do -- trace, line information must be second element traceLine( s[i..i+1] ) -- get clause if opFunc( s[i] ) then -- run the block of code block = s[i+2] for j = 1 to length( block ) do -- execute it opProc( block[j] ) -- return or exit? if exitFlag or returnFlag then return end if end for -- exit the loop exit end if end for end procedure ----------------------------------------------------------------------------- procedure while_( sequence s ) -- run if statement -- { WHILE, line, test, block } sequence block -- get the block block = s[4] -- trace traceLine( s ) -- while the test is true... while opFunc( s[3] ) do -- execute each instruction of the block for j = 1 to length( block ) do -- execute instruction opProc( block[j] ) -- exit? if exitFlag then -- clear flag exitFlag = 0 -- leave return -- return? elsif returnFlag then -- leave return end if end for -- trace traceLine( s ) end while end procedure ----------------------------------------------------------------------------- -- there appears to be a 'nested for loop' bug in Euphoria 2.1 -- Workaround: change the FOR loop into a WHILE loop procedure for_( sequence s ) -- run for loop -- { FOR, line, var, start, end, step, codeBlock } integer index, scope atom forStart, forEnd, forStep atom forI sequence block -- trace traceLine( s ) -- index is in form { scope, index } scope = s[3][1] index = s[3][2] -- loop range forStart = opFunc( s[4] ) forEnd = opFunc( s[5] ) forStep = opFunc( s[6] ) -- non-euphoria error message if forStep = 0 then runErr( "the BY value of this FOR loop is ZERO", {} ) end if -- get the block of code block = s[7] -- mark index as intialized if scope = ROUTINE then uInit[ index ] = 1 else vInit[ index ] = 1 end if -- for loop -- need to change into a WHILE loop forI = forStart while True do if (forStep>0 and forI>forEnd) or (forStep<0 and forI<forEnd) then exit -- terminate loop end if -- update index variable if scope = ROUTINE then -- store and mark as initialized uValue[ index ] = forI -- i else -- store and mark as initialized vValue[ index ] = forI -- i end if for j = 1 to length( block ) do -- run code opProc( block[j] ) -- return? if returnFlag then return end if -- exit? if exitFlag then exitFlag = 0 return end if end for -- trace traceLine( s ) -- increment 'i' forI += forStep -- end for end while end procedure ----------------------------------------------------------------------------- function add_( sequence s ) -- add two values -- { ADD, expr1, expr2 } debug( "add", {} ) return opFunc( s[2] ) + opFunc( s[3] ) end function ----------------------------------------------------------------------------- function sub_( sequence s ) -- subtract two values -- { SUB, expr1, expr2 } debug( "sub", {} ) return opFunc( s[2] ) - opFunc( s[3] ) end function ----------------------------------------------------------------------------- function mul_( sequence s ) -- multiply two values -- { MUL, expr1, expr2 } debug( "mul", {} ) return opFunc( s[2] ) * opFunc( s[3] ) end function ----------------------------------------------------------------------------- function div_( sequence s ) -- divide two values -- { DIV, expr1, expr2 } debug( "div", {} ) return opFunc( s[2] ) / opFunc( s[3] ) end function ----------------------------------------------------------------------------- function negate_( sequence s ) -- negate a value -- { NEGATE, expr } debug( "negate", {} ) return - opFunc( s[2] ) end function ----------------------------------------------------------------------------- function concat_( sequence s ) -- concatenate two values -- { CONCAT, expr1, expr2 } debug( "concat", {} ) return opFunc( s[2] ) & opFunc( s[3] ) end function ----------------------------------------------------------------------------- function not_( sequence s ) -- logical not expression -- { NOT, expr ) debug( "not", {} ) return not opFunc( s[2] ) end function ----------------------------------------------------------------------------- function and_( sequence s ) -- logical and two values -- { AND, expr1, expr2 } debug( "and", {} ) return opFunc( s[2] ) and opFunc( s[3] ) end function ----------------------------------------------------------------------------- function short_and_( sequence s ) -- logical and two values -- allow short-circuiting -- { SHORT_AND, expr1, expr2 } debug( "short_and", {} ) -- first expression true? if opFunc( s[2] ) then -- evaluate second return opFunc( s[3] ) else -- return false, skip second return False end if end function ----------------------------------------------------------------------------- function or_( sequence s ) -- logical or two values -- { OR, expr1, expr2 } debug( "or", {} ) return opFunc( s[2] ) or opFunc( s[3] ) end function ----------------------------------------------------------------------------- -- 'or' must be short-circuited in IF & WHILE function short_or_( sequence s ) -- logical or two values -- allow short-circuiting -- { SHORT_OR, expr1, expr2 } debug( "short_or", {} ) -- first expression true? if opFunc( s[2] ) then -- return true, skip second return True else -- evaluate second return opFunc( s[3] ) end if end function ----------------------------------------------------------------------------- function xor_( sequence s ) -- logical xor two values -- { XOR, expr1, expr2 } debug( "xor", {} ) return opFunc( s[2] ) xor opFunc( s[3] ) end function ----------------------------------------------------------------------------- function eq_( sequence s ) -- equal -- { EQ, expr1, expr2 } debug( "eq", {} ) return opFunc( s[2] ) = opFunc( s[3] ) end function ----------------------------------------------------------------------------- function ne_( sequence s ) -- not equal -- { NE, expr1, expr2 } debug( "ne", {} ) return opFunc( s[2] ) != opFunc( s[3] ) end function ----------------------------------------------------------------------------- function gt_( sequence s ) -- greater than -- { GT, expr1, expr2 } debug( "gt", {} ) return opFunc( s[2] ) > opFunc( s[3] ) end function ----------------------------------------------------------------------------- function ge_( sequence s ) -- greater or equal than -- { GE, expr1, expr2 } debug( "ge", {} ) return opFunc( s[2] ) >= opFunc( s[3] ) end function ----------------------------------------------------------------------------- function lt_( sequence s ) -- less than -- { LT, expr1, expr2 } debug( "lt", {} ) return opFunc( s[2] ) < opFunc( s[3] ) end function ----------------------------------------------------------------------------- function le_( sequence s ) -- less or equal than -- { LE, expr1, expr2 } debug( "le", {} ) return opFunc( s[2] ) <= opFunc( s[3] ) end function ----------------------------------------------------------------------------- function data_( sequence s ) -- return value -- { DATA, value } return s[2] end function ----------------------------------------------------------------------------- function seq_( sequence s ) -- evalute sequence of data -- { SEQ, item1, item2 ... } sequence seq debug( "seq", {} ) seq = repeat( 0, length(s)-1 ) for i = 1 to length( seq ) do -- replace each item with value seq[i] = opFunc( s[i+1] ) end for return seq end function ----------------------------------------------------------------------------- function empty_( sequence s ) -- empty sequence -- { EUEMPTY } debug( "empty", {} ) return {} end function ----------------------------------------------------------------------------- -- sequence functions -- seq_fetch from Jiri Babor -- mwl 12/12/00 ----------------------------------------------------------------------------- function seq_fetch(object a, sequence b) for i = 1 to length(b) do a = a[b[i]] end for return a end function function seq_store(object a, object b, object c) integer len len = length(c) if len > 1 then -- recursively go into the sequence return seq_store(a, b[c[1]], c[2..len] ) end if -- get the index c = c[1] if c then b[c] = a else b = a end if return b end function -- set opcodes -- procedures opCode[ EUFUNC ] = routine_id( "func_" ) opCode[ PROC ] = routine_id( "proc_" ) opCode[ RETURN_EUFUNC ] = routine_id( "return_func_" ) opCode[ RETURN_PROC ] = routine_id( "return_proc_" ) -- variables opCode[ GET_LOCAL ] = routine_id( "get_local_" ) opCode[ GET_MODULE ] = routine_id( "get_module_" ) opCode[ SET_LOCAL ] = routine_id( "set_local_" ) opCode[ SET_MODULE ] = routine_id( "set_module_" ) opCode[ GET_INDEX_LOCAL ] = routine_id( "get_index_local_" ) opCode[ GET_INDEX_MODULE ] = routine_id( "get_index_module_" ) opCode[ SET_INDEX_LOCAL ] = routine_id( "set_index_local_" ) opCode[ SET_INDEX_MODULE ] = routine_id( "set_index_module_" ) opCode[ GET_SLICE_LOCAL ] = routine_id( "get_slice_local_" ) opCode[ GET_SLICE_MODULE ] = routine_id( "get_slice_module_" ) opCode[ SET_SLICE_LOCAL ] = routine_id( "set_slice_local_" ) opCode[ SET_SLICE_MODULE ] = routine_id( "set_slice_module_" ) opCode[ SET_CONSTANT ] = routine_id( "set_constant_" ) -- statements opCode[ FOR ] = routine_id( "for_" ) opCode[ EXIT ] = routine_id( "exit_" ) opCode[ IF ] = routine_id( "if_" ) opCode[ WHILE ] = routine_id( "while_" ) opCode[ USER_PROC ] = routine_id( "user_proc_" ) opCode[ USER_EUFUNC ] = routine_id( "user_func_" ) -- opCode[ USER_TYPE ] = routine_id( "user_type" ) NOT DEFINED HENCE -1 opCode[ NO_OP ] = routine_id( "no_op_" ) opCode[ TRUE ] = routine_id( "true_" ) -- data operations opCode[ ADD ] = routine_id( "add_" ) opCode[ SUB ] = routine_id( "sub_" ) opCode[ MUL ] = routine_id( "mul_" ) opCode[ DIV ] = routine_id( "div_" ) opCode[ NEGATE ] = routine_id( "negate_" ) opCode[ CONCAT ] = routine_id( "concat_" ) opCode[ NOT ] = routine_id( "not_" ) opCode[ AND ] = routine_id( "and_" ) opCode[ SHORT_AND ] = routine_id( "short_and_" ) opCode[ OR ] = routine_id( "or_" ) opCode[ XOR ] = routine_id( "xor_" ) opCode[ EQ ] = routine_id( "eq_" ) opCode[ NE ] = routine_id( "ne_" ) opCode[ GT ] = routine_id( "gt_" ) opCode[ GE ] = routine_id( "ge_" ) opCode[ LT ] = routine_id( "lt_" ) opCode[ LE ] = routine_id( "le_" ) -- 'or' must be short-circuited in IF & WHILE opCode[ SHORT_OR ] = routine_id( "short_or_" ) -- embedded constants opCode[ DATA ] = routine_id( "data_" ) opCode[ SEQ ] = routine_id( "seq_" ) opCode[ EUEMPTY ] = routine_id( "empty_" ) ----------------------------------------------------------------------------- -- set opcode names for tracing -- procedures opName[ EUFUNC ] = "func" opName[ PROC ] = "proc" opName[ RETURN_EUFUNC ] = "return_func" opName[ RETURN_PROC ] = "return_proc" -- variables opName[ GET_LOCAL ] = "get_local" opName[ GET_MODULE ] = "get_module" opName[ SET_LOCAL ] = "set_local" opName[ SET_MODULE ] = "set_module" opName[ GET_INDEX_LOCAL ] = "get_index_local" opName[ GET_INDEX_MODULE ] = "get_index_module" opName[ SET_INDEX_LOCAL ] = "set_index_local" opName[ SET_INDEX_MODULE ] = "set_index_module" opName[ GET_SLICE_LOCAL ] = "get_slice_local" opName[ GET_SLICE_MODULE ] = "get_slice_module" opName[ SET_SLICE_LOCAL ] = "set_slice_local" opName[ SET_SLICE_MODULE ] = "set_slice_module" opName[ SET_CONSTANT ] = "set_constant" -- statements opName[ FOR ] = "for" opName[ EXIT ] = "exit" opName[ IF ] = "if" opName[ USER_PROC ] = "user_proc" opName[ USER_EUFUNC ] = "user_func" opName[ NO_OP ] = "no_op" opName[ TRUE ] = "true" -- data operations opName[ ADD ] = "add" opName[ SUB ] = "sub" opName[ MUL ] = "mul" opName[ DIV ] = "div" opName[ NEGATE ] = "negate" opName[ CONCAT ] = "concat" opName[ NOT ] = "not" opName[ AND ] = "and" opName[ OR ] = "or" opName[ XOR ] = "xor" opName[ EQ ] = "eq" opName[ NE ] = "ne" opName[ GT ] = "gt" opName[ GE ] = "ge" opName[ LT ] = "lt" opName[ LE ] = "le" -- embedded constants opName[ DATA ] = "data" opName[ SEQ ] = "seq" opName[ EUEMPTY ] = "empty" ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- wrappers for builtins ----------------------------------------------------------------------------- procedure qprint_( object o ) ? o end procedure ----------------------------------------------------------------------------- procedure abort_( integer i ) abort(i) end procedure ----------------------------------------------------------------------------- function and_bits_( object x1, object x2 ) return and_bits( x1, x2 ) end function ----------------------------------------------------------------------------- function append_( sequence s1, object x ) return append( s1, x ) end function ----------------------------------------------------------------------------- function arctan_( object x1 ) return arctan( x1 ) end function ----------------------------------------------------------------------------- function atom_( object x ) return atom( x ) end function ----------------------------------------------------------------------------- procedure call_( atom a ) call( a ) end procedure ----------------------------------------------------------------------------- function c_func_( integer i, sequence s ) return c_func( i, s ) end function ----------------------------------------------------------------------------- procedure c_proc_( integer i, sequence s ) c_proc( i, s ) end procedure ----------------------------------------------------------------------------- -- added to handle IDs in conjunction with 'routine_id_' function call_func_( integer i, sequence s ) -- 'id' has the routine's index with pUser if i < 0 then runErr( "invalid routine id", {} ) end if -- 'i' is equivalent to 'theProc' i.e. the routine's index within pUser -- check that it is indeed a 'function' if pUser[i][P_TYPE] = PROC then runErr( "no value returned from %s", {pUser[i][P_NAME]} ) end if -- since ALL the arguments have ALREADY been evaluated by 'func_' -- embed AS data for k = 1 to length(s) do s[k] = { DATA, s[k] } end for -- 'i' is equivalent to 'theProc' i.e. the routine's index within pUser -- therefore run as if it were a procedure WITHOUT a sourceline -- as a 'user function' would be defined -- { USER_EUFUNC, function, arg1, arg2 ... } -- append EUFUNC, index and arg list s = {USER_EUFUNC, i} & s return user_func_( s ) end function ----------------------------------------------------------------------------- procedure call_proc_( integer i, sequence s ) -- 'id' has the routine's index with pUser if i < 0 then runErr( "invalid routine id", {} ) end if -- 'i' is equivalent to 'theProc' i.e. the routine's index within pUser -- check that it is indeed a 'procedure' if pUser[i][P_TYPE] != PROC then runErr( "function result of %s must be assigned or used", {pUser[i][P_NAME]} ) end if -- since ALL the arguments have ALREADY been evaluated by 'proc_' -- embed AS data for k = 1 to length(s) do s[k] = { DATA, s[k] } end for -- 'i' is equivalent to 'theProc' i.e. the routine's index within pUser -- therefore run as if it were a procedure WITHOUT a sourceline -- as a 'user function' would be defined -- { USER_EUFUNC, function, arg1, arg2 ... } -- append EUFUNC, index and arg list s = {USER_EUFUNC, i} & s user_proc_( s ) end procedure ----------------------------------------------------------------------------- procedure clear_screen_() clear_screen() -- move below debugging position( TRACE_LINES+1, 1 ) end procedure ----------------------------------------------------------------------------- procedure close_( integer fn ) close( fn ) end procedure ----------------------------------------------------------------------------- function command_line_() return command_line() end function ----------------------------------------------------------------------------- function compare_( object x1, object x2 ) return compare( x1, x2 ) end function ----------------------------------------------------------------------------- function cos_( object x1 ) return cos( x1 ) end function ----------------------------------------------------------------------------- function date_() return date() end function ----------------------------------------------------------------------------- function equal_( object x1, object x2 ) return equal( x1, x2 ) end function ----------------------------------------------------------------------------- function find_( object x, sequence s ) return find( x, s ) end function ----------------------------------------------------------------------------- function floor_( object x1 ) return floor( x1 ) end function ----------------------------------------------------------------------------- function get_key_() return get_key() end function ----------------------------------------------------------------------------- function get_pixel_( sequence s ) return get_pixel( s ) end function ----------------------------------------------------------------------------- function getc_( integer fn ) return getc( fn ) end function ----------------------------------------------------------------------------- function getenv_( sequence s ) return getenv( s ) end function ----------------------------------------------------------------------------- function gets_( integer fn ) return gets( fn ) end function ----------------------------------------------------------------------------- function integer_( object x ) return integer( x ) end function ----------------------------------------------------------------------------- function length_( sequence s ) return length( s ) end function ----------------------------------------------------------------------------- function log_( object x1 ) return log( x1 ) end function ----------------------------------------------------------------------------- function machine_func_( atom a, object x ) return machine_func( a, x ) end function ----------------------------------------------------------------------------- procedure machine_proc_( atom a, object x ) machine_proc( a, x ) end procedure ----------------------------------------------------------------------------- function match_( sequence s1, sequence s2 ) return match( s1, s2 ) end function ----------------------------------------------------------------------------- procedure mem_copy_( atom a1, atom a2, integer i ) mem_copy( a1, a2, i ) end procedure ----------------------------------------------------------------------------- procedure mem_set_( atom a1, atom a2, integer i ) mem_set( a1, a2, i ) end procedure ----------------------------------------------------------------------------- function not_bits_( object x1 ) return not_bits( x1 ) end function ----------------------------------------------------------------------------- function object_( object x ) return object( x ) end function ----------------------------------------------------------------------------- function open_( sequence st1, sequence st2 ) return open( st1, st2 ) end function ----------------------------------------------------------------------------- function or_bits_( object x1, object x2 ) return or_bits( x1, x2 ) end function ----------------------------------------------------------------------------- function peek_( object a ) return peek( a ) end function ----------------------------------------------------------------------------- function peek4s_( object a ) return peek4s( a ) end function ----------------------------------------------------------------------------- function peek4u_( object a ) return peek4u( a ) end function ----------------------------------------------------------------------------- function platform_() return platform() end function ----------------------------------------------------------------------------- procedure pixel_( object x1, sequence s ) pixel( x1, s ) end procedure ----------------------------------------------------------------------------- procedure poke_( atom a, object x ) poke( a, x ) end procedure ----------------------------------------------------------------------------- procedure poke4_( atom a, object x ) poke4( a, x ) end procedure ----------------------------------------------------------------------------- procedure position_( integer i1, integer i2 ) -- position( i1, i2 ) -- move below debugging position( TRACE_LINES+i1, i2 ) end procedure ----------------------------------------------------------------------------- function power_( object x1, object x2 ) return power( x1, x2 ) end function ----------------------------------------------------------------------------- function prepend_( sequence s1, object x2 ) return prepend( s1, x2 ) end function ----------------------------------------------------------------------------- procedure print_( integer fn, object o ) print( fn, o ) end procedure ----------------------------------------------------------------------------- procedure printf_( integer fn, sequence st, object x ) printf( fn, st, x ) end procedure ----------------------------------------------------------------------------- procedure profile_( integer i ) profile( i ) end procedure ----------------------------------------------------------------------------- procedure puts_( integer fn, object x ) puts( fn, x ) end procedure ----------------------------------------------------------------------------- function rand_( object x1 ) return rand( x1 ) end function ----------------------------------------------------------------------------- function remainder_( object x1, object x2 ) return remainder( x1, x2 ) end function ----------------------------------------------------------------------------- function repeat_( object x, atom a ) return repeat( x, a ) end function ----------------------------------------------------------------------------- function routine_id_( sequence st ) object index atom current_fileindex -- is it a user defined routine? -- this routine, like the rest of the programs -- allows the 'builtins' to be redefined! -- search for solely the routines in the file where the 'routine_id' call -- is located i.e. in scope -- this will NOT be affected by the fact that the parser may have closed -- this file, because its 'fileindex' is recorded with the routine index = False current_fileindex = source[CURRENT_LINE_INDEX][2] -- LIFO ... from the most previous to the earliest ... -- please note: 'routines' are STACKED in the order that the -- PARSER FINDS THEM - DG for i = length(pUser) to 1 by -1 do if equal(pUser[i][P_NAME],st) and pUser[i][P_FILEINDEX] = current_fileindex then -- same file! index = i exit end if end for -- try GLOBAL -- note GLOBAL ROUTINES can be defined in any MODULE -- so 'fileIndex' is N/A here! if not index then -- is it a GLOBAL routine? index = findIndex(st, pVisible[GLOBAL]) if index then index = pVisible[GLOBAL][index][2] -- get the index end if end if if index then -- got the index -- user defined function/procedure return index -- return its ID that is 'theProc' index end if -- else routine does not exist -- its either 'builtin' or 'undefined' ... either way return -1 return -1 end function ----------------------------------------------------------------------------- function sequence_( object x ) return sequence( x ) end function ----------------------------------------------------------------------------- function sin_( object x1 ) return sin(x1) end function ----------------------------------------------------------------------------- function sprintf_( sequence st, object x ) return sprintf( st, x ) end function ----------------------------------------------------------------------------- function sqrt_( object x1 ) return sqrt(x1) end function ----------------------------------------------------------------------------- procedure system_( sequence st, integer i ) system(st,i) end procedure ----------------------------------------------------------------------------- function system_exec_( sequence st, integer i ) return system_exec(st,i) end function ----------------------------------------------------------------------------- function tan_( object x1 ) return tan(x1) end function ----------------------------------------------------------------------------- function time_() return time() end function ----------------------------------------------------------------------------- procedure trace_( integer i ) -- my trace routine traceFlag = i traceDepth = 9999 end procedure ----------------------------------------------------------------------------- function xor_bits_( object x1, object x2 ) return xor_bits( x1, x2 ) end function ----------------------------------------------------------------------------- -- assign builtins -- Non scriptible routines commented out...mwl 12/12/00 builtin = { { "?", PROC, 1, routine_id("qprint_") }, -- { "abort", PROC, 1, routine_id("abort_") }, -- { "and_bits", EUFUNC, 2, routine_id("and_bits_") }, -- { "append", EUFUNC, 2, routine_id("append_") }, -- { "arctan", EUFUNC, 1, routine_id("arctan_") }, -- { "atom", EUFUNC, 1, routine_id("atom_") }, -- { "call", PROC, 1, routine_id("call_") }, -- { "c_func", EUFUNC, 2, routine_id("c_func_") }, -- { "c_proc", PROC, 2, routine_id("c_proc_") }, -- { "call_func", EUFUNC, 2, routine_id("call_func_") }, -- { "call_proc", PROC, 2, routine_id("call_proc_") }, -- { "clear_screen", PROC, 0, routine_id("clear_screen_") }, -- { "close", PROC, 1, routine_id("close_") }, -- { "command_line", EUFUNC, 0, routine_id("command_line_") }, -- { "compare", EUFUNC, 2, routine_id("compare_") }, -- { "cos", EUFUNC, 1, routine_id("cos_") }, -- { "date", EUFUNC, 0, routine_id("date_") }, -- { "equal", EUFUNC, 2, routine_id("equal_") }, -- { "find", EUFUNC, 2, routine_id("find_") }, -- { "floor", EUFUNC, 1, routine_id("floor_") }, -- { "get_key", EUFUNC, 0, routine_id("get_key_") }, -- { "get_pixel", EUFUNC, 1, routine_id("get_pixel_") }, -- { "getc", EUFUNC, 1, routine_id("getc_") }, -- { "getenv", EUFUNC, 1, routine_id("getenv_") }, -- { "gets", EUFUNC, 1, routine_id("gets_") }, -- { "integer", EUFUNC, 1, routine_id("integer_") }, -- { "length", EUFUNC, 1, routine_id("length_") }, -- { "log", EUFUNC, 1, routine_id("log_") }, -- { "machine_func", EUFUNC, 2, routine_id("machine_func_") }, -- { "machine_proc", PROC, 2, routine_id("machine_proc_") }, -- { "match", EUFUNC, 2, routine_id("match_") }, -- { "mem_copy", PROC, 3, routine_id("mem_copy_") }, -- { "mem_set", PROC, 3, routine_id("mem_set_") }, -- { "not_bits", EUFUNC, 1, routine_id("not_bits_") }, -- { "object", EUFUNC, 1, routine_id("object_") }, -- { "open", EUFUNC, 2, routine_id("open_") }, -- { "or_bits", EUFUNC, 2, routine_id("or_bits_") }, -- { "peek", EUFUNC, 1, routine_id("peek_") }, -- { "peek4s", EUFUNC, 1, routine_id("peek4s_") }, -- { "peek4u", EUFUNC, 1, routine_id("peek4u_") }, -- -- NEW! dc { "platform", EUFUNC, 0, routine_id("platform_") }, { "pixel", PROC, 2, routine_id("pixel_") }, { "poke", PROC, 2, routine_id("poke_") }, -- { "poke4", PROC, 2, routine_id("poke4_") }, -- { "position", PROC, 2, routine_id("position_") }, -- { "power", EUFUNC, 2, routine_id("power_") }, -- { "prepend", EUFUNC, 2, routine_id("prepend_") }, -- { "print", PROC, 2, routine_id("print_") }, -- { "printf", PROC, 3, routine_id("printf_") }, -- { "profile", PROC, 1, routine_id("profile_") }, -- { "puts", PROC, 2, routine_id("puts_") }, -- { "rand", EUFUNC, 1, routine_id("rand_") }, -- { "remainder", EUFUNC, 2, routine_id("remainder_") }, -- { "repeat", EUFUNC, 2, routine_id("repeat_") }, -- { "routine_id", EUFUNC, 1, routine_id("routine_id_") }, -- { "sequence", EUFUNC, 1, routine_id("sequence_") }, -- { "sin", EUFUNC, 1, routine_id("sin_") }, -- { "sprintf", EUFUNC, 2, routine_id("sprintf_") }, -- { "sqrt", EUFUNC, 1, routine_id("sqrt_") }, -- { "system", PROC, 2, routine_id("system_") }, -- { "system_exec", EUFUNC, 2, routine_id("system_exec_") }, -- { "tan", EUFUNC, 1, routine_id("tan_") }, -- { "time", EUFUNC, 0, routine_id("time_") }, -- { "trace", PROC, 1, routine_id("trace_") }, -- { "xor_bits", EUFUNC, 2, routine_id("xor_bits_") }, -- { "sprint", EUFUNC, 1, routine_id("sprint") }, { "sprintf", EUFUNC, 2, routine_id("sprintf") }, { "pretty_sprint", EUFUNC, 1, routine_id("pretty_sprint")} } integer fresh_init ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- --function run_script_( sequence source ) -- sequence code -- code = {} -- while length( source ) do -- thisLine = source[1] -- parseLine( thisLine ) -- -- -- parse one instruction -- code = parse() -- -- -- did it result in executable code? -- if length( code ) then -- -- -- run the code -- opProc( code ) -- -- end if -- -- end while -- -- if returnInit then -- return euReturnValue -- else -- return 0 -- end if --end function global procedure resetLine() lineNumber = 0 end procedure sequence scripts scripts = {} integer current_script --/topic Reference --/proc run_script( sequence source_text ) -- --Parses and executes a script contained in /b source_text. --/b source_text should be a sequence of sequences. Each line --of script should be its own sequence. The parsed script is --added to the script buffer. global procedure run_script( sequence source_text ) object code fresh_init = 0 script = source_text -- code accumulator code = {} words = {} while not equal( thisWord(), EOF ) do -- parse one instruction code = parse() if atom( code ) then return end if -- did it result in executable code? if length( code ) then -- run the code opProc( code ) end if end while end procedure --euproc = routine_id( "runFile") --/topic Reference --/proc init_eu() -- --Initializes euscript. This is automatically called when --euscript is included and when builtin routines are added or --removed. -- put initialization into routine to enable reset of scripts -- mwl 12/12/00 procedure init_script() fileIndex = 1 lineNumber = 0 pVisible = repeat( {}, 3 ) pUser = {} vList = repeat( {}, 3 ) vName = {} vValue = {} vType = {} vInit = {} uValue = {} uInit = {} stack = {} included = {} source = {} traceStack = {} globalFlag = 0 theProc = 0 runProc = 0 returnFlag = 0 returnInit = 0 exitFlag = 0 typeCheckFlag = 1 traceFlag = 0 shortCircuitFlag = 0 sourceHandle = 0 lineNumber = 0 topTraceLine = 0 traceDepth = 0 euReturnValue = "" script = {} end procedure procedure save_script( integer id ) if not id then return end if scripts[id] = { fileIndex, lineNumber, pVisible, pUser, vList, vName, vValue, vType, vInit, uValue, uInit, stack, included, source, traceStack, globalFlag, theProc, runProc, returnFlag, returnInit, exitFlag, typeCheckFlag, traceFlag, shortCircuitFlag, sourceHandle, lineNumber, topTraceLine, traceDepth, euReturnValue, script } end procedure sequence the_sequence integer the_index function get_element() the_index += 1 return the_sequence[the_index] end function --/topic Reference --/func get_current_script() -- --Returns the id of the current script. global function get_current_script() return current_script end function --/topic Reference --/proc activate_script( integer id ) -- --Saves the current script and makes script /b id the --current script. global procedure activate_script( integer id ) sequence s save_script( current_script ) the_sequence = scripts[id] the_index = 0 fileIndex = get_element() lineNumber = get_element() pVisible = get_element() pUser = get_element() vList = get_element() vName = get_element() vValue = get_element() vType = get_element() vInit = get_element() uValue = get_element() uInit = get_element() stack = get_element() included = get_element() source = get_element() traceStack = get_element() globalFlag = get_element() theProc = get_element() runProc = get_element() returnFlag = get_element() returnInit = get_element() exitFlag = get_element() typeCheckFlag = get_element() traceFlag = get_element() shortCircuitFlag = get_element() sourceHandle = get_element() lineNumber = get_element() topTraceLine = get_element() traceDepth = get_element() euReturnValue = get_element() script = get_element() current_script = id end procedure --/topic Reference --/func new_script() -- --Creates a new script instance and returns the id of the script. --This new script will be completely separate from all other scripts. global function new_script() integer id save_script( current_script ) id = find(-1, scripts) if not id then id = length(scripts) + 1 scripts &= { {} } end if current_script = id init_script() init_script() save_script( id ) return id end function --/topic Reference --/proc delete_script( integer id ) -- --Deletes the script from memory. global procedure delete_script( integer id ) scripts[id] = -1 for i = 1 to length(scripts) do if compare(scripts[i], -1) then current_script = i return end if end for id = new_script() end procedure --/topic Reference --/proc init_eu() -- --Initializes euscript. Erases all scripts from memory, and initializes --a new script with id = 1. global procedure init_eu() integer id scripts = {} current_script = 0 id = new_script() fresh_init = 1 init_script() save_script(1) end procedure --/topic Reference --/proc add_routine( sequence name, integer rtype, integer args, integer rid ) -- --Add a builtin routine that can be called by scripts. /b name should be --the name of the routine as it will be called from within a script. --/b rtype should be either \b EUFUNC or \b PROC, depending on the type of --the routine. /b args is the number of arguments that must be passed when --the routine is called. /b rid is the routine id of the actual routine in --your code that is called from the script. -- --Calling add_routine() clears the script buffer. ----------------------------------------------------------------------------- global procedure add_routine( sequence name, integer rtype, integer args, integer rid ) builtin = append( builtin, { name, rtype, args, rid } ) if not fresh_init then init_eu() end if end procedure ----------------------------------------------------------------------------- --/topic Reference --/proc remove_routine( sequence name ) -- --Removes a builtin script routine. A builtin routine is either --a predefined routine, or a user defined routine added by --/add_routine(). You can also pass a sequence of names to have --multiple routines removed with one call. -- --Calling remove_routine() clears the script buffer. global procedure remove_routine( sequence name ) integer ix if not length(name) then return end if if atom(name[1]) then name = {name} end if for j = 1 to length(name) do for i = 1 to length(builtin) do if equal( name[j], builtin[i][1] ) then builtin = builtin[1..i-1] & builtin[i+1..length(builtin)] exit end if end for end for if not fresh_init then init_eu() end if end procedure --/topic Reference --/proc set_err_routine( integer rid ) -- --This allows you to set a routine to be called when an --error is encountered. Your routine must take 4 arguments: --/code --ex: -- procedure my_error( sequence s1, sequence s2, sequence text, atom line_number ) -- printf(1, "%s\nLine: %d\n", { text, line_number } ) -- printf(1, s1 & "\n", s2 ) -- end procedure --/endcode --/b s1 and /b s2 are a format string and arguments for the description of the error, --/b text is the line of code with the error and /b line_number is the line within the --script buffer where the error occured. -- --This routine will be called multiple times for the same error, due to the internals --of euscript, so you should set and check a flag to determine whether your error --routine has been called whenever you execute a script. global procedure set_err_routine( integer rid ) err_routine = rid end procedure init_eu() --/topic Reference --/info --Global functions and procedures -- -- --/topic Using euscript --/info --What can I do with this? -- --Euscript is meant to allow you to add euphoria scripting to your applications. This --means that users can create their own scripts (like Visual Basic for Applications), --or that you can dynamically generate and execute code within an application. Although --extensive testing hasn't been done to prove this, euscript should be compatible with --all Euphoria 2.2 code. -- --There is a little work involved in allowing euscript code to interact with the rest --of your application. You must provide wrappers for each routine and variable within --your code that you want visible to scripts (see /add_routine). Adding visibility --for a routine is fairly straightforward. -- --Variables are a little more tricky, --since you can't refer to variables by reference in the official Euphoria interpreter. --Instead, you need to write a wrapper routine for reading and writing each variable, --and then making the routine visible through /add_routine. Then, in order to change --or read a program variable from a script, the script will call the wrapper routine. --/code --ex: -- atom x -- sequence s -- -- procedure set_var( sequence var, object val ) -- if equal(var,"s") then -- s = val -- elsif equal(var,"x") then -- x = val -- end if -- end procedure -- add_routine( "set_var", PROC, 2, routine_id("set_var")) -- -- function get_var( sequence var ) -- if equal( var, "s" ) then -- return s -- elsif equal( var, "x" ) then -- return x -- end if -- return 0 -- end function -- add_routine( "get_var", EUFUNC, 1, routine_id("get_var")) -- -- -- now, scripts can read and write x or s by calling -- -- x = get_var( "x" ) or set_var( "x", x ) -- -- s = get_var( "s" ) or set_var( "s", s ) --/endcode -- --You can also remove certain builtin routines if you don't want to allow scripts --to have access to such builtins as peek/poke/puts/etc. See /remove_routine. -- --It is possible to have multiple scripts in memory. Each script will not be --able to interact with the others. This can be useful to prevent namespace --clashes among scripts, or simply to ensure that one script cannot interferre --with another. It also allows you to remove scripts from memory when they --are no longer needed.
6. Re: EDB.EXW Database Browser
- Posted by dcole Sep 12, 2010
- 1761 views
Hello jimcbrown,
I too was having the same problem a while back and abandoned the whole project. I copied your post and now it seems to work but with many problems. So again I am going to abandon and try something else.
Thank you for your fix. It did work.
Don Cole
Hello SergioGelli,
I would advise you (as a newbie), to find another program in the Archives to learn Euphoria on.
Don Cole
