------------------------------------------------------------------------------ -- Common declarations across most of BUSH including -- -- command line switches and the symbol table. -- -- -- -- -- -- Part of BUSH -- ------------------------------------------------------------------------------ -- -- -- Copyright (C) 2001-2005 Ken O. Burtch & FSF -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. This is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with this; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- This is maintained at http://www.pegasoft.ca -- -- -- ------------------------------------------------------------------------------ -- CVS: $Id: world.ads,v 1.5 2005/08/31 15:10:45 ken Exp $ with system, ada.numerics.float_random, ada.unchecked_deallocation, ada.strings.unbounded, gen_list, APQ; use ada.strings.unbounded, APQ; package world is ------------------------------------------------------------------------------ -- Global Variables / Flags ------------------------------------------------------------------------------ version : constant string := "1.0.3"; copyright : constant string := " Copyright (c)2001-2005 PegaSoft Canada & Free Software Foundation"; random_generator : ada.numerics.float_random.generator; -- -- Decimal type for formatted numbers -- type integerOutputType is delta 0.1 digits System.Max_Digits-2; -- delta can't be 1, so we'll settle for 0.1. This is the largest -- long float number we can convert to an integer (and vice vera) -- without rounding or resorting to scientific notation. Why -- -2? Anything higher resulted in rounding of Max_Int and Min_Int. type anInputMode is ( interactive, breakout, fromScriptFile ); -- interactive - user is typing commands from the prompt -- fromScriptFile - commands are executing from a script file type identifier is new integer range 1..2750; -- identifiers are identified by a unique number. The upper bound indicates -- the number of identifiers that can be declared. ------------------------------------------------------------------------------ -- Modes ------------------------------------------------------------------------------ trace : boolean := false; -- true if trace is on inputMode : anInputMode := interactive; syntax_check : boolean := false; -- true if syntax checking breakoutContinue : boolean := false; -- true if execution should continue isLoginShell : boolean := false; -- true if a login shell stepFlag1 : boolean := false; -- first parser step cmd flag stepFlag2 : boolean := false; -- second parser step cmd flag ------------------------------------------------------------------------------ -- Scanning ------------------------------------------------------------------------------ type aLineNumber is new natural; -- a byte code line number type aStatusCode is new integer; -- a shell status code token : identifier; -- item we're currently looking at done : boolean := false; -- true if exiting script error_found : boolean := false; -- true if an error occurred done_sub : boolean := false; -- true if done a subprogram exit_block : boolean := false; -- true if "exit"ing last_status : aStatusCode := 0; -- status of last shell command -- Source Files List -- -- The byte code compiler permits for multiple source files to be built at -- one time (though there is no way to specify multiple source files yet). -- We need to maintain a globally-accessible linked list of the names of -- loaded source files to identify where byte code lines originated from. -- We're using a record for allow storing additional information in the future. type aSourceFile is record -- source file info name : unbounded_string; -- name of the source file end record; function ">"( left, right : aSourceFile ) return boolean; package SourceFilesList is new gen_list( aSourceFile, ">", "=" ); sourceFiles : SourceFilesList.List; -- the list of source files commandLineSource : constant string := "Command"; -- name for a "script" (command) typed at the command prompt ------------------------------------------------------------------------------ -- Error Handling ------------------------------------------------------------------------------ -- error_type : anExceptionType; -- type of exception err_message : unbounded_string; -- last error message ------------------------------------------------------------------------------ -- Pragma Flags ------------------------------------------------------------------------------ onlyAda95 : boolean := false; -- pragma ada_95 restriction_no_auto_declarations : boolean := false; -- pragma restriction restriction_no_external_commands : boolean := false; -- pragma restriction no_command_hash : boolean := false; type templateTypes is (noTemplate, htmlTemplate, textTemplate); processingTemplate : boolean := false; -- pragma tempate unrestrictedTemplate : boolean := false; -- pragma unrestricted_t templatePath : unbounded_string; -- template path templateType : templateTypes; depreciatedMsg : unbounded_string := null_unbounded_string; -- pragma dep. ------------------------------------------------------------------------------ -- Command Line Options -- -- These are set when BUSH interprets its command line options ------------------------------------------------------------------------------ type commandLineOption is new boolean; breakoutOpt : commandLineOption := false; -- true if -b syntaxOpt : commandLineOption := false; -- true if -c debugOpt : commandLineOption := false; -- true if -d execOpt : commandLineOption := false; -- true if -e gccOpt : commandLineOption := false; -- true if -g importOpt : commandLineOption := false; -- true if -i nosyntaxOpt : commandLineOption := false; -- true if -n rshOpt : commandLineOption := false; -- true if -r verboseOpt : commandLineOption := false; -- true if -v traceOpt : commandLineOption := false; -- true if -x --optionOffset : natural := 0; -- character offset to script parameters terminalWindowNaming : boolean := false; -- true if terminal emulation supports xterm window naming currentEngine : Database_Type := Engine_PostgreSQL; engineOpen : boolean := false; -- current database being used. Unfortunately, APQ has no Engine_None so we -- need two variables. ------------------------------------------------------------------------------ -- Identifiers (The Symbol Table) -- ------------------------------------------------------------------------------ -- -- Identifier classes -- -- constClass - a constant -- subClass - a subtype -- typeClass - a type -- funcClass - a function -- procClass - a procedure -- userProcClass - a user-defined procedure -- taskClass - a task -- otherClass - a variable (probably needs a more descriptive name) type anIdentifierClass is ( constClass, subClass, typeClass, funcClass, userFuncClass, procClass, userProcClass, taskClass, otherClass ); ------------------------------------------------------------------------------ -- Identifier Declarations -- ------------------------------------------------------------------------------ type declaration is record name : unbounded_string -- identifier name := Null_Unbounded_String; kind : identifier; -- identifier's type value : unbounded_string -- identifier's value := Null_Unbounded_String; class : anIdentifierClass -- identifier's class := otherClass; import : boolean := false; -- marked by pragma import export : boolean := false; -- marked by pragma export volatile : boolean := false; -- marked by pragma volatile limit : boolean := false; -- limited type list : boolean := false; -- array or array type field_of : identifier; -- record superclass inspect : boolean := false; -- show value on breakout deleted : boolean := false; -- marked for deletion end record; ------------------------------------------------------------------------------ -- Symbol Table -- ------------------------------------------------------------------------------ type identifiersArray is array ( identifier ) of declaration; identifiers : identifiersArray; identifiers_top : identifier := identifier'first; keywords_top : identifier := identifier'last; reserved_top : identifier := identifier'last; -- this arrangement means the last array element is never accessed -- "Captain, the ship can't take any more!" symbol_table_overflow : exception; ------------------------------------------------------------------------------ -- Predefined Identifiers (Global) -- -- These identifiers always have meaning and are accessible from all other -- packages. They represent keywords and other unchangable declarations -- in the symbol table. -- -- Keyword is the root of all identifiers in the symbol table tree. It is -- the type for any AdaScript keyword. ------------------------------------------------------------------------------ keyword_t : identifier; ------------------------------------------------------------------------------ -- Keywords -- -- All Ada95 keywords are reserved even if they are not used by AdaScript ------------------------------------------------------------------------------ abort_t : identifier; abs_t : identifier; abstract_t : identifier; accept_t : identifier; access_t : identifier; aliased_t : identifier; all_t : identifier; and_t : identifier; array_t : identifier; at_t : identifier; begin_t : identifier; body_t : identifier; case_t : identifier; constant_t : identifier; declare_t : identifier; delay_t : identifier; delta_t : identifier; digits_t : identifier; do_t : identifier; else_t : identifier; elsif_t : identifier; end_t : identifier; entry_t : identifier; exception_t : identifier; exit_t : identifier; for_t : identifier; function_t : identifier; generic_t : identifier; goto_t : identifier; if_t : identifier; in_t : identifier; interface_t : identifier; is_t : identifier; limited_t : identifier; loop_t : identifier; mod_t : identifier; new_t : identifier; not_t : identifier; null_t : identifier; of_t : identifier; or_t : identifier; others_t : identifier; out_t : identifier; package_t : identifier; pragma_t : identifier; private_t : identifier; procedure_t : identifier; protected_t : identifier; raise_t : identifier; range_t : identifier; record_t : identifier; rem_t : identifier; renames_t : identifier; requeue_t : identifier; return_t : identifier; reverse_t : identifier; select_t : identifier; separate_t : identifier; subtype_t : identifier; tagged_t : identifier; task_t : identifier; terminate_t : identifier; then_t : identifier; type_t : identifier; until_t : identifier; use_t : identifier; when_t : identifier; while_t : identifier; with_t : identifier; xor_t : identifier; ------------------------------------------------------------------------------ -- Built-in Bourne shell commands -- -- AdaScript shell commands that extend Ada 95 are also reserved words ------------------------------------------------------------------------------ env_t : identifier; typeset_t : identifier; unset_t : identifier; trace_t : identifier; help_t : identifier; clear_t : identifier; jobs_t : identifier; logout_t : identifier; pwd_t : identifier; -- built-in pwd cd_t : identifier; -- built-in cd wait_t : identifier; -- built-in wait step_t : identifier; -- template_t : identifier; history_t : identifier; -- built-in history ------------------------------------------------------------------------------ -- Built-in SQL commands -- ------------------------------------------------------------------------------ alter_t : identifier; insert_t : identifier; -- delete_t : identifier; (shared with Ada delete declared above) -- select_t : identifier; (shared with Ada select declared above) update_t : identifier; ------------------------------------------------------------------------------ -- Other internal identifiers -- -- EOF token, literals and virtual machine instructions. Users should never -- see these but they are all defined in the symbol table. ------------------------------------------------------------------------------ eof_t : identifier; -- end of file / abort script symbol_t : identifier; -- punctuation/etc., value = string of punctuation backlit_t : identifier; -- back quoted literal, value = the literal strlit_t : identifier; -- string literal, value = the literal charlit_t : identifier; -- character literal, value = the literal number_t : identifier; -- numeric literal, value = the literal imm_delim_t: identifier; -- immediate word delimiter / identifier terminator imm_sql_delim_t: identifier; -- same for SQL word word_t : identifier; -- immediate word value sql_word_t : identifier; -- a SQL word (not to be escaped) char_escape_t : identifier; -- character escape ------------------------------------------------------------------------------ -- Predefined types -- -- All Ada 95 fundamental types are declared, as well as AdaScript extensions. -- -- variable_t is the root type of all variables and -- is only used to mark the fundamental types. -- -- the fundamental types are univeral number, universal -- string and universal (typeless). All have .kind = -- variable_t. -- -- the basic Ada types are derived from the universal -- types and have a .kind = some univeral type. -- -- user types are, of course, derived from the basic -- Ada types and have a .kind = some basic Ada type ------------------------------------------------------------------------------ variable_t : identifier; uni_numeric_t : identifier; uni_string_t : identifier; universal_t : identifier; root_enumerated_t : identifier; root_record_t : identifier; command_t : identifier; file_type_t : identifier; socket_type_t : identifier; integer_t : identifier; natural_t : identifier; positive_t : identifier; short_short_integer_t : identifier; short_integer_t : identifier; long_integer_t : identifier; long_long_integer_t : identifier; character_t : identifier; float_t : identifier; short_float_t : identifier; long_float_t : identifier; boolean_t : identifier; string_t : identifier; duration_t : identifier; file_mode_t : identifier; unbounded_string_t : identifier; complex_t : identifier; complex_real_t : identifier; complex_imaginary_t : identifier; false_t : identifier; -- Boolean.false true_t : identifier; -- Boolean.true ------------------------------------------------------------------------------ -- Shortcut operands -- -- The reflexive operand, itself, "@": -- -- If itself's class is otherClass, it refers to a variable. -- eg. total := @+1; itself is the value, itself_type is the type -- If itself's class is procClass, it refers to a procedure. -- eg. put( "hello" ) @ ( "!" ) itself_type is the procedure id and -- itself is unused -- If itself_type is new_t, then itself is undefined. -- To extend itself's capabilities, beware of side-effects. ------------------------------------------------------------------------------ itself : unbounded_string; -- copy of the identifier declaration itself_type : identifier; -- type of @ or procedure identifier -- The last output operand, % last_output : unbounded_string; -- result of last output last_output_type : identifier; -- type of last output ------------------------------------------------------------------------------ -- Declarations ------------------------------------------------------------------------------ procedure declareKeyword( id : out identifier; s : string ); -- initialize a new keyword / internal identifier procedure declareFunction( id : out identifier; s : string ); -- Initialize a built-in function identifier in the symbol table procedure declareProcedure( id : out identifier; s : string ); -- Initialize a built-in procedure identifier in the symbol table function deleteIdent( id : identifier ) return boolean; -- delete an identifier, true if successful procedure declareIdent( id : out identifier; name : unbounded_string; kind : identifier; class : anIdentifierClass := otherClass ); -- Declare an identifier in the symbol table, specifying name, kind. -- and (optionally) symbol class. The id is returned. procedure declareIdent( id : out identifier; name : string; kind : identifier; class : anIdentifierClass := otherClass ); -- Alternate version: use fixed string type for name procedure declareStandardConstant( id : out identifier; name : string; kind : identifier; value : string ); -- Declare a standard constant in the symbol table. The id is not -- returned since we don't change with constants once they are set. procedure declareStandardConstant( name : string; kind : identifier; value : string ); -- Alternative version: return the symbol table id procedure updateFormalParameter( id : identifier; kind : identifier; proc_id : identifier; parameterNumber : integer ); -- Update a formal parameter (ie. proc.param). The id is not -- returned since we don't change the formal parameters once they are set. procedure declareActualParameter( id : out identifier; proc_id : identifier; parameterNumber : integer; value : unbounded_string ); -- Declare an actual parameter (ie. param for proc.param). procedure declareReturnResult( id : out identifier; func_id : identifier ); -- Declare space for the function return result. procedure findIdent( name : unbounded_string; id : out identifier ); -- find an identifier, eof_t if failed procedure init_env_ident( s : string ); -- initialize an environment variable function is_keyword( id : identifier ) return boolean; -- TRUE if the identifier is a keyword ----------------------------------------------------------------------------- -- Type Representation ----------------------------------------------------------------------------- maxInteger : long_float; -- equivalent to BUSH's System.Max_Int, the largest integer representable -- by BUSH (it is not long_integer'last). Set during scanner startup. function to_numeric( s : unbounded_string ) return long_float; -- Convert an unbounded string to a long float (BUSH's numeric representation) function to_numeric( id : identifier ) return long_float; -- Look up an identifier's value and return it as a long float -- (BUSH's numeric representation). function to_bush_boolean( AdaBoolean : boolean ) return unbounded_string; -- convert an Ada boolean into a BUSH boolean (a string containing -- the position, no leading blank). function to_unbounded_string( f : long_float ) return unbounded_string; -- convert a numeric value to a bush string, dropping of decimal portion -- if a small integer ----------------------------------------------------------------------------- -- Character Conversion ----------------------------------------------------------------------------- function toHighASCII( ch : character ) return character; function toHighASCII( id : identifier ) return character; -- add 128 to a character function toLowASCII( ch : character ) return character; function toLowASCII( id : identifier ) return character; -- subtract 128 from a character ----------------------------------------------------------------------------- -- Shell Words ----------------------------------------------------------------------------- type aShellWordType is ( normalWord, -- any word that is not a special word semicolonWord, -- unescaped ; pipeWord, -- unescaped | ampersandWord, -- unescaped & redirectOutWord, -- unescaped > redirectInWord, -- unescaped < redirectAppendWord, -- unescaped >> redirectErrOutWord, -- unescaped 2> redirectErrOutWord, -- unescaped 2> redirectErrAppendWord,-- unescaped 2>> redirectErr2OutWord, -- unescaped 2>&1 itselfWord -- unescaped @ ); -- To differentiate between ";" and ;, "|" and |, "&" and &, etc. type aShellWord is record wordType : aShellWordType; -- shell token type pattern : unbounded_string; -- pattern for word word : unbounded_string; -- expanded word end record; nullShellWord : aShellWord := ( normalWord, null_unbounded_string, null_unbounded_string ); function ">"( left, right : aShellWord ) return boolean; package shellWordList is new gen_list( aShellWord, ">", "=" ); -- Enviroment -- -- Since the O/S environment is altered while BUSH is running, save the initial -- environment in a linked list when BUSH starts. This is the list. package environmentList is new gen_list( unbounded_string, ">", "=" ); initialEnvironment : environmentList.List; -- Find fieldNumber'th field of a record varable. procedure findField( recordVar : identifier; fieldNumber: natural; fieldVar : out identifier ); end world;