Currently the content of the 


    ./ParaSail_v_7_0_console_version

is the same as the upstream zip-file is, with the 













exception that the 

    make clean

was run before check-in.

===========================================================================


The 

    ./forks/ParaSail_v_7_0_console_version


contains the fork release candidate source.
You may ignore the rest of this COMMENTS.txt file, 
unless You want to get to know the details of the 
contents of this folder.

---------------------------------------------------------------------------
                          Overview               
---------------------------------------------------------------------------

The content of the subfolders of  

    ./upstream_deliverables

contains unmodified upstream deliverables, with the exception that the 

    make clean

has been run before the check-in. The 

    ./forking_tools

contains scripts that copy the 

    ./upstream_deliverables/<something>

to 

    ./forks/<something>_console_version_<some suffix X1>

and they might also patch the 

    ./forks/<something>_console_version_<some suffix X1>

The patch scripts depend on Ruby, Bash, grep and 
other console tools. As of 2016 the scripts have been tested only on Linux.


===========================================================================

# Makefile used at AdaCore to build ParaSail compiler/interpreter
# local installation ready to use
# You must run this Makefile from the top level source directory

# The OMP library is enabled from the command line as follows:
#   $ make OMP=on

# The behavior of gdb can be improved compiling without optimizations. This
# is the default; optimization can be turned on with from the command line
# using:
#   $ make DEBUG=off

ifeq ($(DEBUG),off)
  ADAFLAGS=-p -g -O2 -gnatn -gnata -gnatE -gnat95
else
  ADAFLAGS=-p -g -O0 -gnato -gnata -gnatE -gnat95
endif

# Turn off implicit rules
.SUFFIXES:

PROCS=0
RM=rm -rf

# default to not silent, can be set to true from command line
# used by pslc.csh so that users aren't confused by walls of text
SILENT=0
ifeq ($(SILENT),1)
   GPRBUILD=gprbuild -q -p
else
   GPRBUILD=gprbuild -p
endif

OBJS=
EXE=compiled_main.exe
OMPLIB=-lgomp
MATHLIB=-lm

ifeq ($(OMP),on)
  EXTRALIBS=$(OMPLIB)
else
  EXTRALIBS=
endif

# EXTRALIBS can be extended with additional libraries (if required)

COMPLIBS=$(MATHLIB)

.DELETE_ON_ERROR:

.PHONY: build all all_no_gtk local-install clean parasail parser 
.PHONY: sparkel sparkel_parser build_sparkel sparkel_doc
.PHONY: parasail_gtk build_no_gtk
.PHONY: javallel javallel_parser build_javallel
.PHONY: parython parython_gtk parython_parser build_parython build_parython_gtk
.PHONY: test_runtime
.PHONY: compiled_main compiled_main_with_interp
.PHONY: do_psltags do_atags

all: config build do_psltags do_atags doc build_sparkel build_javallel build_parython_gtk sparkel_doc test_runtime local-install

all_no_gtk: config build_no_gtk doc build_sparkel build_javallel build_parython sparkel_doc test_runtime local-install

config: semantics/psc-link_names.ads
	cd interpreter; ./config.sh $(OMP)

semantics/psc-link_names.ads : semantics/psc-link_names-common.ads
	cp semantics/psc-link_names-common.ads semantics/psc-link_names.ads

build: parser parasail check_compiled_main parasail_gtk

build_no_gtk: parser check_compiled_main parasail

build_sparkel: sparkel_parser sparkel

build_javallel: javallel_parser javallel

build_parython: parython_parser parython

build_parython_gtk: build_parython parython_gtk

do_atags : tags

tags : */*.ad?
	csh share/tools/vi_tags/do_atags.csh

do_psltags : lib/tags

lib/tags : lib/aaa.psi lib/reflection.ps? lib/llvm_printer.ps? lib/compiler.ps? lib/psvm_debugging.psl lib/parascope.ps? lib/vn_il.ps? lib/node_tree.ps?
	cd lib; ../share/tools/vi_tags/psltags aaa.psi reflection.ps? llvm_printer.ps? compiler.ps? psvm_debugging.psl parascope.ps? vn_il.ps? node_tree.ps?

doc:
	$(MAKE) -C documentation/ref_manual parasail_ref_manual.pdf

sparkel_doc:
	$(MAKE) -C documentation/sparkel_ref_manual sparkel_ref_manual.pdf

parser:
	$(MAKE) -C parser/build

sparkel_parser:
	$(MAKE) -C sparkel_parser/build

javallel_parser:
	$(MAKE) -C javallel_parser/build

parython_parser:
	$(MAKE) -C parython_parser/build

parasail: cleantestsuite
	@mkdir -p build/bin build/obj
	$(GPRBUILD) $(ADAFLAGS) -P build/parasail -largs $(EXTRALIBS)

parasail_gtk: gtk_libs
	@mkdir -p build/bin build/obj
	$(GPRBUILD) $(ADAFLAGS) -P build/parasail_gtk -largs $(EXTRALIBS)

sparkel: cleantestsuite
	@mkdir -p build/bin build/obj
	$(GPRBUILD) $(ADAFLAGS) -P build/sparkel -largs $(EXTRALIBS)

javallel: cleantestsuite
	@mkdir -p build/bin build/obj
	$(GPRBUILD) $(ADAFLAGS) -P build/javallel -largs $(EXTRALIBS)

parython: cleantestsuite
	@mkdir -p build/bin build/obj
	$(GPRBUILD) $(ADAFLAGS) -P build/parython -largs $(EXTRALIBS)

parython_gtk: gtk_libs
	@mkdir -p build/bin build/obj
	$(GPRBUILD) $(ADAFLAGS) -P build/parython_gtk -largs $(EXTRALIBS)

test_runtime:
	@mkdir -p build/bin build/obj
	$(GPRBUILD) $(ADAFLAGS) -P build/test_runtime -largs $(EXTRALIBS)

gtk_libs:
	pkg-config gtk+-2.0 gthread-2.0 --libs > gtk_libs
	mkdir -p build/obj
	rm -f build/obj/gtk_libs
	cp gtk_libs build/obj/gtk_libs

check_compiled_main:
	$(GPRBUILD) -c -P build/compiled_main -largs $(COMPLIBS)
	$(GPRBUILD) -c $(ADAFLAGS) -P build/compiled_main_with_interp -largs $(COMPLIBS)

compiled_main:
	rm -f $(EXE)
	$(GPRBUILD) -P build/compiled_main -o $(EXE) -largs $(OBJS) $(COMPLIBS)

compiled_main_with_interp:
	rm -f $(EXE)
	$(GPRBUILD) $(ADAFLAGS) -P build/compiled_main_with_interp -o $(EXE) -largs $(OBJS) $(COMPLIBS)

local-install:
	$(RM) install/share/examples/parasail
	$(RM) install/share/doc/parasail
	$(RM) install/share/tools
	$(RM) install/bin
	$(RM) install/lib
	@mkdir -p install/bin
	@mkdir -p install/lib
	@mkdir -p install/lib/aaa
	@mkdir -p install/share
	@mkdir -p install/share/examples/parasail
	@mkdir -p install/share/doc/parasail
	@mkdir -p install/share/tools/parasail
	cp -p documentation/ref_manual/*.pdf install/share/doc/parasail
	cp -p documentation/parasail_release_notes*.txt install/share/doc/parasail
	cp -p documentation/*.pdf install/share/doc/parasail
	cp -p examples/*.ps? install/share/examples/parasail
	cp -p lib/*.ps? install/lib
	cp -p lib/aaa/*.ps?  install/lib/aaa
	cp -p bin/pslc.csh install/bin/pslc.csh
	cp -p bin/scope.csh install/bin/scope.csh
	-cp -p build/bin/parasail_main_gtk install/bin/psli
	cp -p build/bin/parasail_main install/bin/psli_no_gtk
	cp -pr share/tools/* install/share/tools/parasail
	$(RM) install/share/examples/sparkel
	$(RM) install/share/doc/sparkel
	@mkdir -p install/share/examples/sparkel
	@mkdir -p install/share/doc/sparkel
	@mkdir -p install/share/tools/sparkel
	cp -p documentation/sparkel_ref_manual/*.pdf install/share/doc/sparkel
	cp -p documentation/sparkel_release_notes*.txt install/share/doc/sparkel
	cp -p sparkel_examples/*.sk? install/share/examples/sparkel
	cp -p build/bin/sparkel_main install/bin/skli
	cp -p share/sparkel_tools/* install/share/tools/sparkel
	$(RM) install/share/examples/javallel
	$(RM) install/share/doc/javallel
	@mkdir -p install/share/examples/javallel
	@mkdir -p install/share/doc/javallel
	@mkdir -p install/share/tools/javallel
	cp -p javallel_examples/*.jl? install/share/examples/javallel
	cp -p build/bin/javallel_main install/bin/jlli
	$(RM) install/share/examples/parython
	$(RM) install/share/doc/parython
	@mkdir -p install/share/examples/parython
	@mkdir -p install/share/doc/parython
	@mkdir -p install/share/tools/parython
	-cp -p parython_examples/*.pr? install/share/examples/parython
	cp -p build/bin/parython_main install/bin/pryi
	-cp -p build/bin/parython_main_gtk install/bin/pryi_gtk
	-cp -p build/bin/test_runtime install/bin/test_runtime

cleantestsuite:
	cd testsuite/ParaSail; ../support/clean.sh
	cd testsuite/Sparkel;  ../support/clean.sh
	cd testsuite/Parython; ../support/clean.sh
	cd testsuite/Javallel; ../support/clean.sh

cleanconfig:
	-rm interpreter/psc-interpreter-locks.ads
	-rm interpreter/psc-interpreter-locks.adb

clean: cleanconfig
	-gnatclean -q -r -P build/parasail
	$(RM) install gtk_libs
	$(RM) build/bin build/obj
	$(MAKE) -C documentation/ref_manual clean
	$(MAKE) -C parser/build clean-all
	-gnatclean -q -r -P build/sparkel
	-gnatclean -q -r -P build/javallel
	-gnatclean -q -r -P build/parython
	-gnatclean -q -r -P build/test_runtime
	$(MAKE) -C documentation/sparkel_ref_manual clean
	$(MAKE) -C sparkel_parser/build clean
	$(MAKE) -C javallel_parser/build clean
	$(MAKE) -C parython_parser/build clean

-- AUTHOR: John Self (UCI)
-- DESCRIPTION main subprogram of aflex, calls the major routines in order
--*************************************************************************** 
--                              aflex
--                          version 1.4a
--***************************************************************************
--
--                            Arcadia Project
--               Department of Information and Computer Science
--                        University of California
--                        Irvine, California 92717
--
--    Send requests for aflex information to alex-info@ics.uci.edu
--
--    Send bug reports for aflex to alex-bugs@ics.uci.edu
--
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
--
--    This program is based on the flex program written by Vern Paxson.
--
--    The following is the copyright notice from flex, from which aflex is
--    derived.
--	Copyright (c) 1989 The Regents of the University of California.
--	All rights reserved.
--
--	This code is derived from software contributed to Berkeley by
--	Vern Paxson.
--
--      The United States Government has rights in this work pursuant to
--	contract no. DE-AC03-76SF00098 between the United States Department of
--	Energy and the University of California.
--
--	Redistribution and use in source and binary forms are permitted
--	provided that the above copyright notice and this paragraph are
--	duplicated in all such forms and that any documentation,
--	advertising materials, and other materials related to such
--	distribution and use acknowledge that the software was developed
--	by the University of California, Berkeley.  The name of the
--	University may not be used to endorse or promote products derived
--	from this software without specific prior written permission.
--	THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
--	IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
--	WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.

pragma Warnings(Off);
pragma Style_Checks(Off);


package body Aflex_parser is
-- build_eof_action - build the "<<EOF>>" action for the active start
--                    conditions

use text_io, misc_defs;
procedure build_eof_action is
begin
    text_io.put( temp_action_file, "when " );
    for i in 1..actvp loop
	if ( sceof(actvsc(i)) ) then
	    text_io.put( Standard_Error,
		"multiple <<EOF>> rules for start condition ");
	    tstring.put( Standard_Error, scname(actvsc(i)));
	    main_body.aflexend(1);
	else
	    sceof(actvsc(i)) := true;
	    text_io.put( temp_action_file, "YY_END_OF_BUFFER +" );
	    tstring.put( temp_action_file,  scname(actvsc(i)) );
	    text_io.put_line( temp_action_file, " + 1 " );
	    if (i /= actvp) then
	        text_io.put_line( temp_action_file, " |" );
	    else
	        text_io.put_line( temp_action_file, " =>" );
	    end if;
        end if;
    end loop;
    misc.line_directive_out( temp_action_file );
end build_eof_action;

--  yyerror - eat up an error message from the parser
-- 
--  synopsis
--     char msg[];
--     yyerror( msg );

procedure yyerror( msg : string ) is
begin
null;
end yyerror;

use  Parse_Goto, Parse_Shift_Reduce, Text_IO, misc_defs, tstring;
procedure YYParse is

   -- Rename User Defined Packages to Internal Names.
    package yy_goto_tables         renames
      Parse_Goto;
    package yy_shift_reduce_tables renames
      Parse_Shift_Reduce;
    package yy_tokens              renames
      Parse_Tokens;

   use yy_tokens, yy_goto_tables, yy_shift_reduce_tables;

   procedure yyerrok;
   procedure yyclearin;


   package yy is

       -- the size of the value and state stacks
       stack_size : constant Natural := 300;

       -- subtype rule         is natural;
       subtype parse_state  is natural;
       -- subtype nonterminal  is integer;

       -- encryption constants
       default           : constant := -1;
       first_shift_entry : constant :=  0;
       accept_code       : constant := -1001;
       error_code        : constant := -1000;

       -- stack data used by the parser
       tos                : natural := 0;
       value_stack        : array(0..stack_size) of yy_tokens.yystype;
       state_stack        : array(0..stack_size) of parse_state;

       -- current input symbol and action the parser is on
       action             : integer;
       rule_id            : rule;
       input_symbol       : yy_tokens.token;


       -- error recovery flag
       error_flag : natural := 0;
          -- indicates  3 - (number of valid shifts after an error occurs)

       look_ahead : boolean := true;
       index      : integer;

       -- Is Debugging option on or off
        DEBUG : constant boolean := FALSE;

    end yy;


    function goto_state
      (state : yy.parse_state;
       sym   : nonterminal) return yy.parse_state;

    function parse_action
      (state : yy.parse_state;
       t     : yy_tokens.token) return integer;

    pragma inline(goto_state, parse_action);


    function goto_state(state : yy.parse_state;
                        sym   : nonterminal) return yy.parse_state is
        index : integer;
    begin
        index := goto_offset(state);
        while  integer(goto_matrix(index).nonterm) /= sym loop
            index := index + 1;
        end loop;
        return integer(goto_matrix(index).newstate);
    end goto_state;


    function parse_action(state : yy.parse_state;
                          t     : yy_tokens.token) return integer is
        index      : integer;
        tok_pos    : integer;
        default    : constant integer := -1;
    begin
        tok_pos := yy_tokens.token'pos(t);
        index   := shift_reduce_offset(state);
        while integer(shift_reduce_matrix(index).t) /= tok_pos and then
              integer(shift_reduce_matrix(index).t) /= default
        loop
            index := index + 1;
        end loop;
        return integer(shift_reduce_matrix(index).act);
    end parse_action;

-- error recovery stuff

    procedure handle_error is
      temp_action : integer;
    begin

      if yy.error_flag = 3 then -- no shift yet, clobber input.
      if yy.debug then
          text_io.put_line("Ayacc.YYParse: Error Recovery Clobbers " &
                   yy_tokens.token'image(yy.input_symbol));
      end if;
        if yy.input_symbol = yy_tokens.end_of_input then  -- don't discard,
        if yy.debug then
            text_io.put_line("Ayacc.YYParse: Can't discard END_OF_INPUT, quiting...");
        end if;
        raise yy_tokens.syntax_error;
        end if;

            yy.look_ahead := true;   -- get next token
        return;                  -- and try again...
    end if;

    if yy.error_flag = 0 then -- brand new error
        yyerror("Syntax Error");
    end if;

    yy.error_flag := 3;

    -- find state on stack where error is a valid shift --

    if yy.debug then
        text_io.put_line("Ayacc.YYParse: Looking for state with error as valid shift");
    end if;

    loop
        if yy.debug then
          text_io.put_line("Ayacc.YYParse: Examining State " &
               yy.parse_state'image(yy.state_stack(yy.tos)));
        end if;
        temp_action := parse_action(yy.state_stack(yy.tos), error);

            if temp_action >= yy.first_shift_entry then
                if yy.tos = yy.stack_size then
                    text_io.put_line(" Stack size exceeded on state_stack");
                    raise yy_Tokens.syntax_error;
                end if;
                yy.tos := yy.tos + 1;
                yy.state_stack(yy.tos) := temp_action;
                exit;
            end if;

        Decrement_Stack_Pointer :
        begin
          yy.tos := yy.tos - 1;
        exception
          when Constraint_Error =>
            yy.tos := 0;
        end Decrement_Stack_Pointer;

        if yy.tos = 0 then
          if yy.debug then
            text_io.put_line("Ayacc.YYParse: Error recovery popped entire stack, aborting...");
          end if;
          raise yy_tokens.syntax_error;
        end if;
    end loop;

    if yy.debug then
        text_io.put_line("Ayacc.YYParse: Shifted error token in state " &
              yy.parse_state'image(yy.state_stack(yy.tos)));
    end if;

    end handle_error;

   -- print debugging information for a shift operation
   procedure shift_debug(state_id: yy.parse_state; lexeme: yy_tokens.token) is
   begin
       text_io.put_line("Ayacc.YYParse: Shift "& yy.parse_state'image(state_id)&" on input symbol "&
               yy_tokens.token'image(lexeme) );
   end;

   -- print debugging information for a reduce operation
   procedure reduce_debug(rule_id: rule; state_id: yy.parse_state) is
   begin
       text_io.put_line("Ayacc.YYParse: Reduce by rule "&rule'image(rule_id)&" goto state "&
               yy.parse_state'image(state_id));
   end;

   -- make the parser believe that 3 valid shifts have occured.
   -- used for error recovery.
   procedure yyerrok is
   begin
       yy.error_flag := 0;
   end yyerrok;

   -- called to clear input symbol that caused an error.
   procedure yyclearin is
   begin
       -- yy.input_symbol := yylex;
       yy.look_ahead := true;
   end yyclearin;


begin
    -- initialize by pushing state 0 and getting the first input symbol
    yy.state_stack(yy.tos) := 0;


    loop

        yy.index := shift_reduce_offset(yy.state_stack(yy.tos));
        if integer(shift_reduce_matrix(yy.index).t) = yy.default then
            yy.action := integer(shift_reduce_matrix(yy.index).act);
        else
            if yy.look_ahead then
                yy.look_ahead   := false;

                yy.input_symbol := yylex;
            end if;
            yy.action :=
             parse_action(yy.state_stack(yy.tos), yy.input_symbol);
        end if;


        if yy.action >= yy.first_shift_entry then  -- SHIFT

            if yy.debug then
                shift_debug(yy.action, yy.input_symbol);
            end if;

            -- Enter new state
            if yy.tos = yy.stack_size then
                text_io.put_line(" Stack size exceeded on state_stack");
                raise yy_Tokens.syntax_error;
            end if;
            yy.tos := yy.tos + 1;
            yy.state_stack(yy.tos) := yy.action;
              yy.value_stack(yy.tos) := yylval;

        if yy.error_flag > 0 then  -- indicate a valid shift
            yy.error_flag := yy.error_flag - 1;
        end if;

            -- Advance lookahead
            yy.look_ahead := true;

        elsif yy.action = yy.error_code then       -- ERROR

            handle_error;

        elsif yy.action = yy.accept_code then
            if yy.debug then
                text_io.put_line("Ayacc.YYParse: Accepting Grammar...");
            end if;
            exit;

        else -- Reduce Action

            -- Convert action into a rule
            yy.rule_id  := -1 * yy.action;

            -- Execute User Action
            -- user_action(yy.rule_id);


                case yy.rule_id is

when  1 =>
--#line  44
 -- add default rule

			pat := ccl.cclinit;
			ccl.cclnegate( pat );

			def_rule := nfa.mkstate( -pat );

			nfa.finish_rule( def_rule, false, 0, 0 );

			for i in 1 .. lastsc loop
			    scset(i) := nfa.mkbranch( scset(i), def_rule );
			end loop;
			
			if ( spprdflt ) then
			    text_io.put(temp_action_file,
					"raise AFLEX_SCANNER_JAMMED;");
			else
			    text_io.put( temp_action_file, "ECHO" );

			text_io.put_line( temp_action_file, ";" );
			end if;
			

when  2 =>
--#line  69

			-- initialize for processing rules

       			-- create default DFA start condition
			sym.scinstal( tstring.vstr("INITIAL"), false );
			

when  5 =>
--#line  80
 misc.synerr( "unknown error processing section 1" );

when  7 =>
--#line  87

			 -- these productions are separate from the s1object
			 -- rule because the semantics must be done before
			 -- we parse the remainder of an s1object
			

			xcluflg := false;
			

when  8 =>
--#line  97
 xcluflg := true; 

when  9 =>
--#line  101
 sym.scinstal( nmstr, xcluflg ); 

when  10 =>
--#line  104
 sym.scinstal( nmstr, xcluflg ); 

when  11 =>
--#line  107
 misc.synerr( "bad start condition list" ); 

when  14 =>
--#line  115

			-- initialize for a parse of one rule
			trlcontxt := false;
			variable_trail_rule := false;
			varlength := false;
			trailcnt := 0;
			headcnt := 0;
			rulelen := 0;
			current_state_enum := STATE_NORMAL;
			previous_continued_action := continued_action;
			nfa.new_rule;
			

when  15 =>
--#line  130

			pat := nfa.link_machines( 
yy.value_stack(yy.tos-1), 
yy.value_stack(yy.tos) );
			nfa.finish_rule( pat, variable_trail_rule,
				     headcnt, trailcnt );

			for i in 1 .. actvp loop
			    scbol(actvsc(i)) :=
				nfa.mkbranch( scbol(actvsc(i)), pat );
			end loop;	
				
			if ( not bol_needed ) then
			    bol_needed := true;

			    if ( performance_report ) then
				text_io.put( Standard_Error,
			"'^' operator results in sub-optimal performance");
			        text_io.new_line(Standard_Error);
    	    	    	    end if;
			end if;
			

when  16 =>
--#line  152

			pat := nfa.link_machines( 
yy.value_stack(yy.tos-1), 
yy.value_stack(yy.tos) );
			nfa.finish_rule( pat, variable_trail_rule,
				     headcnt, trailcnt );

			for i in 1 .. actvp loop
			    scset(actvsc(i)) := 
				nfa.mkbranch( scset(actvsc(i)), pat );
			end loop;
		        

when  17 =>
--#line  163

			pat := nfa.link_machines( 
yy.value_stack(yy.tos-1), 
yy.value_stack(yy.tos) );
			nfa.finish_rule( pat, variable_trail_rule,
				     headcnt, trailcnt );

			-- add to all non-exclusive start conditions,
			-- including the default (0) start condition

			for i in 1 .. lastsc loop
			    if ( not scxclu(i) ) then
				scbol(i) := nfa.mkbranch( scbol(i), pat );
			    end if;	
			end loop;

			if ( not bol_needed ) then
			    bol_needed := true;

			    if ( performance_report ) then
				text_io.put( Standard_Error,
			"'^' operator results in sub-optimal performance");
			        text_io.new_line(Standard_Error);
			    end if;
			end if;
    	    	    	

when  18 =>
--#line  188

			pat := nfa.link_machines( 
yy.value_stack(yy.tos-1), 
yy.value_stack(yy.tos) );
			nfa.finish_rule( pat, variable_trail_rule,
				     headcnt, trailcnt );

			for i in 1 .. lastsc loop
			    if ( not scxclu(i) ) then
				scset(i) := nfa.mkbranch( scset(i), pat );
			    end if;
			end loop;
			

when  19 =>
--#line  201
 build_eof_action; 

when  20 =>
--#line  204

			-- this EOF applies only to the INITIAL start cond.
			actvp := 1;
			actvsc(actvp) := 1;
			build_eof_action;
			

when  21 =>
--#line  212
 misc.synerr( "unrecognized rule" ); 

when  23 =>
--#line  219

			scnum := sym.sclookup( nmstr );
			if (scnum = 0 ) then
		            text_io.put( Standard_Error,
					 "undeclared start condition ");
		            tstring.put( Standard_Error, nmstr );
			    main_body.aflexend( 1 );
			else
			  actvp := actvp + 1;
			    actvsc(actvp) := scnum;
			end if;
			

when  24 =>
--#line  233

			scnum := sym.sclookup( nmstr );
			if (scnum = 0 ) then
		            text_io.put( Standard_Error,
					"undeclared start condition ");
		            tstring.put( Standard_Error,	 nmstr );
			    main_body.aflexend ( 1 );
			else
			    actvp := 1;
			    actvsc(actvp) := scnum;
			end if;
			

when  25 =>
--#line  247
 misc.synerr( "bad start condition list" ); 

when  26 =>
--#line  251

			if trlcontxt then
			    misc.synerr( "trailing context used twice" );
			    
yyval := nfa.mkstate( SYM_EPSILON );
			else
			    trlcontxt := true;

			    if ( not varlength ) then
				headcnt := rulelen;
			    end if;

			    rulelen := rulelen + 1;
			    trailcnt := 1;

			    eps := nfa.mkstate( SYM_EPSILON );
			    
yyval := nfa.link_machines( eps,
					  nfa.mkstate( CHARACTER'POS(ASCII.LF) ) );
    	    	    	end if;
			

when  27 =>
--#line  272

		        
yyval := nfa.mkstate( SYM_EPSILON );

			if ( trlcontxt ) then
			    if ( varlength and (headcnt = 0) ) then
				-- both head and trail are variable-length
				variable_trail_rule := true;
			    else
				trailcnt := rulelen;
			    end if;
    	    	    	end if;
		        

when  28 =>
--#line  287

			varlength := true;

			
yyval := nfa.mkor( 
yy.value_stack(yy.tos-2), 
yy.value_stack(yy.tos) );
			

when  29 =>
--#line  294

			if ( transchar(lastst(
yy.value_stack(yy.tos))) /= SYM_EPSILON ) then
			    -- provide final transition \now/ so it
			    -- will be marked as a trailing context
			    -- state

			    
yy.value_stack(yy.tos) := nfa.link_machines( 
yy.value_stack(yy.tos), nfa.mkstate( SYM_EPSILON ) );
			end if;

			nfa.mark_beginning_as_normal( 
yy.value_stack(yy.tos) );
			current_state_enum := STATE_NORMAL;

			if ( previous_continued_action ) then
			    -- we need to treat this as variable trailing
			    -- context so that the backup does not happen
			    -- in the action but before the action switch
			    -- statement.  If the backup happens in the
			    -- action, then the rules "falling into" this
			    -- one's action will *also* do the backup,
			    -- erroneously.

			    	if ( (not varlength) or  headcnt /= 0 ) then
				     text_io.put( Standard_Error,
                              "alex: warning - trailing context rule at line");
                                     int_io.put(Standard_Error, linenum);
				     text_io.put( Standard_Error,
                           "made variable because of preceding '|' action" );
                                     int_io.put(Standard_Error, linenum);
    	    	    	    	end if;

			    -- mark as variable
			    varlength := true;
			    headcnt := 0;
    	    	    	end if;
			
			if ( varlength and (headcnt = 0) ) then
			    -- variable trailing context rule
			    -- mark the first part of the rule as the accepting
			    -- "head" part of a trailing context rule

			    -- by the way, we didn't do this at the beginning
			    -- of this production because back then
			    -- current_state_enum was set up for a trail
			    -- rule, and add_accept() can create a new
			    -- state ...

			    nfa.add_accept( 
yy.value_stack(yy.tos-1),
    	    	    	    	   misc.set_yy_trailing_head_mask(num_rules) );
    	    	    	end if;

			
yyval := nfa.link_machines( 
yy.value_stack(yy.tos-1), 
yy.value_stack(yy.tos) );
			

when  30 =>
--#line  348
 
yyval := 
yy.value_stack(yy.tos); 

when  31 =>
--#line  353

			-- this rule is separate from the others for "re" so
			-- that the reduction will occur before the trailing
			-- series is parsed

			if ( trlcontxt ) then
			    misc.synerr( "trailing context used twice" );
			else
			    trlcontxt := true;
			end if;    

			if ( varlength ) then
			    -- we hope the trailing context is fixed-length
			    varlength := false;
			else
			    headcnt := rulelen;
			end if;    

			rulelen := 0;

			current_state_enum := STATE_TRAILING_CONTEXT;
			
yyval := 
yy.value_stack(yy.tos-1);
			

when  32 =>
--#line  379

			-- this is where concatenation of adjacent patterns
			-- gets done

			
yyval := nfa.link_machines( 
yy.value_stack(yy.tos-1), 
yy.value_stack(yy.tos) );
			

when  33 =>
--#line  387
 
yyval := 
yy.value_stack(yy.tos); 

when  34 =>
--#line  391

			varlength := true;

			
yyval := nfa.mkclos( 
yy.value_stack(yy.tos-1) );
			

when  35 =>
--#line  398

			varlength := true;

			
yyval := nfa.mkposcl( 
yy.value_stack(yy.tos-1) );
			

when  36 =>
--#line  405

			varlength := true;

			
yyval := nfa.mkopt( 
yy.value_stack(yy.tos-1) );
			

when  37 =>
--#line  412

			varlength := true;

			if ( (
yy.value_stack(yy.tos-3) > 
yy.value_stack(yy.tos-1)) or (
yy.value_stack(yy.tos-3) < 0) ) then
			    misc.synerr( "bad iteration values" );
			    
yyval := 
yy.value_stack(yy.tos-5);
			else
			    if ( 
yy.value_stack(yy.tos-3) = 0 ) then
				
yyval := nfa.mkopt( nfa.mkrep( 
yy.value_stack(yy.tos-5), 
yy.value_stack(yy.tos-3), 
yy.value_stack(yy.tos-1) ) );
			    else
				
yyval := nfa.mkrep( 
yy.value_stack(yy.tos-5), 
yy.value_stack(yy.tos-3), 
yy.value_stack(yy.tos-1) );
			    end if;
    	    	    	end if;
			

when  38 =>
--#line  428

			varlength := true;

			if ( 
yy.value_stack(yy.tos-2) <= 0 ) then
			    misc.synerr( "iteration value must be positive" );
			    
yyval := 
yy.value_stack(yy.tos-4);
			else
			    
yyval := nfa.mkrep( 
yy.value_stack(yy.tos-4), 
yy.value_stack(yy.tos-2), INFINITY );
			end if;    
			

when  39 =>
--#line  440

			-- the singleton could be something like "(foo)",
			-- in which case we have no idea what its length
			-- is, so we punt here.

			varlength := true;

			if ( 
yy.value_stack(yy.tos-1) <= 0 ) then
			    misc.synerr( "iteration value must be positive" );
			    
yyval := 
yy.value_stack(yy.tos-3);
			else
			    
yyval := nfa.link_machines( 
yy.value_stack(yy.tos-3), nfa.copysingl( 
yy.value_stack(yy.tos-3), 
yy.value_stack(yy.tos-1) - 1 ) );
			end if;    
			

when  40 =>
--#line  456

			if ( not madeany ) then
			    -- create the '.' character class
			    anyccl := ccl.cclinit;
			    ccl.ccladd( anyccl, ASCII.LF );
			    ccl.cclnegate( anyccl );

			    if ( useecs ) then
				ecs.mkeccl(
		       ccltbl(cclmap(anyccl)..cclmap(anyccl) + ccllen(anyccl)),
					ccllen(anyccl), nextecm,
					ecgroup, CSIZE );
			    end if;
			    madeany := true;
    	    	    	end if;

			rulelen := rulelen + 1;

			
yyval := nfa.mkstate( -anyccl );
			

when  41 =>
--#line  478

			if ( not cclsorted ) then
			    -- sort characters for fast searching.  We use a
			    -- shell sort since this list could be large.

--			    misc.cshell( ccltbl + cclmap($1), ccllen($1) );
		      misc.cshell( ccltbl(cclmap(
yy.value_stack(yy.tos))..cclmap(
yy.value_stack(yy.tos)) + ccllen(
yy.value_stack(yy.tos))),
				   ccllen(
yy.value_stack(yy.tos)) );
			end if;

			if ( useecs ) then
		    ecs.mkeccl( ccltbl(cclmap(
yy.value_stack(yy.tos))..cclmap(
yy.value_stack(yy.tos)) + ccllen(
yy.value_stack(yy.tos))),
				ccllen(
yy.value_stack(yy.tos)),nextecm, ecgroup, CSIZE );
			end if;
				     
			rulelen := rulelen + 1;

			
yyval := nfa.mkstate( -
yy.value_stack(yy.tos) );
			

when  42 =>
--#line  499

			rulelen := rulelen + 1;

			
yyval := nfa.mkstate( -
yy.value_stack(yy.tos) );
			

when  43 =>
--#line  506
 
yyval := 
yy.value_stack(yy.tos-1); 

when  44 =>
--#line  509
 
yyval := 
yy.value_stack(yy.tos-1); 

when  45 =>
--#line  512

			rulelen := rulelen + 1;

			if ( 
yy.value_stack(yy.tos) = CHARACTER'POS(ASCII.NUL) ) then
			    misc.synerr( "null in rule" );
			end if;    

			if ( caseins and (
yy.value_stack(yy.tos) >= CHARACTER'POS('A')) and (
yy.value_stack(yy.tos) <= CHARACTER'POS('Z')) ) then
			    
yy.value_stack(yy.tos) := misc.clower( 
yy.value_stack(yy.tos) );
			end if;

			
yyval := nfa.mkstate( 
yy.value_stack(yy.tos) );
			

when  46 =>
--#line  528
 
yyval := 
yy.value_stack(yy.tos-1); 

when  47 =>
--#line  531

			-- *Sigh* - to be compatible Unix lex, negated ccls
			-- match newlines
			ccl.cclnegate( 
yy.value_stack(yy.tos-1) );
			
yyval := 
yy.value_stack(yy.tos-1);
			

when  48 =>
--#line  540

			if ( 
yy.value_stack(yy.tos-2) > 
yy.value_stack(yy.tos) ) then
			    misc.synerr( "negative range in character class" );
			else
			    if ( caseins ) then
				if ( (
yy.value_stack(yy.tos-2) >= CHARACTER'POS('A')) and (
yy.value_stack(yy.tos-2) <= CHARACTER'POS('Z')) ) then
				    
yy.value_stack(yy.tos-2) := misc.clower( 
yy.value_stack(yy.tos-2) );
				end if;					    
				if ( (
yy.value_stack(yy.tos) >= CHARACTER'POS('A')) and (
yy.value_stack(yy.tos) <= CHARACTER'POS('Z')) ) then
				    
yy.value_stack(yy.tos) := misc.clower( 
yy.value_stack(yy.tos) );
				end if;    
    	    	    	    end if;

			    for i in 
yy.value_stack(yy.tos-2) .. 
yy.value_stack(yy.tos) loop
			        ccl.ccladd( 
yy.value_stack(yy.tos-3), CHARACTER'VAL(i) );
    	    	    	    end loop;
			    
			    -- keep track if this ccl is staying in
			    -- alphabetical order

			    cclsorted := cclsorted and (
yy.value_stack(yy.tos-2) > lastchar);
			    lastchar := 
yy.value_stack(yy.tos);
    	    	    	end if;
			
			
yyval := 
yy.value_stack(yy.tos-3);
			

when  49 =>
--#line  568

			if ( caseins ) then
			    if ( (
yy.value_stack(yy.tos) >= CHARACTER'POS('A')) and (
yy.value_stack(yy.tos) <= CHARACTER'POS('Z')) ) then
				
yy.value_stack(yy.tos) := misc.clower( 
yy.value_stack(yy.tos) );
    	    	    	    end if;
			end if;    
			ccl.ccladd( 
yy.value_stack(yy.tos-1), CHARACTER'VAL(
yy.value_stack(yy.tos)) );
			cclsorted := cclsorted and (
yy.value_stack(yy.tos) > lastchar);
			lastchar := 
yy.value_stack(yy.tos);
			
yyval := 
yy.value_stack(yy.tos-1);
			

when  50 =>
--#line  581

			cclsorted := true;
			lastchar := 0;
			
yyval := ccl.cclinit;
			

when  51 =>
--#line  589

			if ( caseins ) then
			    if ( (
yy.value_stack(yy.tos) >= CHARACTER'POS('A')) and (
yy.value_stack(yy.tos) <= CHARACTER'POS('Z')) ) then
				
yy.value_stack(yy.tos) := misc.clower( 
yy.value_stack(yy.tos) );
			    end if;
			end if;    

			rulelen := rulelen + 1;

			
yyval := nfa.link_machines( 
yy.value_stack(yy.tos-1), nfa.mkstate( 
yy.value_stack(yy.tos) ) );
			

when  52 =>
--#line  602
 
yyval := nfa.mkstate( SYM_EPSILON ); 

                    when others => null;
                end case;


            -- Pop RHS states and goto next state
            yy.tos      := yy.tos - rule_length(yy.rule_id) + 1;
            if yy.tos > yy.stack_size then
                text_io.put_line(" Stack size exceeded on state_stack");
                raise yy_Tokens.syntax_error;
            end if;
            yy.state_stack(yy.tos) := goto_state(yy.state_stack(yy.tos-1) ,
                                 get_lhs_rule(yy.rule_id));

              yy.value_stack(yy.tos) := yyval;

            if yy.debug then
                reduce_debug(yy.rule_id,
                    goto_state(yy.state_stack(yy.tos - 1),
                               get_lhs_rule(yy.rule_id)));
            end if;

        end if;


    end loop;


end yyparse;
end Aflex_parser;

pragma Warnings(Off);
pragma Style_Checks(Off);


with Parse_Tokens, Parse_Goto, Parse_Shift_Reduce, Text_IO, scanner;
with NFA, ccl, Aflex_misc, misc_defs, sym, ecs, aflex_scanner;
with tstring, int_io, main_body, text_io, external_file_manager;
use aflex_scanner, external_file_manager;

package Aflex_parser is
  package misc renames Aflex_misc;
  procedure build_eof_action;
  procedure yyerror(msg: string);
  procedure YYParse;
  def_rule:integer;
end Aflex_parser;

pragma Warnings(Off);
pragma Style_Checks(Off);

with ascan_dfa; use ascan_dfa; 
package body ascan_dfa is
function YYText return string is
    i : integer;
    str_loc : integer := 1;
    buffer : string(1..1024);
    EMPTY_STRING : constant string := "";
begin
    -- find end of buffer
    i := yytext_ptr;
    while ( yy_ch_buf(i) /= ASCII.NUL ) loop
    buffer(str_loc ) := yy_ch_buf(i);
        i := i + 1;
    str_loc := str_loc + 1;
    end loop;
--    return yy_ch_buf(yytext_ptr.. i - 1);

    if (str_loc < 2) then
        return EMPTY_STRING;
    else
      return buffer(1..str_loc-1);
    end if;

end;

-- returns the length of the matched text
function YYLength return integer is
begin
    return yy_cp - yy_bp;
end YYLength;

-- done after the current pattern has been matched and before the
-- corresponding action - sets up yytext

procedure YY_DO_BEFORE_ACTION is
begin
    yytext_ptr := yy_bp;
    yy_hold_char := yy_ch_buf(yy_cp);
    yy_ch_buf(yy_cp) := ASCII.NUL;
    yy_c_buf_p := yy_cp;
end YY_DO_BEFORE_ACTION;

end ascan_dfa;

pragma Warnings(Off);
pragma Style_Checks(Off);

package ascan_dfa is
aflex_debug : boolean := false;
yytext_ptr : integer; -- points to start of yytext in buffer

-- yy_ch_buf has to be 2 characters longer than YY_BUF_SIZE because we need
-- to put in 2 end-of-buffer characters (this is explained where it is
-- done) at the end of yy_ch_buf
YY_READ_BUF_SIZE : constant integer :=  8192;
YY_BUF_SIZE : constant integer := YY_READ_BUF_SIZE * 2; -- size of input buffer
type unbounded_character_array is array(integer range <>) of character;
subtype ch_buf_type is unbounded_character_array(0..YY_BUF_SIZE + 1);
yy_ch_buf : ch_buf_type;
yy_cp, yy_bp : integer;

-- yy_hold_char holds the character lost when yytext is formed
yy_hold_char : character;
yy_c_buf_p : integer;   -- points to current character in buffer

function YYText return string;
function YYLength return integer;
procedure YY_DO_BEFORE_ACTION;
--These variables are needed between calls to YYLex.
yy_init : boolean := true; -- do we need to initialize YYLex?
yy_start : integer := 0; -- current start state number
subtype yy_state_type is integer;
yy_last_accepting_state : yy_state_type;
yy_last_accepting_cpos : integer;
end ascan_dfa;

pragma Warnings(Off);
pragma Style_Checks(Off);

package body ascan_io is
-- gets input and stuffs it into 'buf'.  number of characters read, or YY_NULL,
-- is returned in 'result'.

procedure YY_INPUT(buf: out unbounded_character_array; result: out integer; max_size: in integer) is
    c : character;
    i : integer := 1;
    loc : integer := buf'first;
begin

    if (is_open(user_input_file)) then
      while ( i <= max_size ) loop
         if (end_of_line(user_input_file)) then -- Ada ate our newline, put it back on the end.
             buf(loc) := ASCII.LF;
             skip_line(user_input_file, 1);
         else
-- UCI CODES CHANGED:
--    The following codes are modified. Previous codes is commented out.
--    The purpose of doing this is to make it possible to set Temp_Line
--    in Ayacc-extension specific codes. Definitely, we can read the character
--    into the Temp_Line and then set the buf. But Temp_Line will only
--    be used in Ayacc-extension specific codes which makes this approach impossible.
           get(user_input_file, c);
           buf(loc) := c;
--         get(user_input_file, buf(loc));
         end if;

         loc := loc + 1;
         i := i + 1;
      end loop;
    else
      while ( i <= max_size ) loop
         if (end_of_line) then -- Ada ate our newline, put it back on the end.
             buf(loc) := ASCII.LF;
             skip_line(1);

         else
--    The following codes are modified. Previous codes is commented out.
--    The purpose of doing this is to make it possible to set Temp_Line
--    in Ayacc-extension specific codes. Definitely, we can read the character
--    into the Temp_Line and then set the buf. But Temp_Line will only
--    be used in Ayacc-extension specific codes which makes this approach impossible.
           get(c);
           buf(loc) := c;
--         get(buf(loc));
         end if; 

         loc := loc + 1;
         i := i + 1;
      end loop;
    end if; -- for input file being standard input

    result := i - 1; 
    exception
        when END_ERROR => result := i - 1;
    -- when we hit EOF we need to set yy_eof_has_been_seen
    yy_eof_has_been_seen := true;
end YY_INPUT;

-- yy_get_next_buffer - try to read in new buffer
--
-- returns a code representing an action
--     EOB_ACT_LAST_MATCH - 
--     EOB_ACT_RESTART_SCAN - restart the scanner
--     EOB_ACT_END_OF_FILE - end of file

function yy_get_next_buffer return eob_action_type is
    dest : integer := 0;
    source : integer := yytext_ptr - 1; -- copy prev. char, too
    number_to_move : integer;
    ret_val : eob_action_type;
    num_to_read : integer;
begin    
    if ( yy_c_buf_p > yy_n_chars + 1 ) then
        raise NULL_IN_INPUT;
    end if;

    -- try to read more data

    -- first move last chars to start of buffer
    number_to_move := yy_c_buf_p - yytext_ptr;

    for i in 0..number_to_move - 1 loop
        yy_ch_buf(dest) := yy_ch_buf(source);
    dest := dest + 1;
    source := source + 1;
    end loop;
        
    if ( yy_eof_has_been_seen ) then
    -- don't do the read, it's not guaranteed to return an EOF,
    -- just force an EOF

    yy_n_chars := 0;
    else
    num_to_read := YY_BUF_SIZE - number_to_move - 1;

    if ( num_to_read > YY_READ_BUF_SIZE ) then
        num_to_read := YY_READ_BUF_SIZE;
        end if;

    -- read in more data
    YY_INPUT( yy_ch_buf(number_to_move..yy_ch_buf'last), yy_n_chars, num_to_read );
    end if;
    if ( yy_n_chars = 0 ) then
    if ( number_to_move = 1 ) then
        ret_val := EOB_ACT_END_OF_FILE;
    else
        ret_val := EOB_ACT_LAST_MATCH;
        end if;

    yy_eof_has_been_seen := true;
    else
    ret_val := EOB_ACT_RESTART_SCAN;
    end if;
    
    yy_n_chars := yy_n_chars + number_to_move;
    yy_ch_buf(yy_n_chars) := YY_END_OF_BUFFER_CHAR;
    yy_ch_buf(yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;

    -- yytext begins at the second character in
    -- yy_ch_buf; the first character is the one which
    -- preceded it before reading in the latest buffer;
    -- it needs to be kept around in case it's a
    -- newline, so yy_get_previous_state() will have
    -- with '^' rules active

    yytext_ptr := 1;

    return ret_val;
end yy_get_next_buffer;

procedure yyunput( c : character; yy_bp: in out integer ) is
    number_to_move : integer;
    dest : integer;
    source : integer;
    tmp_yy_cp : integer;
begin
    tmp_yy_cp := yy_c_buf_p;
    yy_ch_buf(tmp_yy_cp) := yy_hold_char; -- undo effects of setting up yytext

    if ( tmp_yy_cp < 2 ) then
    -- need to shift things up to make room
    number_to_move := yy_n_chars + 2; -- +2 for EOB chars
    dest := YY_BUF_SIZE + 2;
    source := number_to_move;

    while ( source > 0 ) loop
        dest := dest - 1;
        source := source - 1;
            yy_ch_buf(dest) := yy_ch_buf(source);
    end loop;

    tmp_yy_cp := tmp_yy_cp + dest - source;
    yy_bp := yy_bp + dest - source;
    yy_n_chars := YY_BUF_SIZE;

    if ( tmp_yy_cp < 2 ) then
        raise PUSHBACK_OVERFLOW;
    end if;
    end if;

    if ( tmp_yy_cp > yy_bp and then yy_ch_buf(tmp_yy_cp-1) = ASCII.LF ) then
    yy_ch_buf(tmp_yy_cp-2) := ASCII.LF;
    end if;

    tmp_yy_cp := tmp_yy_cp - 1;
    yy_ch_buf(tmp_yy_cp) := c;

--  Note:  this code is the text of YY_DO_BEFORE_ACTION, only
--         here we get different yy_cp and yy_bp's
    yytext_ptr := yy_bp;
    yy_hold_char := yy_ch_buf(tmp_yy_cp);
    yy_ch_buf(tmp_yy_cp) := ASCII.NUL;
    yy_c_buf_p := tmp_yy_cp;
end yyunput;

procedure unput(c : character) is
begin
     yyunput( c, yy_bp );
end unput;

function input return character is
    c : character;
    yy_cp : integer := yy_c_buf_p;
begin
    yy_ch_buf(yy_cp) := yy_hold_char;

    if ( yy_ch_buf(yy_c_buf_p) = YY_END_OF_BUFFER_CHAR ) then
    -- need more input
    yytext_ptr := yy_c_buf_p;
    yy_c_buf_p := yy_c_buf_p + 1;

    case yy_get_next_buffer is
        -- this code, unfortunately, is somewhat redundant with
        -- that above

        when EOB_ACT_END_OF_FILE =>
        if ( yywrap ) then
            yy_c_buf_p := yytext_ptr;
            return ASCII.NUL;
        end if;

        yy_ch_buf(0) := ASCII.LF;
        yy_n_chars := 1;
        yy_ch_buf(yy_n_chars) := YY_END_OF_BUFFER_CHAR;
        yy_ch_buf(yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;
        yy_eof_has_been_seen := false;
        yy_c_buf_p := 1;
        yytext_ptr := yy_c_buf_p;
        yy_hold_char := yy_ch_buf(yy_c_buf_p);

        return ( input );
        when EOB_ACT_RESTART_SCAN =>
        yy_c_buf_p := yytext_ptr;

        when EOB_ACT_LAST_MATCH =>
        raise UNEXPECTED_LAST_MATCH;
        when others => null;
        end case;
    end if;

    c := yy_ch_buf(yy_c_buf_p);
    yy_c_buf_p := yy_c_buf_p + 1;
    yy_hold_char := yy_ch_buf(yy_c_buf_p);

    return c;
end input;

procedure output(c : character) is
begin
    if (is_open(user_output_file)) then
      text_io.put(user_output_file, c);
    else
      text_io.put(c);
    end if;
end output;

-- default yywrap function - always treat EOF as an EOF
function yywrap return boolean is
begin
    return true;
end yywrap;

procedure Open_Input(fname : in String) is
begin
    yy_init := true;
    open(user_input_file, in_file, fname);
end Open_Input;

procedure Create_Output(fname : in String := "") is
begin
    if (fname /= "") then
        create(user_output_file, out_file, fname);
    end if;
end Create_Output;

procedure Close_Input is
begin
   if (is_open(user_input_file)) then
     text_io.close(user_input_file);
   end if;
end Close_Input;

procedure Close_Output is
begin
   if (is_open(user_output_file)) then
     text_io.close(user_output_file);
   end if;
end Close_Output;


end ascan_io;

pragma Warnings(Off);
pragma Style_Checks(Off);

with ascan_dfa; use ascan_dfa; 
with text_io; use text_io;

package ascan_io is
user_input_file : file_type;
user_output_file : file_type;
NULL_IN_INPUT : exception;
AFLEX_INTERNAL_ERROR : exception;
UNEXPECTED_LAST_MATCH : exception;
PUSHBACK_OVERFLOW : exception;
AFLEX_SCANNER_JAMMED : exception;
type eob_action_type is ( EOB_ACT_RESTART_SCAN,
                          EOB_ACT_END_OF_FILE,
                          EOB_ACT_LAST_MATCH );
YY_END_OF_BUFFER_CHAR :  constant character:=  ASCII.NUL;
yy_n_chars : integer;       -- number of characters read into yy_ch_buf

-- true when we've seen an EOF for the current input file
yy_eof_has_been_seen : boolean;


procedure YY_INPUT(buf: out unbounded_character_array; result: out integer; max_size: in integer);
function yy_get_next_buffer return eob_action_type;
procedure yyunput( c : character; yy_bp: in out integer );
procedure unput(c : character);
function input return character;
procedure output(c : character);
function yywrap return boolean;
procedure Open_Input(fname : in String);
procedure Close_Input;
procedure Create_Output(fname : in String := "");
procedure Close_Output;


end ascan_io;

pragma Warnings(Off);
pragma Style_Checks(Off);

package Parse_Goto is

    type Small_Integer is range -32_000 .. 32_000;

    type Goto_Entry is record
        Nonterm  : Small_Integer;
        Newstate : Small_Integer;
    end record;

  --pragma suppress(index_check);

    subtype Row is Integer range -1 .. Integer'Last;

    type Goto_Parse_Table is array (Row range <>) of Goto_Entry;

    Goto_Matrix : constant Goto_Parse_Table :=
       ((-1,-1)  -- Dummy Entry.
-- State  0
,(-3, 1),(-2, 2)
-- State  1
,(-4, 3)
-- State  2

-- State  3
,(-8, 10)
,(-5, 9)
-- State  4

-- State  5

-- State  6

-- State  7

-- State  8

-- State  9
,(-6, 12)
-- State  10

-- State  11

-- State  12
,(-7, 14)
-- State  13
,(-9, 15)

-- State  14
,(-18, 28),(-17, 26),(-16, 24),(-15, 25)
,(-12, 20),(-11, 18),(-10, 34)
-- State  15

-- State  16

-- State  17

-- State  18
,(-18, 28)
,(-17, 26),(-16, 24),(-15, 25),(-12, 37)

-- State  19
,(-18, 28),(-17, 26),(-16, 24),(-15, 25)
,(-12, 40)
-- State  20
,(-13, 42)
-- State  21

-- State  22

-- State  23
,(-14, 45)
-- State  24
,(-18, 28)
,(-17, 26),(-15, 48)
-- State  25
,(-18, 28),(-17, 49)

-- State  26

-- State  27

-- State  28

-- State  29

-- State  30
,(-19, 54)
-- State  31
,(-18, 28),(-17, 26),(-16, 24)
,(-15, 25),(-12, 55)
-- State  32

-- State  33
,(-20, 56)
-- State  34

-- State  35

-- State  36

-- State  37
,(-13, 60)

-- State  38
,(-18, 28),(-17, 26),(-16, 24),(-15, 25)
,(-12, 61)
-- State  39

-- State  40
,(-13, 62)
-- State  41

-- State  42

-- State  43
,(-18, 28),(-17, 26)
,(-15, 63)
-- State  44

-- State  45

-- State  46

-- State  47

-- State  48
,(-18, 28),(-17, 49)
-- State  49

-- State  50

-- State  51

-- State  52

-- State  53

-- State  54

-- State  55

-- State  56

-- State  57
,(-20, 72)

-- State  58

-- State  59

-- State  60

-- State  61
,(-13, 73)
-- State  62

-- State  63
,(-18, 28),(-17, 49)
-- State  64

-- State  65

-- State  66

-- State  67

-- State  68

-- State  69

-- State  70

-- State  71

-- State  72

-- State  73

-- State  74

-- State  75

-- State  76

-- State  77

-- State  78

-- State  79

-- State  80

-- State  81

-- State  82

);
--  The offset vector
GOTO_OFFSET : array (0.. 82) of Integer :=
( 0,
 2, 3, 3, 5, 5, 5, 5, 5, 5, 6,
 6, 6, 7, 8, 15, 15, 15, 15, 20, 25,
 26, 26, 26, 27, 30, 32, 32, 32, 32, 32,
 33, 38, 38, 39, 39, 39, 39, 40, 45, 45,
 46, 46, 46, 49, 49, 49, 49, 49, 51, 51,
 51, 51, 51, 51, 51, 51, 51, 52, 52, 52,
 52, 53, 53, 55, 55, 55, 55, 55, 55, 55,
 55, 55, 55, 55, 55, 55, 55, 55, 55, 55,
 55, 55);

subtype Rule        is Natural;
subtype Nonterminal is Integer;

   Rule_Length : array (Rule range  0 ..  52) of Natural := ( 2,
 5, 0, 5, 0, 2, 1, 1, 1,
 3, 1, 1, 4, 0, 0, 4, 3,
 3, 2, 2, 1, 1, 3, 3, 1,
 1, 1, 0, 3, 2, 1, 2, 2,
 1, 2, 2, 2, 6, 5, 4, 1,
 1, 1, 3, 3, 1, 3, 4, 4,
 2, 0, 2, 0);
   Get_LHS_Rule: array (Rule range  0 ..  52) of Nonterminal := (-1,
-2,-3,-4,-4,-4,-5,-8,-8,
-9,-9,-9,-6,-6,-7,-10,-10,
-10,-10,-10,-10,-10,-11,-14,-14,
-14,-13,-13,-12,-12,-12,-16,-15,
-15,-17,-17,-17,-17,-17,-17,-17,
-17,-17,-17,-17,-17,-18,-18,-20,
-20,-20,-19,-19);
end Parse_Goto;

pragma Warnings(Off);
pragma Style_Checks(Off);

package Parse_Shift_Reduce is

    type Small_Integer is range -32_000 .. 32_000;

    type Shift_Reduce_Entry is record
        T   : Small_Integer;
        Act : Small_Integer;
    end record;
    pragma Pack(Shift_Reduce_Entry);

    subtype Row is Integer range -1 .. Integer'Last;

  --pragma suppress(index_check);

    type Shift_Reduce_Array is array (Row  range <>) of Shift_Reduce_Entry;

    Shift_Reduce_Matrix : constant Shift_Reduce_Array :=
        ( (-1,-1) -- Dummy Entry

-- state  0
,(-1,-2)
-- state  1
,( 1, 4),(-1,-4)
-- state  2
,( 0,-1001)
,(-1,-1000)
-- state  3
,( 4, 6),( 5, 7),( 6, 8)
,(-1,-1000)
-- state  4
,( 11, 11),(-1,-1000)
-- state  5
,(-1,-1000)

-- state  6
,(-1,-6)
-- state  7
,(-1,-7)
-- state  8
,(-1,-8)
-- state  9
,(-1,-13)

-- state  10
,( 7, 13),(-1,-1000)
-- state  11
,(-1,-5)
-- state  12
,(-1,-14)

-- state  13
,( 1, 17),( 8, 16),(-1,-1000)
-- state  14
,( 1, 22)
,( 2, 32),( 9, 29),( 10, 21),( 12, 19)
,( 13, 23),( 24, 27),( 25, 30),( 26, 31)
,( 28, 33),(-1,-1)
-- state  15
,( 7, 36),( 11, 35)
,(-1,-1000)
-- state  16
,(-1,-10)
-- state  17
,(-1,-11)
-- state  18
,( 2, 32)
,( 9, 29),( 10, 39),( 12, 38),( 24, 27)
,( 25, 30),( 26, 31),( 28, 33),(-1,-1000)

-- state  19
,( 2, 32),( 9, 29),( 24, 27),( 25, 30)
,( 26, 31),( 28, 33),(-1,-1000)
-- state  20
,( 16, 41)
,( 17, 43),( 18, 44),(-1,-27)
-- state  21
,(-1,-20)

-- state  22
,(-1,-21)
-- state  23
,( 1, 47),( 8, 46),(-1,-1000)

-- state  24
,( 2, 32),( 9, 29),( 24, 27),( 25, 30)
,( 26, 31),( 28, 33),(-1,-1000)
-- state  25
,( 2, 32)
,( 9, 29),( 24, 27),( 25, 30),( 26, 31)
,( 28, 33),(-1,-30)
-- state  26
,( 19, 50),( 20, 51)
,( 21, 52),( 22, 53),(-1,-33)
-- state  27
,(-1,-40)

-- state  28
,(-1,-41)
-- state  29
,(-1,-42)
-- state  30
,(-1,-52)
-- state  31
,( 2, 32)
,( 9, 29),( 24, 27),( 25, 30),( 26, 31)
,( 28, 33),(-1,-1000)
-- state  32
,(-1,-45)
-- state  33
,( 12, 57)
,(-1,-50)
-- state  34
,( 11, 58),(-1,-1000)
-- state  35
,(-1,-3)

-- state  36
,( 8, 59),(-1,-1000)
-- state  37
,( 16, 41),( 17, 43)
,( 18, 44),(-1,-27)
-- state  38
,( 2, 32),( 9, 29)
,( 24, 27),( 25, 30),( 26, 31),( 28, 33)
,(-1,-1000)
-- state  39
,(-1,-19)
-- state  40
,( 16, 41),( 17, 43)
,( 18, 44),(-1,-27)
-- state  41
,(-1,-26)
-- state  42
,(-1,-18)

-- state  43
,( 2, 32),( 9, 29),( 24, 27),( 25, 30)
,( 26, 31),( 28, 33),(-1,-1000)
-- state  44
,(-1,-31)

-- state  45
,( 14, 64),( 15, 65),(-1,-1000)
-- state  46
,(-1,-24)

-- state  47
,(-1,-25)
-- state  48
,( 2, 32),( 9, 29),( 24, 27)
,( 25, 30),( 26, 31),( 28, 33),(-1,-29)

-- state  49
,( 19, 50),( 20, 51),( 21, 52),( 22, 53)
,(-1,-32)
-- state  50
,(-1,-34)
-- state  51
,(-1,-35)
-- state  52
,(-1,-36)

-- state  53
,( 3, 66),(-1,-1000)
-- state  54
,( 2, 68),( 25, 67)
,(-1,-1000)
-- state  55
,( 17, 43),( 18, 44),( 27, 69)
,(-1,-1000)
-- state  56
,( 2, 71),( 29, 70),(-1,-1000)

-- state  57
,(-1,-50)
-- state  58
,(-1,-12)
-- state  59
,(-1,-9)
-- state  60
,(-1,-16)

-- state  61
,( 16, 41),( 17, 43),( 18, 44),(-1,-27)

-- state  62
,(-1,-17)
-- state  63
,( 2, 32),( 9, 29),( 24, 27)
,( 25, 30),( 26, 31),( 28, 33),(-1,-28)

-- state  64
,(-1,-22)
-- state  65
,( 8, 74),(-1,-1000)
-- state  66
,( 15, 75)
,( 23, 76),(-1,-1000)
-- state  67
,(-1,-43)
-- state  68
,(-1,-51)

-- state  69
,(-1,-44)
-- state  70
,(-1,-46)
-- state  71
,( 30, 77),(-1,-49)

-- state  72
,( 2, 71),( 29, 78),(-1,-1000)
-- state  73
,(-1,-15)

-- state  74
,(-1,-23)
-- state  75
,( 3, 79),( 23, 80),(-1,-1000)

-- state  76
,(-1,-39)
-- state  77
,( 2, 81),(-1,-1000)
-- state  78
,(-1,-47)

-- state  79
,( 23, 82),(-1,-1000)
-- state  80
,(-1,-38)
-- state  81
,(-1,-48)

-- state  82
,(-1,-37)
);
--  The offset vector
SHIFT_REDUCE_OFFSET : array (0.. 82) of Integer :=
( 0,
 1, 3, 5, 9, 11, 12, 13, 14, 15, 16,
 18, 19, 20, 23, 34, 37, 38, 39, 48, 55,
 59, 60, 61, 64, 71, 78, 83, 84, 85, 86,
 87, 94, 95, 97, 99, 100, 102, 106, 113, 114,
 118, 119, 120, 127, 128, 131, 132, 133, 140, 145,
 146, 147, 148, 150, 153, 157, 160, 161, 162, 163,
 164, 168, 169, 176, 177, 179, 182, 183, 184, 185,
 186, 188, 191, 192, 193, 196, 197, 199, 200, 202,
 203, 204);
end Parse_Shift_Reduce;

pragma Warnings(Off);
pragma Style_Checks(Off);

with  Text_Io;
with  Ccl;
with  Nfa;
with  Parse_Shift_Reduce;
with  Parse_Goto;
with  Misc_Defs;
use   Misc_Defs;
with  External_File_Manager;
use   External_File_Manager;
package Parse_Tokens is


  subtype YYSType is Integer;

    YYLVal, YYVal : YYSType; 
    type Token is
        (End_Of_Input, Error, Char, Number,
         Sectend, Scdecl, Xscdecl,
         Whitespace, Name, Prevccl,
         Eof_Op, Newline, '^',
         '<', '>', ',',
         '$', '|', '/',
         '*', '+', '?',
         '{', '}', '.',
         '"', '(', ')',
         '[', ']', '-' );

    Syntax_Error : exception;

end Parse_Tokens;

pragma Warnings(Off);
pragma Style_Checks(Off);


package body scanner is

beglin : boolean := false;
i, bracelevel: integer;

function get_token return Token is
    toktype : Token;
    didadef, indented_code : boolean;
    cclval : integer;
    nmdefptr : vstring;
    nmdef, tmpbuf : vstring;

procedure ACTION_ECHO is
begin
    text_io.put( temp_action_file, yytext(1..YYLength) );
end ACTION_ECHO;

procedure MARK_END_OF_PROLOG is
begin
     text_io.put( temp_action_file, "%%%% end of prolog" );
     text_io.new_line( temp_action_file );
end MARK_END_OF_PROLOG;

procedure PUT_BACK_STRING(str : vstring; start : integer) is
begin
	for i in reverse start+1..tstring.len(str) loop
	    unput( CHAR(str,i) );
	end loop;
end PUT_BACK_STRING;

function check_yylex_here return boolean is
begin
	return ( (yytext'length >= 2) and then
			((yytext(1) = '#') and (yytext(2) = '#')));
end check_yylex_here;

function YYLex return Token is
subtype short is integer range -32768..32767;
    yy_act : integer;
    yy_c : short;

-- returned upon end-of-file
YY_END_TOK : constant integer := 0;
YY_END_OF_BUFFER : constant := 82;
subtype yy_state_type is integer;
yy_current_state : yy_state_type;
INITIAL : constant := 0;
SECT2 : constant := 1;
SECT2PROLOG : constant := 2;
SECT3 : constant := 3;
PICKUPDEF : constant := 4;
SC : constant := 5;
CARETISBOL : constant := 6;
NUM : constant := 7;
QUOTE : constant := 8;
FIRSTCCL : constant := 9;
CCL : constant := 10;
ACTION : constant := 11;
RECOVER : constant := 12;
BRACEERROR : constant := 13;
ACTION_STRING : constant := 14;
yy_accept : constant array(0..206) of short :=
    (   0,
        0,    0,    0,    0,    0,    0,   80,   80,    0,    0,
        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
       82,   13,    6,   12,   10,    1,   11,   13,   13,   13,
        9,   39,   31,   32,   25,   39,   38,   23,   39,   39,
       39,   31,   21,   39,   39,   24,   81,   19,   80,   80,
       15,   14,   16,   45,   81,   41,   42,   44,   46,   60,
       61,   58,   57,   59,   47,   49,   48,   47,   53,   52,
       53,   53,   55,   55,   55,   56,   66,   71,   70,   72,
       66,   72,   67,   64,   65,   81,   17,   63,   62,   73,

       75,   76,   77,    6,   12,   10,    1,   11,    0,    0,
        2,    0,    7,    4,    5,    0,    9,   31,   32,    0,
       28,    0,    0,    0,   78,   78,   27,   26,   27,    0,
       31,   21,    0,    0,   35,    0,    0,   19,   18,   80,
       80,   15,   14,   43,   44,   57,   79,   79,   50,   51,
       54,   66,    0,   69,    0,   66,   67,    0,   17,   73,
       74,    0,    7,    0,    0,    3,    0,   29,    0,   36,
        0,   78,   27,   27,   37,    0,    0,    0,   35,    0,
       30,   79,   66,   68,    0,    0,    8,    0,    0,    0,
        0,    0,    0,    0,    0,    0,    0,   22,    0,   22,

        0,   22,    4,    0,   34,    0
    ) ;

------MOD changed bounds
yy_ec : constant array(ASCII.NUL..ASCII.DEL) of short :=
    (   0,
        1,    1,    1,    1,    1,    1,    1,    1,    2,    3,
        1,    4,    1,    1,    1,    1,    1,    1,    1,    1,
        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
        1,    5,    1,    6,    7,    8,    9,    1,   10,   11,
       11,   11,   11,   12,   13,   11,   14,   15,   15,   15,
       15,   15,   15,   15,   15,   15,   15,    1,    1,   16,
        1,   17,   11,    1,   23,   22,   22,   22,   24,   25,
       22,   22,   22,   22,   22,   22,   22,   22,   26,   22,
       22,   27,   28,   29,   22,   22,   22,   30,   22,   22,
       18,   19,   20,   21,   22,    1,   23,   22,   22,   22,

       24,   25,   22,   22,   22,   22,   22,   22,   22,   22,
       26,   22,   22,   27,   28,   29,   22,   22,   22,   30,
       22,   22,   31,   32,   33,    1,    1
    ) ;

yy_meta : constant array(0..33) of short :=
    (   0,
        1,    2,    3,    2,    2,    4,    1,    1,    1,    5,
        1,    1,    6,    5,    7,    1,    1,    1,    8,    9,
        1,   10,   10,   10,   10,   10,   10,   10,   10,   10,
        5,   11,   12
    ) ;

yy_base : constant array(0..254) of short :=
    (   0,
        0,   29,   58,   89,  503,  499,  498,  305,    4,    8,
      119,  147,  286,  285,   32,   34,   65,   67,   93,   96,
      110,  113,  177,    0,  302,  301,   12,   15,   82,  121,
      303,  880,   76,  880,    0,   37,  880,  299,   11,  288,
        0,  880,   11,  880,  880,   14,  880,  284,  280,  283,
      196,  225,  880,  288,  283,  880,  292,    0,  291,  880,
        0,  133,  880,  880,  880,  880,  272,    0,  880,  880,
      880,  880,  277,  880,  880,  880,  880,  276,  880,  880,
      274,  275,  880,    0,  272,  880,    0,  880,  880,  109,
      273,  880,    0,  880,  880,  282,  880,  880,  880,    0,

      880,  880,    0,  149,  880,    0,  152,  880,  271,  280,
      880,  272,    0,  247,  880,  263,    0,   72,  880,  262,
      880,  240,   63,  119,  880,  248,    0,  880,  245,  249,
      277,  880,  248,  153,    0,  256,  253,    0,  880,  252,
      880,    0,  156,  880,    0,  239,  880,  238,  880,  880,
      880,    0,  221,  880,    0,  309,    0,  249,  880,    0,
      880,  248,    0,  227,  246,  880,  245,  880,  221,  880,
      148,  231,    0,    0,  880,  232,  229,  230,    0,  241,
      880,  226,    0,  880,  236,  234,  880,  209,  210,  197,
      231,  212,  159,  128,  108,  194,  115,  880,  108,  880,

       84,  880,  880,    4,  880,  880,  342,  354,  366,  378,
      390,  402,  414,  426,  438,  450,  462,  474,  486,  493,
      502,  508,  520,  527,  536,  547,  559,  571,  583,  595,
      607,  619,  631,  638,  648,  660,  672,  684,  695,  702,
      712,  724,  736,  748,  760,  772,  784,  795,  807,  819,
      831,  843,  855,  867
    ) ;

yy_def : constant array(0..254) of short :=
    (   0,
      207,  207,  208,  208,  209,  209,  210,  210,  211,  211,
      212,  212,  213,  213,  214,  214,  215,  215,  216,  216,
      217,  217,  206,   23,  218,  218,  213,  213,  219,  219,
      206,  206,  206,  206,  220,  221,  206,  222,  223,  206,
      224,  206,  225,  206,  206,  206,  206,  206,  226,  227,
      228,  229,  206,  206,  206,  206,  230,  231,  232,  206,
      233,  206,  206,  206,  206,  206,  206,  234,  206,  206,
      206,  206,  206,  206,  206,  206,  206,  227,  206,  206,
      235,  236,  206,  237,  227,  206,  238,  206,  206,  239,
      238,  206,  240,  206,  206,  241,  206,  206,  206,  242,

      206,  206,  243,  206,  206,  220,  221,  206,  206,  222,
      206,  206,  244,  206,  206,  245,  224,  225,  206,  246,
      206,  206,  226,  226,  206,  206,  247,  206,  247,  206,
      229,  206,  206,  246,  248,  249,  230,  231,  206,  232,
      206,  233,  206,  206,  234,  206,  206,  206,  206,  206,
      206,  238,  239,  206,  239,  206,  240,  241,  206,  242,
      206,  250,  244,  206,  245,  206,  246,  206,  206,  206,
      226,  206,  247,  129,  206,  206,  249,  246,  248,  249,
      206,  206,  156,  206,  251,  250,  206,  206,  206,  226,
      252,  253,  254,  206,  206,  226,  252,  206,  253,  206,

      254,  206,  206,  206,  206,    0,  206,  206,  206,  206,
      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,
      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,
      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,
      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,
      206,  206,  206,  206
    ) ;

yy_nxt : constant array(0..913) of short :=
    (   0,
      206,   33,   34,   33,   33,   62,   63,   62,   62,   62,
       63,   62,   62,  119,   98,  121,  121,   98,  121,  113,
      205,   35,   35,   35,   35,   35,   35,   35,   35,   35,
       36,   37,   36,   36,   71,   38,   71,   39,  114,  108,
      115,   40,  120,   72,   99,   72,   73,   99,   73,  109,
       41,   41,   41,   41,   41,   41,   41,   41,   41,   43,
       44,   43,   43,   45,   74,   46,   74,   76,   47,   76,
       77,   47,   77,   48,  119,   49,   50,  104,  105,  104,
      104,  124,  170,   78,  101,   78,  202,  102,   51,   47,
       52,   53,   52,   52,   45,   65,   46,   54,   65,   47,

      103,   55,   47,  120,   48,   80,   49,   50,   80,   56,
      200,   81,   65,   82,   81,   65,   82,  198,  154,   51,
       47,   65,   84,  101,  204,   84,  102,  155,   85,   86,
       66,   85,   86,  171,  143,   67,  143,  143,  123,  103,
       68,   68,   68,   68,   68,   68,   68,   68,   68,   65,
      104,  105,  104,  104,  108,  168,  203,  143,   66,  143,
      143,  202,  190,   67,  109,  178,  124,  170,   68,   68,
       68,   68,   68,   68,   68,   68,   68,   87,   87,   88,
       87,   87,   89,   87,   87,   87,   90,   87,   87,   91,
       92,   87,   87,   87,   87,   87,   87,   87,   93,   93,

       93,   93,   93,   93,   93,   93,   93,   94,   87,   95,
      128,  196,  124,  170,  200,  124,  170,  129,  129,  129,
      129,  129,  129,  129,  129,  129,  131,  132,  131,  131,
      154,  181,  168,  198,  195,  194,  187,  133,  184,  155,
      147,  192,  193,  181,  191,  125,  189,  168,  166,  188,
      187,  159,  182,  146,  141,  138,  134,  174,  181,  174,
      177,  176,  172,  169,  168,  166,  174,  174,  174,  174,
      174,  174,  174,  174,  174,  164,  162,  175,  131,  132,
      131,  131,  111,  116,  159,  156,  126,  150,  148,  133,
      126,  146,  144,  141,  138,  136,  135,  126,  124,  122,

      116,  111,  206,   97,   97,   69,   69,   60,  134,  183,
      183,  184,  183,  183,  185,  183,  183,  183,  185,  183,
      183,  183,  185,  183,  183,  183,  183,  183,  183,  183,
      185,  185,  185,  185,  185,  185,  185,  185,  185,  185,
      183,  185,   32,   32,   32,   32,   32,   32,   32,   32,
       32,   32,   32,   32,   42,   42,   42,   42,   42,   42,
       42,   42,   42,   42,   42,   42,   57,   57,   57,   57,
       57,   57,   57,   57,   57,   57,   57,   57,   59,   59,
       59,   59,   59,   59,   59,   59,   59,   59,   59,   59,
       61,   61,   61,   61,   61,   61,   61,   61,   61,   61,

       61,   61,   64,   64,   64,   64,   64,   64,   64,   64,
       64,   64,   64,   64,   65,   65,   65,   65,   65,   65,
       65,   65,   65,   65,   65,   65,   70,   70,   70,   70,
       70,   70,   70,   70,   70,   70,   70,   70,   75,   75,
       75,   75,   75,   75,   75,   75,   75,   75,   75,   75,
       79,   79,   79,   79,   79,   79,   79,   79,   79,   79,
       79,   79,   83,   83,   83,   83,   83,   83,   83,   83,
       83,   83,   83,   83,   96,   96,   96,   96,   96,   96,
       96,   96,   96,   96,   96,   96,  100,  100,  100,  100,
      100,  100,  100,  100,  100,  100,  100,  100,  106,  106,

       60,   58,  106,  107,  107,   58,  206,  107,  110,  110,
      110,  110,  110,  110,  110,  110,  110,  110,  110,  110,
      112,  112,  112,  112,  112,  112,  112,  112,  112,  112,
      112,  112,  117,  117,  206,  206,  117,  118,  118,  206,
      206,  206,  206,  206,  206,  206,  118,  123,  123,  206,
      123,  123,  123,  123,  123,  206,  123,  123,  123,  125,
      125,  206,  125,  125,  125,  125,  125,  125,  125,  125,
      125,  127,  127,  206,  127,  127,  127,  127,  127,  127,
      127,  127,  127,  130,  130,  130,  130,  130,  130,  130,
      130,  130,  130,  130,  130,  137,  137,  137,  137,  137,

      137,  137,  137,  137,  137,  137,  137,  139,  206,  206,
      139,  139,  139,  139,  139,  139,  139,  139,  139,  140,
      140,  140,  140,  140,  140,  140,  140,  140,  140,  140,
      140,  142,  142,  206,  142,  142,  142,  142,  142,  142,
      142,  142,  142,  145,  145,  206,  206,  145,  147,  147,
      206,  147,  147,  147,  147,  147,  147,  147,  147,  147,
      149,  149,  206,  149,  149,  149,  149,  149,  149,  149,
      149,  149,  151,  151,  206,  151,  151,  151,  151,  151,
      206,  151,  151,  151,  152,  152,  206,  206,  206,  152,
      152,  152,  152,  206,  152,  153,  153,  206,  153,  153,

      153,  153,  153,  153,  153,  153,  153,  157,  157,  206,
      206,  157,  158,  158,  158,  158,  158,  158,  158,  158,
      158,  158,  158,  158,  160,  160,  206,  206,  160,  160,
      160,  206,  160,  160,  160,  160,  161,  161,  206,  161,
      161,  161,  161,  161,  161,  161,  161,  161,  163,  163,
      206,  163,  163,  163,  163,  163,  163,  163,  163,  163,
      165,  165,  165,  165,  165,  165,  165,  165,  165,  165,
      165,  165,  167,  167,  167,  167,  167,  167,  167,  167,
      167,  167,  167,  167,  173,  173,  206,  173,  173,  173,
      173,  173,  173,  173,  173,  179,  179,  206,  179,  179,

      179,  179,  179,  179,  179,  179,  179,  180,  180,  180,
      180,  180,  180,  180,  180,  180,  180,  180,  180,  186,
      186,  186,  186,  186,  186,  186,  186,  186,  186,  186,
      186,  185,  185,  185,  185,  185,  185,  185,  185,  185,
      185,  185,  185,  197,  197,  197,  197,  197,  197,  197,
      197,  197,  197,  197,  197,  199,  199,  199,  199,  199,
      199,  199,  199,  199,  199,  199,  199,  201,  201,  201,
      201,  201,  201,  201,  201,  201,  201,  201,  201,   31,
      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,
      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,

      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,
      206,  206,  206
    ) ;

yy_chk : constant array(0..913) of short :=
    (   0,
        0,    1,    1,    1,    1,    9,    9,    9,    9,   10,
       10,   10,   10,   43,   27,   46,   46,   28,   46,   39,
      204,    1,    1,    1,    1,    1,    1,    1,    1,    1,
        2,    2,    2,    2,   15,    2,   16,    2,   39,   36,
       39,    2,   43,   15,   27,   16,   15,   28,   16,   36,
        2,    2,    2,    2,    2,    2,    2,    2,    2,    3,
        3,    3,    3,    3,   15,    3,   16,   17,    3,   18,
       17,    3,   18,    3,  118,    3,    3,   33,   33,   33,
       33,  123,  123,   17,   29,   18,  201,   29,    3,    3,
        4,    4,    4,    4,    4,   19,    4,    4,   20,    4,

       29,    4,    4,  118,    4,   19,    4,    4,   20,    4,
      199,   19,   21,   19,   20,   22,   20,  197,   90,    4,
        4,   11,   21,   30,  195,   22,   30,   90,   21,   21,
       11,   22,   22,  124,   62,   11,   62,   62,  124,   30,
       11,   11,   11,   11,   11,   11,   11,   11,   11,   12,
      104,  104,  104,  104,  107,  134,  194,  143,   12,  143,
      143,  193,  171,   12,  107,  134,  171,  171,   12,   12,
       12,   12,   12,   12,   12,   12,   12,   23,   23,   23,
       23,   23,   23,   23,   23,   23,   23,   23,   23,   23,
       23,   23,   23,   23,   23,   23,   23,   23,   23,   23,

       23,   23,   23,   23,   23,   23,   23,   23,   23,   23,
       51,  190,  196,  196,  192,  190,  190,   51,   51,   51,
       51,   51,   51,   51,   51,   51,   52,   52,   52,   52,
      153,  177,  178,  191,  189,  188,  186,   52,  185,  153,
      182,  177,  178,  180,  176,  172,  169,  167,  165,  164,
      162,  158,  148,  146,  140,  137,   52,  129,  136,  129,
      133,  130,  126,  122,  120,  116,  129,  129,  129,  129,
      129,  129,  129,  129,  129,  114,  112,  129,  131,  131,
      131,  131,  110,  109,   96,   91,   85,   82,   81,  131,
       78,   73,   67,   59,   57,   55,   54,   50,   49,   48,

       40,   38,   31,   26,   25,   14,   13,    8,  131,  156,
      156,  156,  156,  156,  156,  156,  156,  156,  156,  156,
      156,  156,  156,  156,  156,  156,  156,  156,  156,  156,
      156,  156,  156,  156,  156,  156,  156,  156,  156,  156,
      156,  156,  207,  207,  207,  207,  207,  207,  207,  207,
      207,  207,  207,  207,  208,  208,  208,  208,  208,  208,
      208,  208,  208,  208,  208,  208,  209,  209,  209,  209,
      209,  209,  209,  209,  209,  209,  209,  209,  210,  210,
      210,  210,  210,  210,  210,  210,  210,  210,  210,  210,
      211,  211,  211,  211,  211,  211,  211,  211,  211,  211,

      211,  211,  212,  212,  212,  212,  212,  212,  212,  212,
      212,  212,  212,  212,  213,  213,  213,  213,  213,  213,
      213,  213,  213,  213,  213,  213,  214,  214,  214,  214,
      214,  214,  214,  214,  214,  214,  214,  214,  215,  215,
      215,  215,  215,  215,  215,  215,  215,  215,  215,  215,
      216,  216,  216,  216,  216,  216,  216,  216,  216,  216,
      216,  216,  217,  217,  217,  217,  217,  217,  217,  217,
      217,  217,  217,  217,  218,  218,  218,  218,  218,  218,
      218,  218,  218,  218,  218,  218,  219,  219,  219,  219,
      219,  219,  219,  219,  219,  219,  219,  219,  220,  220,

        7,    6,  220,  221,  221,    5,    0,  221,  222,  222,
      222,  222,  222,  222,  222,  222,  222,  222,  222,  222,
      223,  223,  223,  223,  223,  223,  223,  223,  223,  223,
      223,  223,  224,  224,    0,    0,  224,  225,  225,    0,
        0,    0,    0,    0,    0,    0,  225,  226,  226,    0,
      226,  226,  226,  226,  226,    0,  226,  226,  226,  227,
      227,    0,  227,  227,  227,  227,  227,  227,  227,  227,
      227,  228,  228,    0,  228,  228,  228,  228,  228,  228,
      228,  228,  228,  229,  229,  229,  229,  229,  229,  229,
      229,  229,  229,  229,  229,  230,  230,  230,  230,  230,

      230,  230,  230,  230,  230,  230,  230,  231,    0,    0,
      231,  231,  231,  231,  231,  231,  231,  231,  231,  232,
      232,  232,  232,  232,  232,  232,  232,  232,  232,  232,
      232,  233,  233,    0,  233,  233,  233,  233,  233,  233,
      233,  233,  233,  234,  234,    0,    0,  234,  235,  235,
        0,  235,  235,  235,  235,  235,  235,  235,  235,  235,
      236,  236,    0,  236,  236,  236,  236,  236,  236,  236,
      236,  236,  237,  237,    0,  237,  237,  237,  237,  237,
        0,  237,  237,  237,  238,  238,    0,    0,    0,  238,
      238,  238,  238,    0,  238,  239,  239,    0,  239,  239,

      239,  239,  239,  239,  239,  239,  239,  240,  240,    0,
        0,  240,  241,  241,  241,  241,  241,  241,  241,  241,
      241,  241,  241,  241,  242,  242,    0,    0,  242,  242,
      242,    0,  242,  242,  242,  242,  243,  243,    0,  243,
      243,  243,  243,  243,  243,  243,  243,  243,  244,  244,
        0,  244,  244,  244,  244,  244,  244,  244,  244,  244,
      245,  245,  245,  245,  245,  245,  245,  245,  245,  245,
      245,  245,  246,  246,  246,  246,  246,  246,  246,  246,
      246,  246,  246,  246,  247,  247,    0,  247,  247,  247,
      247,  247,  247,  247,  247,  248,  248,    0,  248,  248,

      248,  248,  248,  248,  248,  248,  248,  249,  249,  249,
      249,  249,  249,  249,  249,  249,  249,  249,  249,  250,
      250,  250,  250,  250,  250,  250,  250,  250,  250,  250,
      250,  251,  251,  251,  251,  251,  251,  251,  251,  251,
      251,  251,  251,  252,  252,  252,  252,  252,  252,  252,
      252,  252,  252,  252,  252,  253,  253,  253,  253,  253,
      253,  253,  253,  253,  253,  253,  253,  254,  254,  254,
      254,  254,  254,  254,  254,  254,  254,  254,  254,  206,
      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,
      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,

      206,  206,  206,  206,  206,  206,  206,  206,  206,  206,
      206,  206,  206
    ) ;


-- copy whatever the last rule matched to the standard output

procedure ECHO is
begin
   if (text_io.is_open(user_output_file)) then
     text_io.put( user_output_file, yytext );
   else
     text_io.put( yytext );
   end if;
end ECHO;

-- enter a start condition.
-- Using procedure requires a () after the ENTER, but makes everything
-- much neater.

procedure ENTER( state : integer ) is
begin
     yy_start := 1 + 2 * state;
end ENTER;

-- action number for EOF rule of a given start state
function YY_STATE_EOF(state : integer) return integer is
begin
     return YY_END_OF_BUFFER + state + 1;
end YY_STATE_EOF;

-- return all but the first 'n' matched characters back to the input stream
procedure yyless(n : integer) is
begin
        yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
        yy_cp := yy_bp + n;
        yy_c_buf_p := yy_cp;
        YY_DO_BEFORE_ACTION; -- set up yytext again
end yyless;

-- redefine this if you have something you want each time.
procedure YY_USER_ACTION is
begin
        null;
end;

-- yy_get_previous_state - get the state just before the EOB char was reached

function yy_get_previous_state return yy_state_type is
    yy_current_state : yy_state_type;
    yy_c : short;
    yy_bp : integer := yytext_ptr;
begin
    yy_current_state := yy_start;
    if ( yy_ch_buf(yy_bp-1) = ASCII.LF ) then
	yy_current_state := yy_current_state + 1;
    end if;

    for yy_cp in yytext_ptr..yy_c_buf_p - 1 loop
	yy_c := yy_ec(yy_ch_buf(yy_cp));
	if ( yy_accept(yy_current_state) /= 0 ) then
	    yy_last_accepting_state := yy_current_state;
	    yy_last_accepting_cpos := yy_cp;
	end if;
	while ( yy_chk(yy_base(yy_current_state) + yy_c) /= yy_current_state ) loop
	    yy_current_state := yy_def(yy_current_state);
	    if ( yy_current_state >= 207 ) then
		yy_c := yy_meta(yy_c);
	    end if;
	end loop;
	yy_current_state := yy_nxt(yy_base(yy_current_state) + yy_c);
    end loop;

    return yy_current_state;
end yy_get_previous_state;

procedure yyrestart( input_file : file_type ) is
begin
   open_input(text_io.name(input_file));
end yyrestart;

begin -- of YYLex
<<new_file>>
        -- this is where we enter upon encountering an end-of-file and
        -- yywrap() indicating that we should continue processing

    if ( yy_init ) then
        if ( yy_start = 0 ) then
            yy_start := 1;      -- first start state
        end if;

        -- we put in the '\n' and start reading from [1] so that an
        -- initial match-at-newline will be true.

        yy_ch_buf(0) := ASCII.LF;
        yy_n_chars := 1;

        -- we always need two end-of-buffer characters.  The first causes
        -- a transition to the end-of-buffer state.  The second causes
        -- a jam in that state.

        yy_ch_buf(yy_n_chars) := YY_END_OF_BUFFER_CHAR;
        yy_ch_buf(yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;

        yy_eof_has_been_seen := false;

        yytext_ptr := 1;
        yy_c_buf_p := yytext_ptr;
        yy_hold_char := yy_ch_buf(yy_c_buf_p);
        yy_init := false;
    end if; -- yy_init

    loop                -- loops until end-of-file is reached


        yy_cp := yy_c_buf_p;

        -- support of yytext
        yy_ch_buf(yy_cp) := yy_hold_char;

        -- yy_bp points to the position in yy_ch_buf of the start of the
        -- current run.
	yy_bp := yy_cp;
	yy_current_state := yy_start;
	if ( yy_ch_buf(yy_bp-1) = ASCII.LF ) then
	    yy_current_state := yy_current_state + 1;
	end if;
	loop
		yy_c := yy_ec(yy_ch_buf(yy_cp));
		if ( yy_accept(yy_current_state) /= 0 ) then
		    yy_last_accepting_state := yy_current_state;
		    yy_last_accepting_cpos := yy_cp;
		end if;
		while ( yy_chk(yy_base(yy_current_state) + yy_c) /= yy_current_state ) loop
		    yy_current_state := yy_def(yy_current_state);
		    if ( yy_current_state >= 207 ) then
			yy_c := yy_meta(yy_c);
		    end if;
		end loop;
		yy_current_state := yy_nxt(yy_base(yy_current_state) + yy_c);
	    yy_cp := yy_cp + 1;
if ( yy_current_state = 206 ) then
    exit;
end if;
	end loop;
	yy_cp := yy_last_accepting_cpos;
	yy_current_state := yy_last_accepting_state;

<<next_action>>
	    yy_act := yy_accept(yy_current_state);
            YY_DO_BEFORE_ACTION;
            YY_USER_ACTION;

        if aflex_debug then  -- output acceptance info. for (-d) debug mode
            text_io.put( Standard_Error, "--accepting rule #" );
            text_io.put( Standard_Error, INTEGER'IMAGE(yy_act) );
            text_io.put_line( Standard_Error, "(""" & yytext & """)");
        end if;


<<do_action>>   -- this label is used only to access EOF actions
            case yy_act is
		when 0 => -- must backtrack
		-- undo the effects of YY_DO_BEFORE_ACTION
		yy_ch_buf(yy_cp) := yy_hold_char;
		yy_cp := yy_last_accepting_cpos;
		yy_current_state := yy_last_accepting_state;
		goto next_action;



when 1 => 
--# line 46 "ascan.l"
 indented_code := true; 

when 2 => 
--# line 47 "ascan.l"
 linenum := linenum + 1; ECHO;
				-- treat as a comment;
			

when 3 => 
--# line 50 "ascan.l"
 linenum := linenum + 1; ECHO; 

when 4 => 
--# line 51 "ascan.l"
 return ( SCDECL ); 

when 5 => 
--# line 52 "ascan.l"
 return ( XSCDECL ); 

when 6 => 
--# line 54 "ascan.l"
 return ( WHITESPACE ); 

when 7 => 
--# line 56 "ascan.l"

			sectnum := 2;
			misc.line_directive_out;
			ENTER(SECT2PROLOG);
			return ( SECTEND );
			

when 8 => 
--# line 63 "ascan.l"

			text_io.put( Standard_Error, "old-style lex command at line " );
			int_io.put( Standard_Error, linenum );
			text_io.put( Standard_Error, "ignored:" );
			text_io.new_line( Standard_Error );
			text_io.put( Standard_Error, ASCII.HT );
			text_io.put( Standard_Error, yytext(1..YYLength) );
			linenum := linenum + 1;
			

when 9 => 
--# line 73 "ascan.l"

			nmstr := vstr(yytext(1..YYLength));
			didadef := false;
			ENTER(PICKUPDEF);
			

when 10 => 
--# line 79 "ascan.l"
 nmstr := vstr(yytext(1..YYLength));
			  return NAME;
			

when 11 => 
--# line 82 "ascan.l"
 linenum := linenum + 1;
			  -- allows blank lines in section 1;
			

when 12 => 
--# line 85 "ascan.l"
 linenum := linenum + 1; return Newline; 

when 13 => 
--# line 86 "ascan.l"
 misc.synerr( "illegal character" );ENTER(RECOVER);

when 14 => 
--# line 88 "ascan.l"
 null;
			  -- separates name and definition;
			

when 15 => 
--# line 92 "ascan.l"

			nmdef := vstr(yytext(1..YYLength));

			i := tstring.len( nmdef );
			while ( i >= tstring.first ) loop
			    if ( (CHAR(nmdef,i) /= ' ') and
				 (CHAR(nmdef,i) /= ASCII.HT) ) then
				exit;
			    end if;
			    i := i - 1;
			end loop;

                        sym.ndinstal( nmstr,
				tstring.slice(nmdef, tstring.first, i) );
			didadef := true;
			

when 16 => 
--# line 109 "ascan.l"

			if ( not didadef ) then
			    misc.synerr( "incomplete name definition" );
			end if;
			ENTER(0);
			linenum := linenum + 1;
			

when 17 => 
--# line 117 "ascan.l"
 linenum := linenum + 1;
			  ENTER(0);
			  nmstr := vstr(yytext(1..YYLength));
			  return NAME;
			

when 18 => 
yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
yy_cp := yy_cp - 1;
yy_c_buf_p := yy_cp;
YY_DO_BEFORE_ACTION; -- set up yytext again
--# line 123 "ascan.l"

			linenum := linenum + 1;
			ACTION_ECHO;
			MARK_END_OF_PROLOG;
			ENTER(SECT2);
			

when 19 => 
--# line 130 "ascan.l"
 linenum := linenum + 1; ACTION_ECHO; 

when YY_END_OF_BUFFER +SECT2PROLOG + 1 
 =>
--# line 132 "ascan.l"
 MARK_END_OF_PROLOG;
			  return End_Of_Input;
			

when 21 => 
--# line 136 "ascan.l"
 linenum := linenum + 1;
			  -- allow blank lines in sect2;

			-- this rule matches indented lines which
			-- are not comments.
when 22 => 
--# line 141 "ascan.l"

			misc.synerr("indented code found outside of action");
			linenum := linenum + 1;
			

when 23 => 
--# line 146 "ascan.l"
 ENTER(SC); return ( '<' ); 

when 24 => 
--# line 147 "ascan.l"
 return ( '^' );  

when 25 => 
--# line 148 "ascan.l"
 ENTER(QUOTE); return ( '"' ); 

when 26 => 
yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
 yy_cp := yy_bp + 1;
yy_c_buf_p := yy_cp;
YY_DO_BEFORE_ACTION; -- set up yytext again
--# line 149 "ascan.l"
 ENTER(NUM); return ( '{' ); 

when 27 => 
--# line 150 "ascan.l"
 ENTER(BRACEERROR); 

when 28 => 
yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
 yy_cp := yy_bp + 1;
yy_c_buf_p := yy_cp;
YY_DO_BEFORE_ACTION; -- set up yytext again
--# line 151 "ascan.l"
 return ( '$' ); 

when 29 => 
--# line 153 "ascan.l"
 continued_action := true;
			  linenum := linenum + 1;
			  return Newline;
			

when 30 => 
--# line 158 "ascan.l"
 linenum := linenum + 1; ACTION_ECHO; 

when 31 => 
--# line 160 "ascan.l"

			-- this rule is separate from the one below because
			-- otherwise we get variable trailing context, so
			-- we can't build the scanner using -f,F

			bracelevel := 0;
			continued_action := false;
			ENTER(ACTION);
			return Newline;
			

when 32 => 
yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
yy_cp := yy_cp - 1;
yy_c_buf_p := yy_cp;
YY_DO_BEFORE_ACTION; -- set up yytext again
--# line 171 "ascan.l"

			bracelevel := 0;
			continued_action := false;
			ENTER(ACTION);
			return Newline;
			

when 33 => 
--# line 178 "ascan.l"
 linenum := linenum + 1; return Newline; 

when 34 => 
--# line 180 "ascan.l"
 return ( EOF_OP ); 

when 35 => 
--# line 182 "ascan.l"

			sectnum := 3;
			ENTER(SECT3);
			return ( End_Of_Input );
			-- to stop the parser
			

when 36 => 
--# line 189 "ascan.l"


			nmstr := vstr(yytext(1..YYLength));

			-- check to see if we've already encountered this ccl
                        cclval := sym.ccllookup( nmstr );
			if ( cclval /= 0 ) then
			    yylval := cclval;
			    cclreuse := cclreuse + 1;
			    return ( PREVCCL );
			else
			    -- we fudge a bit.  We know that this ccl will
			    -- soon be numbered as lastccl + 1 by cclinit
			    sym.cclinstal( nmstr, lastccl + 1 );

			    -- push back everything but the leading bracket
			    -- so the ccl can be rescanned

			    PUT_BACK_STRING(nmstr, 1);

			    ENTER(FIRSTCCL);
			    return ( '[' );
			end if;
			

when 37 => 
--# line 214 "ascan.l"

			nmstr := vstr(yytext(1..YYLength));
			-- chop leading and trailing brace
			tmpbuf := slice(vstr(yytext(1..YYLength)),
								2, YYLength-1);

			nmdefptr := sym.ndlookup( tmpbuf );
			if ( nmdefptr = NUL ) then
			    misc.synerr( "undefined {name}" );
			else
			    -- push back name surrounded by ()'s
			    unput(')');
			    PUT_BACK_STRING(nmdefptr, 0);
			    unput('(');
			end if;
			

when 38 => 
--# line 231 "ascan.l"
 tmpbuf := vstr(yytext(1..YYLength));
			  case tstring.CHAR(tmpbuf,1) is
				when '/' => return '/';
				when '|' => return '|';
				when '*' => return '*';
				when '+' => return '+';
				when '?' => return '?';
				when '.' => return '.';
				when '(' => return '(';
				when ')' => return ')';
				when others =>
					misc.aflexerror("error in aflex case");
			  end case;
			

when 39 => 
--# line 245 "ascan.l"
 tmpbuf := vstr(yytext(1..YYLength));
			  yylval := CHARACTER'POS(CHAR(tmpbuf,1));
			  return CHAR;
			

when 40 => 
--# line 249 "ascan.l"
 linenum := linenum + 1; return Newline; 

when 41 => 
--# line 252 "ascan.l"
 return ( ',' ); 

when 42 => 
--# line 253 "ascan.l"
 ENTER(SECT2); return ( '>' ); 

when 43 => 
yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
 yy_cp := yy_bp + 1;
yy_c_buf_p := yy_cp;
YY_DO_BEFORE_ACTION; -- set up yytext again
--# line 254 "ascan.l"
 ENTER(CARETISBOL); return ( '>' ); 

when 44 => 
--# line 255 "ascan.l"
 nmstr := vstr(yytext(1..YYLength));
			  return NAME;
			

when 45 => 
--# line 258 "ascan.l"
 misc.synerr( "bad start condition name" ); 

when 46 => 
--# line 260 "ascan.l"
 ENTER(SECT2); return ( '^' ); 

when 47 => 
--# line 263 "ascan.l"
 tmpbuf := vstr(yytext(1..YYLength));
			  yylval := CHARACTER'POS(CHAR(tmpbuf,1));
			  return CHAR;
			

when 48 => 
--# line 267 "ascan.l"
 ENTER(SECT2); return ( '"' ); 

when 49 => 
--# line 269 "ascan.l"

			misc.synerr( "missing quote" );
			ENTER(SECT2);
			linenum := linenum + 1;
			return ( '"' );
			

when 50 => 
yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
 yy_cp := yy_bp + 1;
yy_c_buf_p := yy_cp;
YY_DO_BEFORE_ACTION; -- set up yytext again
--# line 277 "ascan.l"
 ENTER(CCL); return ( '^' ); 

when 51 => 
yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
 yy_cp := yy_bp + 1;
yy_c_buf_p := yy_cp;
YY_DO_BEFORE_ACTION; -- set up yytext again
--# line 278 "ascan.l"
 return ( '^' ); 

when 52 => 
--# line 279 "ascan.l"
 ENTER(CCL); yylval := CHARACTER'POS('-'); return ( CHAR ); 

when 53 => 
--# line 280 "ascan.l"
 ENTER(CCL);
			  tmpbuf := vstr(yytext(1..YYLength));
			  yylval := CHARACTER'POS(CHAR(tmpbuf,1));
			  return CHAR;
			

when 54 => 
yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext
 yy_cp := yy_bp + 1;
yy_c_buf_p := yy_cp;
YY_DO_BEFORE_ACTION; -- set up yytext again
--# line 286 "ascan.l"
 return ( '-' ); 

when 55 => 
--# line 287 "ascan.l"
 tmpbuf := vstr(yytext(1..YYLength));
			  yylval := CHARACTER'POS(CHAR(tmpbuf,1));
			  return CHAR;
			

when 56 => 
--# line 291 "ascan.l"
 ENTER(SECT2); return ( ']' ); 

when 57 => 
--# line 294 "ascan.l"

			yylval := misc.myctoi( vstr(yytext(1..YYLength)) );
			return ( NUMBER );
			

when 58 => 
--# line 299 "ascan.l"
 return ( ',' ); 

when 59 => 
--# line 300 "ascan.l"
 ENTER(SECT2); return ( '}' ); 

when 60 => 
--# line 302 "ascan.l"

			misc.synerr( "bad character inside {}'s" );
			ENTER(SECT2);
			return ( '}' );
			

when 61 => 
--# line 308 "ascan.l"

			misc.synerr( "missing }" );
			ENTER(SECT2);
			linenum := linenum + 1;
			return ( '}' );
			

when 62 => 
--# line 316 "ascan.l"
 misc.synerr( "bad name in {}'s" ); ENTER(SECT2); 

when 63 => 
--# line 317 "ascan.l"
 misc.synerr( "missing }" );
			  linenum := linenum + 1;
			  ENTER(SECT2);
			

when 64 => 
--# line 322 "ascan.l"
 bracelevel := bracelevel + 1; 

when 65 => 
--# line 323 "ascan.l"
 bracelevel := bracelevel - 1; 

when 66 => 
--# line 324 "ascan.l"
 ACTION_ECHO; 

when 67 => 
--# line 325 "ascan.l"
 ACTION_ECHO; 

when 68 => 
--# line 326 "ascan.l"
 linenum := linenum + 1; ACTION_ECHO; 

when 69 => 
--# line 327 "ascan.l"
 ACTION_ECHO;
				  -- character constant;
			

when 70 => 
--# line 331 "ascan.l"
 ACTION_ECHO; ENTER(ACTION_STRING); 

when 71 => 
--# line 333 "ascan.l"

			linenum := linenum + 1;
			ACTION_ECHO;
			if ( bracelevel = 0 ) then
			    text_io.new_line ( temp_action_file );
			    ENTER(SECT2);
	                end if;
			

when 72 => 
--# line 341 "ascan.l"
 ACTION_ECHO; 

when 73 => 
--# line 343 "ascan.l"
 ACTION_ECHO; 

when 74 => 
--# line 344 "ascan.l"
 ACTION_ECHO; 

when 75 => 
--# line 345 "ascan.l"
 linenum := linenum + 1; ACTION_ECHO; 

when 76 => 
--# line 346 "ascan.l"
 ACTION_ECHO; ENTER(ACTION); 

when 77 => 
--# line 347 "ascan.l"
 ACTION_ECHO; 

when 78 => 
--# line 350 "ascan.l"

			yylval := CHARACTER'POS(misc.myesc( vstr(yytext(1..YYLength)) ));
			return ( CHAR );
			

when 79 => 
--# line 355 "ascan.l"

			yylval := CHARACTER'POS(misc.myesc( vstr(yytext(1..YYLength)) ));
			ENTER(CCL);
			return ( CHAR );
			

when 80 => 
--# line 362 "ascan.l"
 if ( check_yylex_here ) then
				return End_Of_Input;
			  else
				ECHO;
			  end if;
			

when 81 => 
--# line 368 "ascan.l"
raise AFLEX_SCANNER_JAMMED;
when YY_END_OF_BUFFER + INITIAL + 1 |
YY_END_OF_BUFFER + SECT2 + 1 |
YY_END_OF_BUFFER + SECT3 + 1 |
YY_END_OF_BUFFER + PICKUPDEF + 1 |
YY_END_OF_BUFFER + SC + 1 |
YY_END_OF_BUFFER + CARETISBOL + 1 |
YY_END_OF_BUFFER + NUM + 1 |
YY_END_OF_BUFFER + QUOTE + 1 |
YY_END_OF_BUFFER + FIRSTCCL + 1 |
YY_END_OF_BUFFER + CCL + 1 |
YY_END_OF_BUFFER + ACTION + 1 |
YY_END_OF_BUFFER + RECOVER + 1 |
YY_END_OF_BUFFER + BRACEERROR + 1 |
YY_END_OF_BUFFER + ACTION_STRING + 1 => 
    return End_Of_Input;
                when YY_END_OF_BUFFER =>
                    -- undo the effects of YY_DO_BEFORE_ACTION
                    yy_ch_buf(yy_cp) := yy_hold_char;

                    yytext_ptr := yy_bp;

                    case yy_get_next_buffer is
                        when EOB_ACT_END_OF_FILE =>
                            begin
                            if ( yywrap ) then
                                -- note: because we've taken care in
                                -- yy_get_next_buffer() to have set up yytext,
                                -- we can now set up yy_c_buf_p so that if some
                                -- total hoser (like aflex itself) wants
                                -- to call the scanner after we return the
                                -- End_Of_Input, it'll still work - another
                                -- End_Of_Input will get returned.

                                yy_c_buf_p := yytext_ptr;

                                yy_act := YY_STATE_EOF((yy_start - 1) / 2);

                                goto do_action;
                            else
                                --  start processing a new file
                                yy_init := true;
                                goto new_file;
                            end if;
                            end;
                        when EOB_ACT_RESTART_SCAN =>
                            yy_c_buf_p := yytext_ptr;
                            yy_hold_char := yy_ch_buf(yy_c_buf_p);
                        when EOB_ACT_LAST_MATCH =>
                            yy_c_buf_p := yy_n_chars;
                            yy_current_state := yy_get_previous_state;

                            yy_cp := yy_c_buf_p;
                            yy_bp := yytext_ptr;
                            goto next_action;
                        when others => null;
                        end case; -- case yy_get_next_buffer()
                when others =>
                    text_io.put( "action # " );
                    text_io.put( INTEGER'IMAGE(yy_act) );
                    text_io.new_line;
                    raise AFLEX_INTERNAL_ERROR;
            end case; -- case (yy_act)
        end loop; -- end of loop waiting for end of file
end YYLex;
--# line 368 "ascan.l"
begin
    if (call_yylex) then
    	toktype := YYLex;
    	call_yylex := false;
    	return toktype;
    end if;

    if ( eofseen ) then
	toktype := End_Of_Input;
    else
	toktype := YYLex;
    end if;
-- this tracing code allows easy tracing of aflex runs
if (trace) then
text_io.new_line(Standard_Error);
text_io.put(Standard_Error, "toktype = :" );
text_io.put(Standard_Error, Token'image(toktype));
text_io.put_line(Standard_Error, ":" );
end if;

    if ( toktype = End_Of_Input ) then
	eofseen := true;

	if ( sectnum = 1 ) then
	    misc.synerr(  "unexpected EOF" );
	    sectnum := 2;
	    toktype := SECTEND;
	else
	    if ( sectnum = 2 ) then
	    	sectnum := 3;
	    	toktype := SECTEND;
	    end if;
    	end if;
    end if;
    
    if ( trace ) then
	if ( beglin ) then
	    int_io.put( Standard_Error, num_rules + 1 );
	    text_io.put( Standard_Error, ASCII.HT );
	    beglin := false;
    	end if;

	case toktype is
	    when '<' | '>'|'^'|'$'|'"'|'['|']'|'{'|'}'|'|'|'('|
    	    	 ')'|'-'|'/'|'?'|'.'|'*'|'+'|',' =>
		text_io.put( Standard_Error, Token'image(toktype) );

	    when NEWLINE =>
		text_io.new_line(Standard_Error);
		if ( sectnum = 2 ) then
		    beglin := true;
    	    	end if;

	    when SCDECL =>
		text_io.put( Standard_Error, "%s" );

	    when XSCDECL =>
   		text_io.put( Standard_Error, "%x" );

	    when WHITESPACE =>
       		text_io.put( Standard_Error, " " );

	    when SECTEND =>
       		text_io.put_line( Standard_Error, "%%" );	   

		-- we set beglin to be true so we'll start
		-- writing out numbers as we echo rules.  aflexscan() has
		-- already assigned sectnum

		if ( sectnum = 2 ) then
		    beglin := true;
    	    	end if;

	    when NAME =>
		text_io.put( Standard_Error, ''' );
		text_io.put( Standard_Error, YYText);
		text_io.put( Standard_Error, ''' );

	    when CHAR =>
	    	if ( (yylval < CHARACTER'POS(' ')) or
		     (yylval = CHARACTER'POS(ASCII.DEL)) ) then
		    text_io.put( Standard_Error, '\' );
		    int_io.put( Standard_Error, yylval );
    		    text_io.put( Standard_Error, '\' );
		else
		    text_io.put( Standard_Error, Token'image(toktype) );
    	    	end if;

	    when NUMBER =>
    	    	int_io.put( Standard_Error, yylval );

	    when PREVCCL =>
		text_io.put( Standard_Error, '[' );
   	    	int_io.put( Standard_Error, yylval );
		text_io.put( Standard_Error, ']' );		

    	    when End_Of_Input =>
    	    	text_io.put( Standard_Error, "End Marker" );

	    when others =>
	    	text_io.put( Standard_Error, "Something weird:" );
		text_io.put_line( Standard_Error, Token'image(toktype));
    	end case;
    end if;
	    
    return toktype;

end get_token;
end scanner;

pragma Warnings(Off);
pragma Style_Checks(Off);

-- A lexical scanner generated by aflex
with text_io; use text_io;
with ascan_dfa; use ascan_dfa; 
with ascan_io; use ascan_io; 
--# line 1 "ascan.l"
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
-- TITLE scanner specification file
-- AUTHOR: John Self (UCI)
-- DESCRIPTION regular expressions and actions matching tokens
--             that aflex expects to find in its input.
-- NOTES input to aflex (NOT alex.)  It uses exclusive start conditions
--       and case insensitive scanner generation available only in aflex
--       (or flex if you use C.)
--       generate scanner using the command 'aflex -is ascan.l'
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/ascan.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 
--# line 44 "ascan.l"


with misc_defs, Aflex_misc, sym, parse_tokens, int_io;
with tstring, ascan_dfa, ascan_io, external_file_manager;
use misc_defs, parse_tokens, tstring;
use ascan_dfa, ascan_io, external_file_manager;

package scanner is
    package misc renames Aflex_misc;
    call_yylex : boolean := false;
    function get_token return Token;
end scanner;

pragma Style_Checks(Off);

-- TITLE aflex - main program
--
-- AUTHOR: John Self (UCI)
-- DESCRIPTION main subprogram of aflex, calls the major routines in order
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/aflex.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 
--*************************************************************************** 
--                              aflex
--                          version 1.4a
--***************************************************************************
--
--                            Arcadia Project
--               Department of Information and Computer Science
--                        University of California
--                        Irvine, California 92717
--
--    Send requests for aflex information to alex-info@ics.uci.edu
--
--    Send bug reports for aflex to alex-bugs@ics.uci.edu
--
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
--
--    This program is based on the flex program written by Vern Paxson.
--
--    The following is the copyright notice from flex, from which aflex is
--    derived.
--	Copyright (c) 1989 The Regents of the University of California.
--	All rights reserved.
--
--	This code is derived from software contributed to Berkeley by
--	Vern Paxson.
--
--      The United States Government has rights in this work pursuant to
--	contract no. DE-AC03-76SF00098 between the United States Department of
--	Energy and the University of California.
--
--	Redistribution and use in source and binary forms are permitted
--	provided that the above copyright notice and this paragraph are
--	duplicated in all such forms and that any documentation,
--	advertising materials, and other materials related to such
--	distribution and use acknowledge that the software was developed
--	by the University of California, Berkeley.  The name of the
--	University may not be used to endorse or promote products derived
--	from this software without specific prior written permission.
--	THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
--	IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
--	WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
--
--***************************************************************************

with Ada.Command_Line;
with MAIN_BODY, DFA, GEN, MISC_DEFS, TEXT_IO, Aflex_MISC; 
with TSTRING, TEMPLATE_MANAGER, EXTERNAL_FILE_MANAGER; use MISC_DEFS, TEXT_IO, 
  TSTRING, EXTERNAL_FILE_MANAGER; 
procedure AFLEX is
	copyright : constant string :=
    "@(#) Copyright (c) 1990 Regents of the University of California.";
    	copyright2 : constant string :=
    "All rights reserved.";
begin
  MAIN_BODY.AFLEXINIT; 

  MAIN_BODY.READIN; 

  if (SYNTAXERROR) then 
    MAIN_BODY.AFLEXEND(1); 
  end if; 

  if (PERFORMANCE_REPORT) then 
    if (INTERACTIVE) then 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, 
        "-I (interactive) entails a minor performance penalty"); 
    end if; 


  end if; 

  if (VARIABLE_TRAILING_CONTEXT_RULES) then 
    Aflex_MISC.AFLEXERROR("can't handle variable trailing context rules"); 
  end if; 

  -- convert the ndfa to a dfa
  DFA.NTOD; 

  -- generate the Ada state transition tables from the DFA
  GEN.MAKE_TABLES; 

  TEMPLATE_MANAGER.GENERATE_IO_FILE; 
  TEMPLATE_MANAGER.GENERATE_DFA_FILE; 
  MAIN_BODY.AFLEXEND(0); 
exception
  when MAIN_BODY.AFLEX_TERMINATE => 
    Ada.Command_Line.Set_Exit_Status(
      Ada.Command_Line.Exit_Status(MAIN_BODY.TERMINATION_STATUS));
end AFLEX; 

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE command line interface
-- AUTHOR: John Self (UCI)
-- DESCRIPTION command line interface body for use with the VERDIX VADS system.
-- NOTES this file is system dependent
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/command_line_interface.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with TSTRING; use TSTRING; 
with Ada.Command_Line; use Ada.Command_Line;

package body Aflex_COMMAND_LINE_INTERFACE is 
  procedure INITIALIZE_COMMAND_LINE is 
  begin
      for i in 1 .. Ada.Command_Line.Argument_Count
      loop
        ARGV(i):= vstr(Argument(i));
      end loop;
      ARGC := Ada.Command_Line.Argument_Count + 1;
  end INITIALIZE_COMMAND_LINE; 

end Aflex_COMMAND_LINE_INTERFACE; 

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE command line interface
-- AUTHOR: John Self (UCI)
-- DESCRIPTION command line interface body for use with the VERDIX VADS system.
-- NOTES this file is system dependent
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/command_line.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with TSTRING; use TSTRING; 
package Aflex_COMMAND_LINE_INTERFACE is 
  MAX_NUMBER_ARGS : INTEGER := 32; 
  type COMMAND_VECTOR is array(0 .. MAX_NUMBER_ARGS) of VSTRING; 
  procedure INITIALIZE_COMMAND_LINE; 
  ARGV : COMMAND_VECTOR; 
  ARGC : INTEGER; 
end Aflex_COMMAND_LINE_INTERFACE; 

pragma Warnings(Off);
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE  miscellaneous aflex routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION
-- NOTES contains functions used in various places throughout aflex.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/misc.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS, TSTRING, TEXT_IO, Aflex_MISC, MAIN_BODY; 
with INT_IO, CALENDAR, EXTERNAL_FILE_MANAGER; use Aflex_MISC, MISC_DEFS, TEXT_IO, 
  EXTERNAL_FILE_MANAGER; 

package body Aflex_MISC is 
  use TSTRING; 
  -- action_out - write the actions from the temporary file to lex.yy.c

  procedure ACTION_OUT is 
    BUF : VSTRING; 
  begin
    while (not TEXT_IO.END_OF_FILE(TEMP_ACTION_FILE)) loop
      TSTRING.GET_LINE(TEMP_ACTION_FILE, BUF); 
      if ((TSTRING.LEN(BUF) >= 2) and then ((CHAR(BUF, 1) = '%') and (CHAR(BUF, 
        2) = '%'))) then 
        exit; 
      else 
        TSTRING.PUT_LINE(BUF); 
      end if; 
    end loop; 
  end ACTION_OUT; 

  -- bubble - bubble sort an integer array in increasing order
  --
  -- description
  --   sorts the first n elements of array v and replaces them in
  --   increasing order.
  --
  -- passed
  --   v - the array to be sorted
  --   n - the number of elements of 'v' to be sorted

  procedure BUBBLE(V : in INT_PTR; 
                   N : in INTEGER) is 
    K : INTEGER; 
  begin
    for I in reverse 2 .. N loop
      for J in 1 .. I - 1 loop
        if (V(J) > V(J + 1)) then 

          -- compare
          K := V(J); 

          -- exchange
          V(J) := V(J + 1); 
          V(J + 1) := K; 
        end if; 
      end loop; 
    end loop; 
  end BUBBLE; 


  -- clower - replace upper-case letter to lower-case

  function CLOWER(C : in INTEGER) return INTEGER is 
  begin
    if (ISUPPER(CHARACTER'VAL(C))) then 
      return TOLOWER(C); 
    else 
      return C; 
    end if; 
  end CLOWER; 


  -- cshell - shell sort a character array in increasing order
  --
  -- description
  --   does a shell sort of the first n elements of array v.
  --
  -- passed
  --   v - array to be sorted
  --   n - number of elements of v to be sorted

  procedure CSHELL(V : in out CHAR_ARRAY; 
                   N : in INTEGER) is 
    GAP, J, JG  : INTEGER; 
    K           : CHARACTER; 
    LOWER_BOUND : INTEGER := V'FIRST; 
  begin
    GAP := N/2; 
    while GAP > 0 loop
      for I in GAP .. N - 1 loop
        J := I - GAP; 
        while (J >= 0) loop
          JG := J + GAP; 

          if (V(J + LOWER_BOUND) <= V(JG + LOWER_BOUND)) then 
            exit; 
          end if; 

          K := V(J + LOWER_BOUND); 
          V(J + LOWER_BOUND) := V(JG + LOWER_BOUND); 
          V(JG + LOWER_BOUND) := K; 
          J := J - GAP; 
        end loop; 
      end loop; 
      GAP := GAP/2; 
    end loop; 
  end CSHELL; 


  -- dataend - finish up a block of data declarations

  procedure DATAEND is 
  begin
    if (DATAPOS > 0) then 
      DATAFLUSH; 

      -- add terminator for initialization
      TEXT_IO.PUT_LINE("    ) ;"); 
      TEXT_IO.NEW_LINE; 

      DATALINE := 0; 
    end if; 
  end DATAEND; 


  -- dataflush - flush generated data statements

  procedure DATAFLUSH(FILE : in FILE_TYPE) is 
  begin
    TEXT_IO.NEW_LINE(FILE); 
    DATALINE := DATALINE + 1; 
    if (DATALINE >= NUMDATALINES) then 

      -- put out a blank line so that the table is grouped into
      -- large blocks that enable the user to find elements easily
      TEXT_IO.NEW_LINE(FILE); 
      DATALINE := 0; 
    end if; 

    -- reset the number of characters written on the current line
    DATAPOS := 0; 
  end DATAFLUSH; 

  procedure DATAFLUSH is 
  begin
    DATAFLUSH(CURRENT_OUTPUT); 
  end DATAFLUSH; 
  -- aflex_gettime - return current time

  function AFLEX_GETTIME return VSTRING is 
    use TSTRING, CALENDAR; 
    CURRENT_TIME                                            : TIME; 
    CURRENT_YEAR                                            : YEAR_NUMBER; 
    CURRENT_MONTH                                           : MONTH_NUMBER; 
    CURRENT_DAY                                             : DAY_NUMBER; 
    CURRENT_SECONDS                                         : DAY_DURATION; 
    MONTH_STRING, HOUR_STRING, MINUTE_STRING, SECOND_STRING : VSTRING; 
    HOUR, MINUTE, SECOND                                    : INTEGER; 
    SECONDS_PER_HOUR                                        : constant 
      DAY_DURATION := 3600.0; 
  begin
    CURRENT_TIME := CLOCK; 
    SPLIT(CURRENT_TIME, CURRENT_YEAR, CURRENT_MONTH, CURRENT_DAY, 
      CURRENT_SECONDS); 
    case CURRENT_MONTH is 
      when 1 => 
        MONTH_STRING := VSTR("Jan"); 
      when 2 => 
        MONTH_STRING := VSTR("Feb"); 
      when 3 => 
        MONTH_STRING := VSTR("Mar"); 
      when 4 => 
        MONTH_STRING := VSTR("Apr"); 
      when 5 => 
        MONTH_STRING := VSTR("May"); 
      when 6 => 
        MONTH_STRING := VSTR("Jun"); 
      when 7 => 
        MONTH_STRING := VSTR("Jul"); 
      when 8 => 
        MONTH_STRING := VSTR("Aug"); 
      when 9 => 
        MONTH_STRING := VSTR("Sep"); 
      when 10 => 
        MONTH_STRING := VSTR("Oct"); 
      when 11 => 
        MONTH_STRING := VSTR("Nov"); 
      when 12 => 
        MONTH_STRING := VSTR("Dec"); 
    end case; 

    HOUR := INTEGER(CURRENT_SECONDS)/INTEGER(SECONDS_PER_HOUR);
    MINUTE := INTEGER((CURRENT_SECONDS - (HOUR*SECONDS_PER_HOUR))/60); 
    SECOND := INTEGER(CURRENT_SECONDS - HOUR*SECONDS_PER_HOUR - MINUTE*60.0); 

    if (HOUR >= 10) then 
      HOUR_STRING := VSTR(INTEGER'IMAGE(HOUR)); 
    else 
      HOUR_STRING := VSTR("0" & INTEGER'IMAGE(HOUR)); 
    end if; 

    if (MINUTE >= 10) then 
      MINUTE_STRING := VSTR(INTEGER'IMAGE(MINUTE)(2 .. INTEGER'IMAGE(MINUTE)'
        LENGTH)); 
    else 
      MINUTE_STRING := VSTR("0" & INTEGER'IMAGE(MINUTE)(2 .. INTEGER'IMAGE(
        MINUTE)'LENGTH)); 
    end if; 

    if (SECOND >= 10) then 
      SECOND_STRING := VSTR(INTEGER'IMAGE(SECOND)(2 .. INTEGER'IMAGE(SECOND)'
        LENGTH)); 
    else 
      SECOND_STRING := VSTR("0" & INTEGER'IMAGE(SECOND)(2 .. INTEGER'IMAGE(
        SECOND)'LENGTH)); 
    end if; 

    return MONTH_STRING & VSTR(INTEGER'IMAGE(CURRENT_DAY)) & HOUR_STRING & ":"
      & MINUTE_STRING & ":" & SECOND_STRING & INTEGER'IMAGE(CURRENT_YEAR); 
  end AFLEX_GETTIME; 

  -- aflexerror - report an error message and terminate
  -- overloaded function, one for vstring, one for string.
  procedure AFLEXERROR(MSG : in VSTRING) is 
    use TEXT_IO; 
  begin
    TSTRING.PUT(STANDARD_ERROR, "aflex: " & MSG); 
    TEXT_IO.NEW_LINE(STANDARD_ERROR); 
    MAIN_BODY.AFLEXEND(1); 
  end AFLEXERROR; 

  procedure AFLEXERROR(MSG : in STRING) is 
    use TEXT_IO; 
  begin
    TEXT_IO.PUT(STANDARD_ERROR, "aflex: " & MSG); 
    TEXT_IO.NEW_LINE(STANDARD_ERROR); 
    MAIN_BODY.AFLEXEND(1); 
  end AFLEXERROR; 

  -- aflexfatal - report a fatal error message and terminate
  -- overloaded function, one for vstring, one for string.
  procedure AFLEXFATAL(MSG : in VSTRING) is 
    use TEXT_IO; 
  begin
    TSTRING.PUT(STANDARD_ERROR, "aflex: fatal internal error " & MSG); 
    TEXT_IO.NEW_LINE(STANDARD_ERROR); 
    MAIN_BODY.AFLEXEND(1); 
  end AFLEXFATAL; 

  procedure AFLEXFATAL(MSG : in STRING) is 
    use TEXT_IO; 
  begin
    TEXT_IO.PUT(STANDARD_ERROR, "aflex: fatal internal error " & MSG); 
    TEXT_IO.NEW_LINE(STANDARD_ERROR); 
    MAIN_BODY.AFLEXEND(1); 
  end AFLEXFATAL; 

  -- basename - find the basename of a file
  function BASENAME return VSTRING is 
    END_CHAR_POS : INTEGER := LEN(INFILENAME);
    START_CHAR_POS : INTEGER;
  begin
    if (END_CHAR_POS = 0) then 
      -- if reading standard input give everything this name
      return VSTR("aflex_yy"); 
    end if; 
    
    -- find out where the end of the basename is    
    while ((END_CHAR_POS >= 1) and then
           (CHAR(INFILENAME, END_CHAR_POS) /= '.')) loop
      END_CHAR_POS := END_CHAR_POS - 1; 
    end loop; 

    -- find out where the beginning of the basename is    
    START_CHAR_POS := END_CHAR_POS; -- start at the end of the basename
    while ((START_CHAR_POS > 1) and then
           (CHAR(INFILENAME, START_CHAR_POS) /= '/')) loop
    	START_CHAR_POS := START_CHAR_POS - 1; 
    end loop; 

    if (CHAR(INFILENAME, START_CHAR_POS) = '/') then
    	START_CHAR_POS := START_CHAR_POS + 1;
    end if;
    
    if (END_CHAR_POS >= 1) then 
      return SLICE(INFILENAME, START_CHAR_POS,  END_CHAR_POS - 1); 
    else 
      return INFILENAME; 
    end if; 
  end BASENAME; 

  -- line_directive_out - spit out a "# line" statement

  procedure LINE_DIRECTIVE_OUT(OUTPUT_FILE_NAME : in FILE_TYPE) is 
  begin
    if (GEN_LINE_DIRS) then 
      TEXT_IO.PUT(OUTPUT_FILE_NAME, "--# line "); 
      INT_IO.PUT(OUTPUT_FILE_NAME, LINENUM, 1); 
      TEXT_IO.PUT(OUTPUT_FILE_NAME, " """); 
      TSTRING.PUT(OUTPUT_FILE_NAME, INFILENAME); 
      TEXT_IO.PUT_LINE(OUTPUT_FILE_NAME, """"); 
    end if; 
  end LINE_DIRECTIVE_OUT; 


  procedure LINE_DIRECTIVE_OUT is 
  begin
    if (GEN_LINE_DIRS) then 
      TEXT_IO.PUT("--# line "); 
      INT_IO.PUT(LINENUM, 1); 
      TEXT_IO.PUT(" """); 
      TSTRING.PUT(INFILENAME); 
      TEXT_IO.PUT_LINE(""""); 
    end if; 
  end LINE_DIRECTIVE_OUT; 

  -- all_upper - returns true if a string is all upper-case
  function ALL_UPPER(STR : in VSTRING) return BOOLEAN is 
  begin
    for I in 1 .. LEN(STR) loop
      if (not ((CHAR(STR, I) >= 'A') and (CHAR(STR, I) <= 'Z'))) then 
        return FALSE; 
      end if; 
    end loop; 
    return TRUE; 
  end ALL_UPPER; 

  -- all_lower - returns true if a string is all lower-case
  function ALL_LOWER(STR : in VSTRING) return BOOLEAN is 
  begin
    for I in 1 .. LEN(STR) loop
      if (not ((CHAR(STR, I) >= 'a') and (CHAR(STR, I) <= 'z'))) then 
        return FALSE; 
      end if; 
    end loop; 
    return TRUE; 
  end ALL_LOWER; 

  -- mk2data - generate a data statement for a two-dimensional array
  --
  --  generates a data statement initializing the current 2-D array to "value"

  procedure MK2DATA(FILE  : in FILE_TYPE; 
                    VALUE : in INTEGER) is 
  begin

    if (DATAPOS >= NUMDATAITEMS) then 
      TEXT_IO.PUT(FILE, ','); 
      DATAFLUSH(FILE); 
    end if; 

    if (DATAPOS = 0) then 

      -- indent
      TEXT_IO.PUT(FILE, "    "); 
    else 
      TEXT_IO.PUT(FILE, ','); 
    end if; 

    DATAPOS := DATAPOS + 1; 

    INT_IO.PUT(FILE, VALUE, 5); 
  end MK2DATA; 

  procedure MK2DATA(VALUE : in INTEGER) is 
  begin
    MK2DATA(CURRENT_OUTPUT, VALUE); 
  end MK2DATA; 

  --
  --  generates a data statement initializing the current array element to
  --  "value"

  procedure MKDATA(VALUE : in INTEGER) is 
  begin
    if (DATAPOS >= NUMDATAITEMS) then 
      TEXT_IO.PUT(','); 
      DATAFLUSH; 
    end if; 

    if (DATAPOS = 0) then 

      -- indent
      TEXT_IO.PUT("    "); 
    else 
      TEXT_IO.PUT(','); 
    end if; 

    DATAPOS := DATAPOS + 1; 

    INT_IO.PUT(VALUE, 5); 
  end MKDATA; 


  -- myctoi - return the integer represented by a string of digits

  function MYCTOI(NUM_ARRAY : in VSTRING) return INTEGER is 
    TOTAL : INTEGER := 0; 
    CNT   : INTEGER := TSTRING.FIRST; 
  begin
    while (CNT <= TSTRING.LEN(NUM_ARRAY)) loop
      TOTAL := TOTAL*10; 
      TOTAL := TOTAL + CHARACTER'POS(CHAR(NUM_ARRAY, CNT)) - CHARACTER'POS('0')
        ; 
      CNT := CNT + 1; 
    end loop; 
    return TOTAL; 
  end MYCTOI; 


  -- myesc - return character corresponding to escape sequence

  function MYESC(ARR : in VSTRING) return CHARACTER is 
    use TEXT_IO; 
  begin
    case (CHAR(ARR, TSTRING.FIRST + 1)) is 
      when 'a' => 
        return ASCII.BEL; 
      when 'b' => 
        return ASCII.BS; 
      when 'f' => 
        return ASCII.FF; 
      when 'n' => 
        return ASCII.LF; 
      when 'r' => 
        return ASCII.CR; 
      when 't' => 
        return ASCII.HT; 
      when 'v' => 
        return ASCII.VT; 

      when '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' => 

        -- \<octal>
        declare
          C, ESC_CHAR : CHARACTER; 
          SPTR        : INTEGER := TSTRING.FIRST + 1; 
        begin
          ESC_CHAR := OTOI(TSTRING.SLICE(ARR, TSTRING.FIRST + 1, TSTRING.LEN(ARR
            ))); 
          if (ESC_CHAR = ASCII.NUL) then 
            Aflex_MISC.SYNERR("escape sequence for null not allowed"); 
            return ASCII.SOH; 
          end if; 

          return ESC_CHAR; 
        end; 
      when others => 
        return CHAR(ARR, TSTRING.FIRST + 1); 
    end case; 
  end MYESC; 


  -- otoi - convert an octal digit string to an integer value

  function OTOI(STR : in VSTRING) return CHARACTER is 
    TOTAL : INTEGER := 0; 
    CNT   : INTEGER := TSTRING.FIRST; 
  begin
    while (CNT <= TSTRING.LEN(STR)) loop
      TOTAL := TOTAL*8; 
      TOTAL := TOTAL + CHARACTER'POS(CHAR(STR, CNT)) - CHARACTER'POS('0'); 
      CNT := CNT + 1; 
    end loop; 
    return CHARACTER'VAL(TOTAL); 
  end OTOI; 


  -- readable_form - return the the human-readable form of a character
  --
  -- The returned string is in static storage.

  function READABLE_FORM(C : in CHARACTER) return VSTRING is 
  begin
    if ((CHARACTER'POS(C) >= 0 and CHARACTER'POS(C) < 32) or (C = ASCII.DEL))
      then 
      case C is 
        when ASCII.LF => 
          return (VSTR("\n")); 

        -- Newline
        when ASCII.HT => 
          return (VSTR("\t")); 

        -- Horizontal Tab
        when ASCII.FF => 
          return (VSTR("\f")); 

        -- Form Feed
        when ASCII.CR => 
          return (VSTR("\r")); 

        -- Carriage Return
        when ASCII.BS => 
          return (VSTR("\b")); 

        -- Backspace
        when others => 
          return VSTR("\" & INTEGER'IMAGE(CHARACTER'POS(C))); 
      end case; 
    elsif (C = ' ') then 
      return VSTR("' '"); 
    else 
      return VSTR(C); 
    end if; 
  end READABLE_FORM; 

  -- transition_struct_out - output a yy_trans_info structure
  --
  -- outputs the yy_trans_info structure with the two elements, element_v and
  -- element_n.  Formats the output with spaces and carriage returns.

  procedure TRANSITION_STRUCT_OUT(ELEMENT_V, ELEMENT_N : in INTEGER) is 
  begin
    INT_IO.PUT(ELEMENT_V, 7); 
    TEXT_IO.PUT(", "); 
    INT_IO.PUT(ELEMENT_N, 5); 
    TEXT_IO.PUT(","); 
    DATAPOS := DATAPOS + TRANS_STRUCT_PRINT_LENGTH; 

    if (DATAPOS >= 75) then 
      TEXT_IO.NEW_LINE; 

      DATALINE := DATALINE + 1; 
      if (DATALINE mod 10 = 0) then 
        TEXT_IO.NEW_LINE; 
      end if; 

      DATAPOS := 0; 
    end if; 
  end TRANSITION_STRUCT_OUT; 

  function SET_YY_TRAILING_HEAD_MASK(SRC : in INTEGER) return INTEGER is 
  begin
    if (CHECK_YY_TRAILING_HEAD_MASK(SRC) = 0) then 
      return SRC + YY_TRAILING_HEAD_MASK; 
    else 
      return SRC; 
    end if; 
  end SET_YY_TRAILING_HEAD_MASK; 

  function CHECK_YY_TRAILING_HEAD_MASK(SRC : in INTEGER) return INTEGER is 
  begin
    if (SRC >= YY_TRAILING_HEAD_MASK) then 
      return YY_TRAILING_HEAD_MASK; 
    else 
      return 0; 
    end if; 
  end CHECK_YY_TRAILING_HEAD_MASK; 

  function SET_YY_TRAILING_MASK(SRC : in INTEGER) return INTEGER is 
  begin
    if (CHECK_YY_TRAILING_MASK(SRC) = 0) then 
      return SRC + YY_TRAILING_MASK; 
    else 
      return SRC; 
    end if; 
  end SET_YY_TRAILING_MASK; 

  function CHECK_YY_TRAILING_MASK(SRC : in INTEGER) return INTEGER is 
  begin

-- this test is whether both bits are on, or whether onlyy TRAIL_MASK is set
    if ((SRC >= YY_TRAILING_HEAD_MASK + YY_TRAILING_MASK) or ((
      CHECK_YY_TRAILING_HEAD_MASK(SRC) = 0) and (SRC >= YY_TRAILING_MASK)))
      then 
      return YY_TRAILING_MASK; 
    else 
      return 0; 
    end if; 
  end CHECK_YY_TRAILING_MASK; 

  function ISLOWER(C : in CHARACTER) return BOOLEAN is 
  begin
    return (C in 'a' .. 'z'); 
  end ISLOWER; 


  function ISUPPER(C : in CHARACTER) return BOOLEAN is 
  begin
    return (C in 'A' .. 'Z'); 
  end ISUPPER; 

  function ISDIGIT(C : in CHARACTER) return BOOLEAN is 
  begin
    return (C in '0' .. '9'); 
  end ISDIGIT; 

  function TOLOWER(C : in INTEGER) return INTEGER is 
  begin
    return C - CHARACTER'POS('A') + CHARACTER'POS('a'); 
  end TOLOWER; 

  procedure SYNERR(STR : in STRING) is 
    use TEXT_IO; 
  begin
    SYNTAXERROR := TRUE; 
    TEXT_IO.PUT(STANDARD_ERROR, "Syntax error at line "); 
    INT_IO.PUT(STANDARD_ERROR, LINENUM); 
    TEXT_IO.PUT(STANDARD_ERROR, STR); 
    TEXT_IO.NEW_LINE(STANDARD_ERROR); 
  end SYNERR; 

end Aflex_MISC; 

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE  miscellaneous aflex routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION
-- NOTES contains functions used in various places throughout aflex.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/misc.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS, TSTRING, TEXT_IO; 
package Aflex_MISC is 
  use MISC_DEFS; 
  use TSTRING; 
  use TEXT_IO; 
  procedure ACTION_OUT; 
  procedure BUBBLE(V : in INT_PTR; 
                   N : in INTEGER); 
  function CLOWER(C : in INTEGER) return INTEGER; 
  procedure CSHELL(V : in out CHAR_ARRAY; 
                   N : in INTEGER); 
  procedure DATAEND; 
  procedure DATAFLUSH; 
  procedure DATAFLUSH(FILE : in FILE_TYPE); 
  function AFLEX_GETTIME return VSTRING; 
  procedure AFLEXERROR(MSG : in VSTRING); 
  procedure AFLEXERROR(MSG : in STRING); 
  function ALL_UPPER(STR : in VSTRING) return BOOLEAN; 
  function ALL_LOWER(STR : in VSTRING) return BOOLEAN; 
  procedure AFLEXFATAL(MSG : in VSTRING); 
  procedure AFLEXFATAL(MSG : in STRING); 
  procedure LINE_DIRECTIVE_OUT; 
  procedure LINE_DIRECTIVE_OUT(OUTPUT_FILE_NAME : in FILE_TYPE); 
  procedure MK2DATA(VALUE : in INTEGER); 
  procedure MK2DATA(FILE  : in FILE_TYPE; 
                    VALUE : in INTEGER); 
  procedure MKDATA(VALUE : in INTEGER); 
  function MYCTOI(NUM_ARRAY : in VSTRING) return INTEGER; 
  function MYESC(ARR : in VSTRING) return CHARACTER; 
  function OTOI(STR : in VSTRING) return CHARACTER; 
  function READABLE_FORM(C : in CHARACTER) return VSTRING; 
  procedure SYNERR(STR : in STRING); 
  procedure TRANSITION_STRUCT_OUT(ELEMENT_V, ELEMENT_N : in INTEGER); 
  function SET_YY_TRAILING_HEAD_MASK(SRC : in INTEGER) return INTEGER; 
  function CHECK_YY_TRAILING_HEAD_MASK(SRC : in INTEGER) return INTEGER; 
  function SET_YY_TRAILING_MASK(SRC : in INTEGER) return INTEGER; 
  function CHECK_YY_TRAILING_MASK(SRC : in INTEGER) return INTEGER; 
  function ISLOWER(C : in CHARACTER) return BOOLEAN; 
  function ISUPPER(C : in CHARACTER) return BOOLEAN; 
  function ISDIGIT(C : in CHARACTER) return BOOLEAN; 
  function TOLOWER(C : in INTEGER) return INTEGER; 
  function BASENAME return VSTRING; 
end Aflex_MISC; 

pragma Style_Checks(Off);

with PARSE_TOKENS, SCANNER; use PARSE_TOKENS, SCANNER; 

package body AFLEX_SCANNER is 
  function YYLEX return TOKEN is 
  begin
    return SCANNER.GET_TOKEN; 
  end YYLEX; 

end AFLEX_SCANNER; 

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE  scanner parser interface
-- AUTHOR: John Self (UCI)
-- DESCRIPTION causes parser to call augmented version of YYLex.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/aflex_scanner.ada,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with PARSE_TOKENS, SCANNER; use PARSE_TOKENS, SCANNER; 

package AFLEX_SCANNER is 
  function YYLEX return TOKEN; 
end AFLEX_SCANNER; 

-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE scanner specification file
-- AUTHOR: John Self (UCI)
-- DESCRIPTION regular expressions and actions matching tokens
--             that aflex expects to find in its input.
-- NOTES input to aflex (NOT alex.)  It uses exclusive start conditions
--       and case insensitive scanner generation available only in aflex
--       (or flex if you use C.)
--       generate scanner using the command 'aflex -is ascan.l'
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/ascan.l,v 1.1 2011/03/02 23:41:49 stt Exp stt $ 

%x SECT2 SECT2PROLOG SECT3 PICKUPDEF SC CARETISBOL NUM QUOTE
%x FIRSTCCL CCL ACTION RECOVER BRACEERROR
%x ACTION_STRING

WS		[ \t\f]+
OPTWS		[ \t\f]*
NOT_WS		[^ \t\f\n]

NAME		[a-z_][a-z_0-9-]*
NOT_NAME	[^a-z_\n]+

SCNAME		{NAME}

ESCSEQ		\\([^\n]|[0-9]{1,3})

%%

^{WS}			{ indented_code := true; }
^#.*\n			{ linenum := linenum + 1; ECHO;
				-- treat as a comment;
			}
^{OPTWS}"--".*\n	{ linenum := linenum + 1; ECHO; }
^"%s"(tart)?		{ return ( SCDECL ); }
^"%x"			{ return ( XSCDECL ); }

{WS}			{ return ( WHITESPACE ); }

^"%%".*			{
			sectnum := 2;
			misc.line_directive_out;
			ENTER(SECT2PROLOG);
			return ( SECTEND );
			}

^"%"[^%sx]" ".*\n		{
			text_io.put( Standard_Error, "old-style lex command at line " );
			int_io.put( Standard_Error, linenum );
			text_io.put( Standard_Error, "ignored:" );
			text_io.new_line( Standard_Error );
			text_io.put( Standard_Error, ASCII.HT );
			text_io.put( Standard_Error, yytext(1..YYLength) );
			linenum := linenum + 1;
			}

^{NAME}			{
			nmstr := vstr(yytext(1..YYLength));
			didadef := false;
			ENTER(PICKUPDEF);
			}

{SCNAME}		{ nmstr := vstr(yytext(1..YYLength));
			  return NAME;
			}
^{OPTWS}\n		{ linenum := linenum + 1;
			  -- allows blank lines in section 1;
			}
{OPTWS}\n			{ linenum := linenum + 1; return Newline; }
.			{ misc.synerr( "illegal character" );ENTER(RECOVER);}

<PICKUPDEF>{WS}		{ null;
			  -- separates name and definition;
			}

<PICKUPDEF>{NOT_WS}.*	{
			nmdef := vstr(yytext(1..YYLength));

			i := tstring.len( nmdef );
			while ( i >= tstring.first ) loop
			    if ( (CHAR(nmdef,i) /= ' ') and
				 (CHAR(nmdef,i) /= ASCII.HT) ) then
				exit;
			    end if;
			    i := i - 1;
			end loop;

                        sym.ndinstal( nmstr,
				tstring.slice(nmdef, tstring.first, i) );
			didadef := true;
			}

<PICKUPDEF>\n		{
			if ( not didadef ) then
			    misc.synerr( "incomplete name definition" );
			end if;
			ENTER(0);
			linenum := linenum + 1;
			}

<RECOVER>.*\n		{ linenum := linenum + 1;
			  ENTER(0);
			  nmstr := vstr(yytext(1..YYLength));
			  return NAME;
			}

<SECT2PROLOG>.*\n/{NOT_WS}	{
			linenum := linenum + 1;
			ACTION_ECHO;
			MARK_END_OF_PROLOG;
			ENTER(SECT2);
			}

<SECT2PROLOG>.*\n	{ linenum := linenum + 1; ACTION_ECHO; }

<SECT2PROLOG><<EOF>>	{ MARK_END_OF_PROLOG;
			  return End_Of_Input;
			}

<SECT2>^{OPTWS}\n	{ linenum := linenum + 1;
			  -- allow blank lines in sect2;}
			
			-- this rule matches indented lines which
			-- are not comments.
<SECT2>^{WS}{NOT_WS}"--".*\n	{
			misc.synerr("indented code found outside of action");
			linenum := linenum + 1;
			}

<SECT2>"<"		{ ENTER(SC); return ( '<' ); }
<SECT2>^"^"		{ return ( '^' ); } 
<SECT2>\"		{ ENTER(QUOTE); return ( '"' ); }
<SECT2>"{"/[0-9]		{ ENTER(NUM); return ( '{' ); }
<SECT2>"{"[^0-9\n][^}\n]*	{ ENTER(BRACEERROR); }
<SECT2>"$"/[ \t\n]	{ return ( '$' ); }

<SECT2>{WS}"|".*\n	{ continued_action := true;
			  linenum := linenum + 1;
			  return Newline;
			}

<SECT2>^{OPTWS}"--".*\n	{ linenum := linenum + 1; ACTION_ECHO; }

<SECT2>{WS}		{
			-- this rule is separate from the one below because
			-- otherwise we get variable trailing context, so
			-- we can't build the scanner using -{f,F}

			bracelevel := 0;
			continued_action := false;
			ENTER(ACTION);
			return Newline;
			}

<SECT2>{OPTWS}/\n	{
			bracelevel := 0;
			continued_action := false;
			ENTER(ACTION);
			return Newline;
			}

<SECT2>^{OPTWS}\n	{ linenum := linenum + 1; return Newline; }

<SECT2>"<<EOF>>"	{ return ( EOF_OP ); }

<SECT2>^"%%".*		{
			sectnum := 3;
			ENTER(SECT3);
			return ( End_Of_Input );
			-- to stop the parser
			}

<SECT2>"["([^\\\]\n]|{ESCSEQ})+"]"	{

			nmstr := vstr(yytext(1..YYLength));

			-- check to see if we've already encountered this ccl
                        cclval := sym.ccllookup( nmstr );
			if ( cclval /= 0 ) then
			    yylval := cclval;
			    cclreuse := cclreuse + 1;
			    return ( PREVCCL );
			else
			    -- we fudge a bit.  We know that this ccl will
			    -- soon be numbered as lastccl + 1 by cclinit
			    sym.cclinstal( nmstr, lastccl + 1 );

			    -- push back everything but the leading bracket
			    -- so the ccl can be rescanned

			    PUT_BACK_STRING(nmstr, 1);

			    ENTER(FIRSTCCL);
			    return ( '[' );
			end if;
			}

<SECT2>"{"{NAME}"}"	{
			nmstr := vstr(yytext(1..YYLength));
			-- chop leading and trailing brace
			tmpbuf := slice(vstr(yytext(1..YYLength)),
								2, YYLength-1);

			nmdefptr := sym.ndlookup( tmpbuf );
			if ( nmdefptr = NUL ) then
			    misc.synerr( "undefined {name}" );
			else
			    -- push back name surrounded by ()'s
			    unput(')');
			    PUT_BACK_STRING(nmdefptr, 0);
			    unput('(');
			end if;
			}

<SECT2>[/|*+?.()]	{ tmpbuf := vstr(yytext(1..YYLength));
			  case tstring.CHAR(tmpbuf,1) is
				when '/' => return '/';
				when '|' => return '|';
				when '*' => return '*';
				when '+' => return '+';
				when '?' => return '?';
				when '.' => return '.';
				when '(' => return '(';
				when ')' => return ')';
				when others =>
					misc.aflexerror("error in aflex case");
			  end case;
			}
<SECT2>.		{ tmpbuf := vstr(yytext(1..YYLength));
			  yylval := CHARACTER'POS(CHAR(tmpbuf,1));
			  return CHAR;
			}
<SECT2>\n		{ linenum := linenum + 1; return Newline; }


<SC>","			{ return ( ',' ); }
<SC>">"			{ ENTER(SECT2); return ( '>' ); }
<SC>">"/"^"		{ ENTER(CARETISBOL); return ( '>' ); }
<SC>{SCNAME}		{ nmstr := vstr(yytext(1..YYLength));
			  return NAME;
			}
<SC>.			{ misc.synerr( "bad start condition name" ); }

<CARETISBOL>"^"		{ ENTER(SECT2); return ( '^' ); }


<QUOTE>[^"\n]		{ tmpbuf := vstr(yytext(1..YYLength));
			  yylval := CHARACTER'POS(CHAR(tmpbuf,1));
			  return CHAR;
			}
<QUOTE>\"		{ ENTER(SECT2); return ( '"' ); }

<QUOTE>\n		{
			misc.synerr( "missing quote" );
			ENTER(SECT2);
			linenum := linenum + 1;
			return ( '"' );
			}


<FIRSTCCL>"^"/[^-\n]	{ ENTER(CCL); return ( '^' ); }
<FIRSTCCL>"^"/-		{ return ( '^' ); }
<FIRSTCCL>-		{ ENTER(CCL); yylval := CHARACTER'POS('-'); return ( CHAR ); }
<FIRSTCCL>.		{ ENTER(CCL);
			  tmpbuf := vstr(yytext(1..YYLength));
			  yylval := CHARACTER'POS(CHAR(tmpbuf,1));
			  return CHAR;
			}

<CCL>-/[^\]\n]		{ return ( '-' ); }
<CCL>[^\]\n]		{ tmpbuf := vstr(yytext(1..YYLength));
			  yylval := CHARACTER'POS(CHAR(tmpbuf,1));
			  return CHAR;
			}
<CCL>"]"		{ ENTER(SECT2); return ( ']' ); }


<NUM>[0-9]+		{
			yylval := misc.myctoi( vstr(yytext(1..YYLength)) );
			return ( NUMBER );
			}

<NUM>","			{ return ( ',' ); }
<NUM>"}"			{ ENTER(SECT2); return ( '}' ); }

<NUM>.			{
			misc.synerr( "bad character inside {}'s" );
			ENTER(SECT2);
			return ( '}' );
			}

<NUM>\n			{
			misc.synerr( "missing }" );
			ENTER(SECT2);
			linenum := linenum + 1;
			return ( '}' );
			}


<BRACEERROR>"}"		{ misc.synerr( "bad name in {}'s" ); ENTER(SECT2); }
<BRACEERROR>\n		{ misc.synerr( "missing }" );
			  linenum := linenum + 1;
			  ENTER(SECT2);
			}

<ACTION>"{"		{ bracelevel := bracelevel + 1; }
<ACTION>"}"		{ bracelevel := bracelevel - 1; }
<ACTION>[^a-z_{}"'/\n]+	{ ACTION_ECHO; }
<ACTION>{NAME}		{ ACTION_ECHO; }
<ACTION>"--".*\n	{ linenum := linenum + 1; ACTION_ECHO; }
<ACTION>"'"([^'\\\n]|\\.)*"'"	{ ACTION_ECHO;
				  -- character constant;
			}

<ACTION>\"		{ ACTION_ECHO; ENTER(ACTION_STRING); }

<ACTION>\n		{
			linenum := linenum + 1;
			ACTION_ECHO;
			if ( bracelevel = 0 ) then
			    text_io.new_line ( temp_action_file );
			    ENTER(SECT2);
	                end if;
			}
<ACTION>.		{ ACTION_ECHO; }

<ACTION_STRING>[^"\\\n]+	{ ACTION_ECHO; }
<ACTION_STRING>\\.	{ ACTION_ECHO; }
<ACTION_STRING>\n	{ linenum := linenum + 1; ACTION_ECHO; }
<ACTION_STRING>\"	{ ACTION_ECHO; ENTER(ACTION); }
<ACTION_STRING>.	{ ACTION_ECHO; }


<SECT2,QUOTE,CCL>{ESCSEQ}	{
			yylval := CHARACTER'POS(misc.myesc( vstr(yytext(1..YYLength)) ));
			return ( CHAR );
			}

<FIRSTCCL>{ESCSEQ}	{
			yylval := CHARACTER'POS(misc.myesc( vstr(yytext(1..YYLength)) ));
			ENTER(CCL);
			return ( CHAR );
			}


<SECT3>.*(\n?)		{ if ( check_yylex_here ) then
				return End_Of_Input;
			  else
				ECHO;
			  end if;
			}
%%

with misc_defs, misc, sym, parse_tokens, int_io;
with tstring, ascan_dfa, ascan_io, external_file_manager;
use misc_defs, parse_tokens, tstring;
use ascan_dfa, ascan_io, external_file_manager;

package scanner is
    call_yylex : boolean := false;
    function get_token return Token;
end scanner;

package body scanner is

beglin : boolean := false;
i, bracelevel: integer;

function get_token return Token is
    toktype : Token;
    didadef, indented_code : boolean;
    cclval : integer;
    nmdefptr : vstring;
    nmdef, tmpbuf : vstring;

procedure ACTION_ECHO is
begin
    text_io.put( temp_action_file, yytext(1..YYLength) );
end ACTION_ECHO;

procedure MARK_END_OF_PROLOG is
begin
     text_io.put( temp_action_file, "%%%% end of prolog" );
     text_io.new_line( temp_action_file );
end MARK_END_OF_PROLOG;

procedure PUT_BACK_STRING(str : vstring; start : integer) is
begin
	for i in reverse start+1..tstring.len(str) loop
	    unput( CHAR(str,i) );
	end loop;
end PUT_BACK_STRING;

function check_yylex_here return boolean is
begin
	return ( (yytext'length >= 2) and then
			((yytext(1) = '#') and (yytext(2) = '#')));
end check_yylex_here;

##
begin
    if (call_yylex) then
    	toktype := YYLex;
    	call_yylex := false;
    	return toktype;
    end if;

    if ( eofseen ) then
	toktype := End_Of_Input;
    else
	toktype := YYLex;
    end if;
-- this tracing code allows easy tracing of aflex runs
if (trace) then
text_io.new_line(Standard_Error);
text_io.put(Standard_Error, "toktype = :" );
text_io.put(Standard_Error, Token'image(toktype));
text_io.put_line(Standard_Error, ":" );
end if;

    if ( toktype = End_Of_Input ) then
	eofseen := true;

	if ( sectnum = 1 ) then
	    misc.synerr(  "unexpected EOF" );
	    sectnum := 2;
	    toktype := SECTEND;
	else
	    if ( sectnum = 2 ) then
	    	sectnum := 3;
	    	toktype := SECTEND;
	    end if;
    	end if;
    end if;
    
    if ( trace ) then
	if ( beglin ) then
	    int_io.put( Standard_Error, num_rules + 1 );
	    text_io.put( Standard_Error, ASCII.HT );
	    beglin := false;
    	end if;

	case toktype is
	    when '<' | '>'|'^'|'$'|'"'|'['|']'|'{'|'}'|'|'|'('|
    	    	 ')'|'-'|'/'|'?'|'.'|'*'|'+'|',' =>
		text_io.put( Standard_Error, Token'image(toktype) );

	    when NEWLINE =>
		text_io.new_line(Standard_Error);
		if ( sectnum = 2 ) then
		    beglin := true;
    	    	end if;

	    when SCDECL =>
		text_io.put( Standard_Error, "%s" );

	    when XSCDECL =>
   		text_io.put( Standard_Error, "%x" );

	    when WHITESPACE =>
       		text_io.put( Standard_Error, " " );

	    when SECTEND =>
       		text_io.put_line( Standard_Error, "%%" );	   

		-- we set beglin to be true so we'll start
		-- writing out numbers as we echo rules.  aflexscan() has
		-- already assigned sectnum

		if ( sectnum = 2 ) then
		    beglin := true;
    	    	end if;

	    when NAME =>
		text_io.put( Standard_Error, ''' );
		text_io.put( Standard_Error, YYText);
		text_io.put( Standard_Error, ''' );

	    when CHAR =>
	    	if ( (yylval < CHARACTER'POS(' ')) or
		     (yylval = CHARACTER'POS(ASCII.DEL)) ) then
		    text_io.put( Standard_Error, '\' );
		    int_io.put( Standard_Error, yylval );
    		    text_io.put( Standard_Error, '\' );
		else
		    text_io.put( Standard_Error, Token'image(toktype) );
    	    	end if;

	    when NUMBER =>
    	    	int_io.put( Standard_Error, yylval );

	    when PREVCCL =>
		text_io.put( Standard_Error, '[' );
   	    	int_io.put( Standard_Error, yylval );
		text_io.put( Standard_Error, ']' );		

    	    when End_Of_Input =>
    	    	text_io.put( Standard_Error, "End Marker" );

	    when others =>
	    	text_io.put( Standard_Error, "Something weird:" );
		text_io.put_line( Standard_Error, Token'image(toktype));
    	end case;
    end if;
	    
    return toktype;

end get_token;
end scanner;

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE character classes routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION routines for character classes like [abc]
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/ccl.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS, TEXT_IO, Aflex_MISC, TSTRING; use MISC_DEFS, TEXT_IO; 
package body CCL is 

-- ccladd - add a single character to a ccl
  procedure CCLADD(CCLP : in INTEGER; 
                   CH   : in CHARACTER) is 
    IND, LEN, NEWPOS : INTEGER; 
  begin
    LEN := CCLLEN(CCLP); 
    IND := CCLMAP(CCLP); 

    -- check to see if the character is already in the ccl
    for I in 0 .. LEN - 1 loop
      if (CCLTBL(IND + I) = CH) then 
        return; 
      end if; 
    end loop; 

    NEWPOS := IND + LEN; 

    if (NEWPOS >= CURRENT_MAX_CCL_TBL_SIZE) then 
      CURRENT_MAX_CCL_TBL_SIZE := CURRENT_MAX_CCL_TBL_SIZE + 
        MAX_CCL_TBL_SIZE_INCREMENT; 

      NUM_REALLOCS := NUM_REALLOCS + 1; 

      REALLOCATE_CHARACTER_ARRAY(CCLTBL, CURRENT_MAX_CCL_TBL_SIZE); 
    end if; 

    CCLLEN(CCLP) := LEN + 1; 
    CCLTBL(NEWPOS) := CH; 

  end CCLADD; 

  -- cclinit - make an empty ccl

  function CCLINIT return INTEGER is 
  begin
    LASTCCL := LASTCCL + 1; 
    if (LASTCCL >= CURRENT_MAXCCLS) then 
      CURRENT_MAXCCLS := CURRENT_MAXCCLS + MAX_CCLS_INCREMENT; 

      NUM_REALLOCS := NUM_REALLOCS + 1; 

      REALLOCATE_INTEGER_ARRAY(CCLMAP, CURRENT_MAXCCLS); 
      REALLOCATE_INTEGER_ARRAY(CCLLEN, CURRENT_MAXCCLS); 
      REALLOCATE_INTEGER_ARRAY(CCLNG, CURRENT_MAXCCLS); 
    end if; 

    if (LASTCCL = 1) then 

      -- we're making the first ccl
      CCLMAP(LASTCCL) := 0; 

    else 

      -- the new pointer is just past the end of the last ccl.  Since
      -- the cclmap points to the \first/ character of a ccl, adding the
      -- length of the ccl to the cclmap pointer will produce a cursor
      -- to the first free space
      CCLMAP(LASTCCL) := CCLMAP(LASTCCL - 1) + CCLLEN(LASTCCL - 1); 
    end if; 

    CCLLEN(LASTCCL) := 0; 
    CCLNG(LASTCCL) := 0; 

    -- ccl's start out life un-negated
    return LASTCCL; 
  end CCLINIT; 

  -- cclnegate - negate a ccl

  procedure CCLNEGATE(CCLP : in INTEGER) is 
  begin
    CCLNG(CCLP) := 1; 
  end CCLNEGATE; 

  -- list_character_set - list the members of a set of characters in CCL form
  --
  -- writes to the given file a character-class representation of those
  -- characters present in the given set.  A character is present if it
  -- has a non-zero value in the set array.

  procedure LIST_CHARACTER_SET(F    : in FILE_TYPE; 
                               CSET : in C_SIZE_BOOL_ARRAY) is 
    I, START_CHAR : INTEGER; 
  begin
    TEXT_IO.PUT(F, '['); 

    I := 1; 
    while (I <= CSIZE) loop
      if (CSET(I)) then 
        START_CHAR := I; 

        TEXT_IO.PUT(F, ' '); 

        TSTRING.PUT(F, Aflex_MISC.READABLE_FORM(CHARACTER'VAL(I))); 

        I := I + 1; 
        while ((I <= CSIZE) and then (CSET(I))) loop
          I := I + 1; 
        end loop; 

        if (I - 1 > START_CHAR) then 

          -- this was a run
          TEXT_IO.PUT(F, "-"); 
          TSTRING.PUT(F, Aflex_MISC.READABLE_FORM(CHARACTER'VAL(I - 1))); 
        end if; 

        TEXT_IO.PUT(F, ' '); 
      end if; 
      I := I + 1; 
    end loop; 

    TEXT_IO.PUT(F, ']'); 
  end LIST_CHARACTER_SET; 
end CCL; 

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE character classes routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION routines for character classes like [abc]
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/ccl.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS, TEXT_IO; use MISC_DEFS, TEXT_IO; 
package CCL is 
  procedure CCLADD(CCLP : in INTEGER; 
                   CH   : in CHARACTER); 
  function CCLINIT return INTEGER; 
  procedure CCLNEGATE(CCLP : in INTEGER); 
  procedure LIST_CHARACTER_SET(F    : in FILE_TYPE; 
                               CSET : in C_SIZE_BOOL_ARRAY); 
end CCL; 

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE DFA construction routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION converts non-deterministic finite automatons to finite ones.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/dfa.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with DFA, INT_IO, MISC_DEFS, TEXT_IO, Aflex_MISC, TBLCMP, CCL, EXTERNAL_FILE_MANAGER; 
with ECS, NFA, TSTRING, GEN, SKELETON_MANAGER; use MISC_DEFS, 
  EXTERNAL_FILE_MANAGER; 

package body DFA is 
  use TSTRING; 
  package MISC renames Aflex_MISC;
  -- check_for_backtracking - check a DFA state for backtracking
  --
  -- ds is the number of the state to check and state[) is its out-transitions,
  -- indexed by equivalence class, and state_rules[) is the set of rules
  -- associated with this state

  DID_STK_INIT : BOOLEAN := FALSE; 
  STK          : INT_PTR; 

  procedure CHECK_FOR_BACKTRACKING(DS    : in INTEGER; 
                                   STATE : in UNBOUNDED_INT_ARRAY) is 
    use MISC_DEFS; 
  begin
    if (DFAACC(DS).DFAACC_STATE = 0) then 

      -- state is non-accepting
      NUM_BACKTRACKING := NUM_BACKTRACKING + 1; 

      if (BACKTRACK_REPORT) then 
        TEXT_IO.PUT(BACKTRACK_FILE, "State #"); 
        INT_IO.PUT(BACKTRACK_FILE, DS, 1); 
        TEXT_IO.PUT(BACKTRACK_FILE, "is non-accepting -"); 
        TEXT_IO.NEW_LINE(BACKTRACK_FILE); 

        -- identify the state
        DUMP_ASSOCIATED_RULES(BACKTRACK_FILE, DS); 

        -- now identify it further using the out- and jam-transitions
        DUMP_TRANSITIONS(BACKTRACK_FILE, STATE); 
        TEXT_IO.NEW_LINE(BACKTRACK_FILE); 
      end if; 
    end if; 
  end CHECK_FOR_BACKTRACKING; 


  -- check_trailing_context - check to see if NFA state set constitutes
  --                          "dangerous" trailing context
  --
  -- NOTES
  --    Trailing context is "dangerous" if both the head and the trailing
  --  part are of variable size \and/ there's a DFA state which contains
  --  both an accepting state for the head part of the rule and NFA states
  --  which occur after the beginning of the trailing context.
  --  When such a rule is matched, it's impossible to tell if having been
  --  in the DFA state indicates the beginning of the trailing context
  --  or further-along scanning of the pattern.  In these cases, a warning
  --  message is issued.
  --
  --    nfa_states[1 .. num_states) is the list of NFA states in the DFA.
  --    accset[1 .. nacc) is the list of accepting numbers for the DFA state.

  procedure CHECK_TRAILING_CONTEXT(NFA_STATES : in INT_PTR; 
                                   NUM_STATES : in INTEGER; 
                                   ACCSET     : in INT_PTR; 
                                   NACC       : in INTEGER) is 
    NS, AR              : INTEGER; 
    STATE_VAR, TYPE_VAR : STATE_ENUM; 

    use MISC_DEFS, MISC, TEXT_IO; 
  begin
    for I in 1 .. NUM_STATES loop
      NS := NFA_STATES(I); 
      TYPE_VAR := STATE_TYPE(NS); 
      AR := ASSOC_RULE(NS); 

      if ((TYPE_VAR = STATE_NORMAL) or (RULE_TYPE(AR) /= RULE_VARIABLE)) then 
        null; 

      -- do nothing
      else 
        if (TYPE_VAR = STATE_TRAILING_CONTEXT) then 

          -- potential trouble.  Scan set of accepting numbers for
          -- the one marking the end of the "head".  We assume that
          -- this looping will be fairly cheap since it's rare that
          -- an accepting number set is large.
          for J in 1 .. NACC loop
            if (CHECK_YY_TRAILING_HEAD_MASK(ACCSET(J)) /= 0) then 
              TEXT_IO.PUT(STANDARD_ERROR, 
                "aflex: Dangerous trailing context in rule at line "); 
              INT_IO.PUT(STANDARD_ERROR, RULE_LINENUM(AR), 1); 
              TEXT_IO.NEW_LINE(STANDARD_ERROR); 
              return; 
            end if; 
          end loop; 
        end if; 
      end if; 
    end loop; 
  end CHECK_TRAILING_CONTEXT; 


  -- dump_associated_rules - list the rules associated with a DFA state
  --
  -- goes through the set of NFA states associated with the DFA and
  -- extracts the first MAX_ASSOC_RULES unique rules, sorts them,
  -- and writes a report to the given file

  procedure DUMP_ASSOCIATED_RULES(F  : in FILE_TYPE; 
                                  DS : in INTEGER) is 
    J                    : INTEGER; 
    NUM_ASSOCIATED_RULES : INTEGER := 0; 
    RULE_SET             : INT_PTR; 
    SIZE, RULE_NUM       : INTEGER; 
  begin
    RULE_SET := new UNBOUNDED_INT_ARRAY(0 .. MAX_ASSOC_RULES + 1); 
    SIZE := DFASIZ(DS); 

    for I in 1 .. SIZE loop
      RULE_NUM := RULE_LINENUM(ASSOC_RULE(DSS(DS)(I))); 

      J := 1; 
      while (J <= NUM_ASSOCIATED_RULES) loop
        if (RULE_NUM = RULE_SET(J)) then 
          exit; 
        end if; 
        J := J + 1; 
      end loop; 
      if (J > NUM_ASSOCIATED_RULES) then 

        --new rule
        if (NUM_ASSOCIATED_RULES < MAX_ASSOC_RULES) then 
          NUM_ASSOCIATED_RULES := NUM_ASSOCIATED_RULES + 1; 
          RULE_SET(NUM_ASSOCIATED_RULES) := RULE_NUM; 
        end if; 
      end if; 
    end loop; 

    MISC.BUBBLE(RULE_SET, NUM_ASSOCIATED_RULES); 

    TEXT_IO.PUT(F, " associated rules:"); 

    for I in 1 .. NUM_ASSOCIATED_RULES loop
      if (I mod 8 = 1) then 
        TEXT_IO.NEW_LINE(F); 
      end if; 

      TEXT_IO.PUT(F, ASCII.HT); 
      INT_IO.PUT(F, RULE_SET(I), 1); 
    end loop; 

    TEXT_IO.NEW_LINE(F); 
  exception
    when STORAGE_ERROR => 
      MISC.AFLEXFATAL("dynamic memory failure in dump_associated_rules()"); 
  end DUMP_ASSOCIATED_RULES; 


  -- dump_transitions - list the transitions associated with a DFA state
  --
  -- goes through the set of out-transitions and lists them in human-readable
  -- form (i.e., not as equivalence classes); also lists jam transitions
  -- (i.e., all those which are not out-transitions, plus EOF).  The dump
  -- is done to the given file.

  procedure DUMP_TRANSITIONS(F     : in FILE_TYPE; 
                             STATE : in UNBOUNDED_INT_ARRAY) is 
    EC           : INTEGER; 
    OUT_CHAR_SET : C_SIZE_BOOL_ARRAY; 
  begin
    for I in 1 .. CSIZE loop
      EC := ECGROUP(I); 

      if (EC < 0) then 
        EC :=  -EC; 
      end if; 

      OUT_CHAR_SET(I) := (STATE(EC) /= 0); 
    end loop; 

    TEXT_IO.PUT(F, " out-transitions: "); 

    CCL.LIST_CHARACTER_SET(F, OUT_CHAR_SET); 

    -- now invert the members of the set to get the jam transitions
    for I in 1 .. CSIZE loop
      OUT_CHAR_SET(I) := not OUT_CHAR_SET(I); 
    end loop; 

    TEXT_IO.NEW_LINE(F); 
    TEXT_IO.PUT(F, "jam-transitions: EOF "); 

    CCL.LIST_CHARACTER_SET(F, OUT_CHAR_SET); 

    TEXT_IO.NEW_LINE(F); 
  end DUMP_TRANSITIONS; 


  -- epsclosure - construct the epsilon closure of a set of ndfa states
  --
  -- NOTES
  --    the epsilon closure is the set of all states reachable by an arbitrary
  --  number of epsilon transitions which themselves do not have epsilon
  --  transitions going out, unioned with the set of states which have non-null
  --  accepting numbers.  t is an array of size numstates of nfa state numbers.
--  Upon return, t holds the epsilon closure and numstates is updated.  accset
  --  holds a list of the accepting numbers, and the size of accset is given
  --  by nacc.  t may be subjected to reallocation if it is not large enough
  --  to hold the epsilon closure.
  --
  --    hashval is the hash value for the dfa corresponding to the state set

  procedure EPSCLOSURE(T                  : in out INT_PTR; 
                       NS_ADDR            : in out INTEGER; 
                       ACCSET             : in out INT_PTR; 
                       NACC_ADDR, HV_ADDR : out INTEGER) is
    NS, TSP                                      : INTEGER; 
    NUMSTATES, NACC, HASHVAL, TRANSSYM, NFACCNUM : INTEGER; 
    STKEND                                       : INTEGER; 
    STKPOS                                       : INTEGER; 
    procedure MARK_STATE(STATE : in INTEGER) is 
    begin
      TRANS1(STATE) := TRANS1(STATE) - MARKER_DIFFERENCE; 
    end MARK_STATE; 
    pragma INLINE(MARK_STATE); 

    function IS_MARKED(STATE : in INTEGER) return BOOLEAN is 
    begin
      return TRANS1(STATE) < 0; 
    end IS_MARKED; 
    pragma INLINE(IS_MARKED); 

    procedure UNMARK_STATE(STATE : in INTEGER) is 
    begin
      TRANS1(STATE) := TRANS1(STATE) + MARKER_DIFFERENCE; 
    end UNMARK_STATE; 
    pragma INLINE(UNMARK_STATE); 


    procedure CHECK_ACCEPT(STATE : in INTEGER) is 
    begin
      NFACCNUM := ACCPTNUM(STATE); 
      if (NFACCNUM /= NIL) then 
        NACC := NACC + 1; 
        ACCSET(NACC) := NFACCNUM; 
      end if; 
    end CHECK_ACCEPT; 
    pragma INLINE(CHECK_ACCEPT); 

    procedure DO_REALLOCATION is 
    begin
      CURRENT_MAX_DFA_SIZE := CURRENT_MAX_DFA_SIZE + MAX_DFA_SIZE_INCREMENT; 
      NUM_REALLOCS := NUM_REALLOCS + 1; 
      REALLOCATE_INTEGER_ARRAY(T, CURRENT_MAX_DFA_SIZE); 
      REALLOCATE_INTEGER_ARRAY(STK, CURRENT_MAX_DFA_SIZE); 
    end DO_REALLOCATION; 
    pragma INLINE(DO_REALLOCATION); 


    procedure PUT_ON_STACK(STATE : in INTEGER) is 
    begin
      STKEND := STKEND + 1; 
      if (STKEND >= CURRENT_MAX_DFA_SIZE) then 
        DO_REALLOCATION; 
      end if; 
      STK(STKEND) := STATE; 
      MARK_STATE(STATE); 
    end PUT_ON_STACK; 
    pragma INLINE(PUT_ON_STACK); 

    procedure ADD_STATE(STATE : in INTEGER) is 
    begin
      NUMSTATES := NUMSTATES + 1; 
      if (NUMSTATES >= CURRENT_MAX_DFA_SIZE) then 
        DO_REALLOCATION; 
      end if; 
      T(NUMSTATES) := STATE; 
      HASHVAL := HASHVAL + STATE; 
    end ADD_STATE; 
    pragma INLINE(ADD_STATE); 

    procedure STACK_STATE(STATE : in INTEGER) is 
    begin
      PUT_ON_STACK(STATE); 
      CHECK_ACCEPT(STATE); 
      if ((NFACCNUM /= NIL) or (TRANSCHAR(STATE) /= SYM_EPSILON)) then 
        ADD_STATE(STATE); 
      end if; 
    end STACK_STATE; 
    pragma INLINE(STACK_STATE); 

  begin

    NUMSTATES := NS_ADDR; 
    if (not DID_STK_INIT) then 
      STK := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_DFA_SIZE); 
      DID_STK_INIT := TRUE; 
    end if; 

    NACC := 0; 
    STKEND := 0; 
    HASHVAL := 0; 

    for NSTATE in 1 .. NUMSTATES loop
      NS := T(NSTATE); 

      -- the state could be marked if we've already pushed it onto
      -- the stack
      if (not IS_MARKED(NS)) then 
        PUT_ON_STACK(NS); 
        null; 
      end if; 

      CHECK_ACCEPT(NS); 
      HASHVAL := HASHVAL + NS; 
    end loop; 


    STKPOS := 1; 
    while (STKPOS <= STKEND) loop
      NS := STK(STKPOS); 
      TRANSSYM := TRANSCHAR(NS); 

      if (TRANSSYM = SYM_EPSILON) then 
        TSP := TRANS1(NS) + MARKER_DIFFERENCE; 

        if (TSP /= NO_TRANSITION) then 
          if (not IS_MARKED(TSP)) then 
            STACK_STATE(TSP); 
          end if; 

          TSP := TRANS2(NS); 

          if (TSP /= NO_TRANSITION) then 
            if (not IS_MARKED(TSP)) then 
              STACK_STATE(TSP); 
            end if; 
          end if; 
        end if; 
      end if; 
      STKPOS := STKPOS + 1; 
    end loop; 

    -- clear out "visit" markers
    for CHK_STKPOS in 1 .. STKEND loop
      if (IS_MARKED(STK(CHK_STKPOS))) then 
        UNMARK_STATE(STK(CHK_STKPOS)); 
      else 
        MISC.AFLEXFATAL("consistency check failed in epsclosure()"); 
      end if; 
    end loop; 

    NS_ADDR := NUMSTATES; 
    HV_ADDR := HASHVAL; 
    NACC_ADDR := NACC; 

  end EPSCLOSURE; 


  -- increase_max_dfas - increase the maximum number of DFAs

  procedure INCREASE_MAX_DFAS is 
  begin
    CURRENT_MAX_DFAS := CURRENT_MAX_DFAS + MAX_DFAS_INCREMENT; 

    NUM_REALLOCS := NUM_REALLOCS + 1; 

    REALLOCATE_INTEGER_ARRAY(BASE, CURRENT_MAX_DFAS); 
    REALLOCATE_INTEGER_ARRAY(DEF, CURRENT_MAX_DFAS); 
    REALLOCATE_INTEGER_ARRAY(DFASIZ, CURRENT_MAX_DFAS); 
    REALLOCATE_INTEGER_ARRAY(ACCSIZ, CURRENT_MAX_DFAS); 
    REALLOCATE_INTEGER_ARRAY(DHASH, CURRENT_MAX_DFAS); 
    REALLOCATE_INT_PTR_ARRAY(DSS, CURRENT_MAX_DFAS); 
    REALLOCATE_DFAACC_UNION(DFAACC, CURRENT_MAX_DFAS); 
  end INCREASE_MAX_DFAS; 


  -- ntod - convert an ndfa to a dfa
  --
  --  creates the dfa corresponding to the ndfa we've constructed.  the
  --  dfa starts out in state #1.

  procedure NTOD is 

    ACCSET                                             : INT_PTR; 
    DS, NACC, NEWDS                                    : INTEGER; 
    DUPLIST, TARGFREQ, TARGSTATE, STATE                : C_SIZE_ARRAY; 
    SYMLIST                                            : C_SIZE_BOOL_ARRAY; 
    HASHVAL, NUMSTATES, DSIZE                          : INTEGER; 
    NSET, DSET                                         : INT_PTR; 
    TARGPTR, TOTALTRANS, I, J, COMSTATE, COMFREQ, TARG : INTEGER; 
    NUM_START_STATES, TODO_HEAD, TODO_NEXT             : INTEGER; 
    SNSRESULT                                          : BOOLEAN; 
    FULL_TABLE_TEMP_FILE                               : FILE_TYPE; 
    BUF                                                : VSTRING; 
    NUM_NXT_STATES                                     : INTEGER; 
    use TEXT_IO; 

    -- this is so find_table_space(...) will know where to start looking in
    -- chk/nxt for unused records for space to put in the state
  begin
    ACCSET := ALLOCATE_INTEGER_ARRAY(NUM_RULES + 1); 
    NSET := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_DFA_SIZE); 

    -- the "todo" queue is represented by the head, which is the DFA
    -- state currently being processed, and the "next", which is the
    -- next DFA state number available (not in use).  We depend on the
    -- fact that snstods() returns DFA's \in increasing order/, and thus
    -- need only know the bounds of the dfas to be processed.
    TODO_HEAD := 0; 
    TODO_NEXT := 0; 

    for CNT in 0 .. CSIZE loop
      DUPLIST(CNT) := NIL; 
      SYMLIST(CNT) := FALSE; 
    end loop; 

    for CNT in 0 .. NUM_RULES loop
      ACCSET(CNT) := NIL; 
    end loop; 

    if (TRACE) then 
      NFA.DUMPNFA(SCSET(1)); 
      TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      TEXT_IO.PUT(STANDARD_ERROR, "DFA Dump:"); 
      TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      TEXT_IO.NEW_LINE(STANDARD_ERROR); 
    end if; 

    TBLCMP.INITTBL; 

    if (FULLTBL) then 
      GEN.DO_SECT3_OUT; 

      -- output user code up to ##
      SKELETON_MANAGER.SKELOUT; 

      -- declare it "short" because it's a real long-shot that that
      -- won't be large enough
      begin -- make a temporary file to write yy_nxt array into
        CREATE(FULL_TABLE_TEMP_FILE, OUT_FILE); 
      exception
        when USE_ERROR | NAME_ERROR => 
          MISC.AFLEXFATAL("can't create temporary file"); 
      end; 

      NUM_NXT_STATES := 1; 
      TEXT_IO.PUT(FULL_TABLE_TEMP_FILE, "( "); 
      -- generate 0 entries for state #0
      for CNT in 0 .. NUMECS loop
        MISC.MK2DATA(FULL_TABLE_TEMP_FILE, 0); 
      end loop; 

      TEXT_IO.PUT(FULL_TABLE_TEMP_FILE, " )"); 
      -- force extra blank line next dataflush()
      DATALINE := NUMDATALINES; 
    end if; 

    -- create the first states

    NUM_START_STATES := LASTSC*2; 

    for CNT in 1 .. NUM_START_STATES loop
      NUMSTATES := 1; 

      -- for each start condition, make one state for the case when
      -- we're at the beginning of the line (the '%' operator) and
      -- one for the case when we're not

      if (CNT mod 2 = 1) then 
        NSET(NUMSTATES) := SCSET((CNT/2) + 1); 
      else 
        NSET(NUMSTATES) := NFA.MKBRANCH(SCBOL(CNT/2), SCSET(CNT/2)); 
      end if; 

      DFA.EPSCLOSURE(NSET, NUMSTATES, ACCSET, NACC, HASHVAL); 

      SNSTODS(NSET, NUMSTATES, ACCSET, NACC, HASHVAL, DS, SNSRESULT); 
      if (SNSRESULT) then 
        NUMAS := NUMAS + NACC; 
        TOTNST := TOTNST + NUMSTATES; 
        TODO_NEXT := TODO_NEXT + 1; 

        if (VARIABLE_TRAILING_CONTEXT_RULES and (NACC > 0)) then 
          CHECK_TRAILING_CONTEXT(NSET, NUMSTATES, ACCSET, NACC); 
        end if; 
      end if; 
    end loop; 

    SNSTODS(NSET, 0, ACCSET, 0, 0, END_OF_BUFFER_STATE, SNSRESULT); 
    if (not SNSRESULT) then 
      MISC.AFLEXFATAL("could not create unique end-of-buffer state"); 
    end if; 
    NUMAS := NUMAS + 1; 
    NUM_START_STATES := NUM_START_STATES + 1; 
    TODO_NEXT := TODO_NEXT + 1; 

    while (TODO_HEAD < TODO_NEXT) loop
      NUM_NXT_STATES := NUM_NXT_STATES + 1; 
      TARGPTR := 0; 
      TOTALTRANS := 0; 

      for STATE_CNT in 1 .. NUMECS loop
        STATE(STATE_CNT) := 0; 
      end loop; 

      TODO_HEAD := TODO_HEAD + 1; 
      DS := TODO_HEAD; 

      DSET := DSS(DS); 
      DSIZE := DFASIZ(DS); 

      if (TRACE) then 
        TEXT_IO.PUT(STANDARD_ERROR, "state # "); 
        INT_IO.PUT(STANDARD_ERROR, DS, 1); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, ":"); 
      end if; 

      SYMPARTITION(DSET, DSIZE, SYMLIST, DUPLIST); 

      for SYM in 1 .. NUMECS loop
        if (SYMLIST(SYM)) then 
          SYMLIST(SYM) := FALSE; 

          if (DUPLIST(SYM) = NIL) then 
          -- symbol has unique out-transitions
            NUMSTATES := SYMFOLLOWSET(DSET, DSIZE, SYM, NSET); 
            DFA.EPSCLOSURE(NSET, NUMSTATES, ACCSET, NACC, HASHVAL); 

            SNSTODS(NSET, NUMSTATES, ACCSET, NACC, HASHVAL, NEWDS, SNSRESULT); 
            if (SNSRESULT) then 
              TOTNST := TOTNST + NUMSTATES; 
              TODO_NEXT := TODO_NEXT + 1; 
              NUMAS := NUMAS + NACC; 

              if (VARIABLE_TRAILING_CONTEXT_RULES and (NACC > 0)) then 
                CHECK_TRAILING_CONTEXT(NSET, NUMSTATES, ACCSET, NACC); 
              end if; 
            end if; 

            STATE(SYM) := NEWDS; 

            if (TRACE) then 
              TEXT_IO.PUT(STANDARD_ERROR, ASCII.HT); 
              INT_IO.PUT(STANDARD_ERROR, SYM, 1); 
              TEXT_IO.PUT(STANDARD_ERROR, ASCII.HT); 
              INT_IO.PUT(STANDARD_ERROR, NEWDS, 1); 
              TEXT_IO.NEW_LINE(STANDARD_ERROR); 
            end if; 

            TARGPTR := TARGPTR + 1; 
            TARGFREQ(TARGPTR) := 1; 
            TARGSTATE(TARGPTR) := NEWDS; 
            NUMUNIQ := NUMUNIQ + 1; 
          else 
          -- sym's equivalence class has the same transitions
          -- as duplist(sym)'s equivalence class

            TARG := STATE(DUPLIST(SYM)); 
            STATE(SYM) := TARG; 
            if (TRACE) then 
              TEXT_IO.PUT(STANDARD_ERROR, ASCII.HT); 
              INT_IO.PUT(STANDARD_ERROR, SYM, 1); 
              TEXT_IO.PUT(STANDARD_ERROR, ASCII.HT); 
              INT_IO.PUT(STANDARD_ERROR, TARG, 1); 
              TEXT_IO.NEW_LINE(STANDARD_ERROR); 
            end if; 

            -- update frequency count for destination state

            I := 1; 

            while (TARGSTATE(I) /= TARG) loop
              I := I + 1; 
            end loop; 

            TARGFREQ(I) := TARGFREQ(I) + 1; 
            NUMDUP := NUMDUP + 1; 
          end if; 

          TOTALTRANS := TOTALTRANS + 1; 
          DUPLIST(SYM) := NIL; 
        end if; 
      end loop; 

      NUMSNPAIRS := NUMSNPAIRS + TOTALTRANS; 

      if (CASEINS and not USEECS) then 
        I := CHARACTER'POS('A'); 
        J := CHARACTER'POS('a'); 
        while (I < CHARACTER'POS('Z')) loop
          STATE(I) := STATE(J); 
          I := I + 1; 
          J := J + 1; 
        end loop; 
      end if; 

      if (DS > NUM_START_STATES) then 
        CHECK_FOR_BACKTRACKING(DS, STATE); 
      end if; 

      if (FULLTBL) then 
      -- supply array's 0-element
        TEXT_IO.PUT(FULL_TABLE_TEMP_FILE, ","); 
        MISC.DATAFLUSH(FULL_TABLE_TEMP_FILE); 
        TEXT_IO.PUT(FULL_TABLE_TEMP_FILE, "( "); 
        if (DS = END_OF_BUFFER_STATE) then 
          MISC.MK2DATA(FULL_TABLE_TEMP_FILE,  -END_OF_BUFFER_STATE); 
        else 
          MISC.MK2DATA(FULL_TABLE_TEMP_FILE, END_OF_BUFFER_STATE); 
        end if; 

        for CNT in 1 .. NUMECS loop
        -- jams are marked by negative of state number
          if ((STATE(CNT) /= 0)) then 
            MISC.MK2DATA(FULL_TABLE_TEMP_FILE, STATE(CNT)); 
          else 
            MISC.MK2DATA(FULL_TABLE_TEMP_FILE,  -DS); 
          end if; 
        end loop; 

        TEXT_IO.PUT(FULL_TABLE_TEMP_FILE, " )"); 
        -- force extra blank line next dataflush()
        DATALINE := NUMDATALINES; 
      else 
        if (DS = END_OF_BUFFER_STATE) then 
        -- special case this state to make sure it does what it's
        -- supposed to, i.e., jam on end-of-buffer
          TBLCMP.STACK1(DS, 0, 0, JAMSTATE_CONST); 
        else  -- normal, compressed state
        -- determine which destination state is the most common, and
        -- how many transitions to it there are
          COMFREQ := 0; 
          COMSTATE := 0; 

          for CNT in 1 .. TARGPTR loop
            if (TARGFREQ(CNT) > COMFREQ) then 
              COMFREQ := TARGFREQ(CNT); 
              COMSTATE := TARGSTATE(CNT); 
            end if; 
          end loop; 

          TBLCMP.BLDTBL(STATE, DS, TOTALTRANS, COMSTATE, COMFREQ); 
        end if; 
      end if; 
    end loop; 

    if (FULLTBL) then 
      TEXT_IO.PUT("yy_nxt : constant array(0.."); 
      INT_IO.PUT(NUM_NXT_STATES - 1, 1); 
      TEXT_IO.PUT_LINE(" , ASCII.NUL..Character'Last) of short :="); 
      TEXT_IO.PUT_LINE("   ("); 

      RESET(FULL_TABLE_TEMP_FILE, IN_FILE); 
      while (not END_OF_FILE(FULL_TABLE_TEMP_FILE)) loop
        TSTRING.GET_LINE(FULL_TABLE_TEMP_FILE, BUF); 
        TSTRING.PUT_LINE(BUF); 
      end loop; 
      DELETE(FULL_TABLE_TEMP_FILE); 

      MISC.DATAEND; 
    else 
      TBLCMP.CMPTMPS;  -- create compressed template entries

      -- create tables for all the states with only one out-transition
      while (ONESP > 0) loop
        TBLCMP.MK1TBL(ONESTATE(ONESP), ONESYM(ONESP), ONENEXT(ONESP), ONEDEF(
          ONESP)); 
        ONESP := ONESP - 1; 
      end loop; 

      TBLCMP.MKDEFTBL; 
    end if; 
  end NTOD; 

  -- snstods - converts a set of ndfa states into a dfa state
  --
  -- on return, the dfa state number is in newds.
  procedure SNSTODS(SNS           : in INT_PTR; 
                    NUMSTATES     : in INTEGER; 
                    ACCSET        : in INT_PTR; 
                    NACC, HASHVAL : in INTEGER; 
                    NEWDS_ADDR    : out INTEGER; 
                    RESULT        : out BOOLEAN) is 
    DIDSORT : BOOLEAN := FALSE; 
    J       : INTEGER; 
    NEWDS   : INTEGER; 
    OLDSNS  : INT_PTR; 
  begin
    for I in 1 .. LASTDFA loop
      if (HASHVAL = DHASH(I)) then 
        if (NUMSTATES = DFASIZ(I)) then 
          OLDSNS := DSS(I); 

          if (not DIDSORT) then 
          -- we sort the states in sns so we can compare it to
          -- oldsns quickly.  we use bubble because there probably
          -- aren't very many states

            MISC.BUBBLE(SNS, NUMSTATES); 
            DIDSORT := TRUE; 
          end if; 

          J := 1; 
          while (J <= NUMSTATES) loop
            if (SNS(J) /= OLDSNS(J)) then 
              exit; 
            end if; 
            J := J + 1; 
          end loop; 

          if (J > NUMSTATES) then 
            DFAEQL := DFAEQL + 1; 
            NEWDS_ADDR := I; 
            RESULT := FALSE; 
            return; 
          end if; 

          HSHCOL := HSHCOL + 1; 
        else 
          HSHSAVE := HSHSAVE + 1; 
        end if; 
      end if; 
    end loop; 
    -- make a new dfa

    LASTDFA := LASTDFA + 1; 
    if (LASTDFA >= CURRENT_MAX_DFAS) then 
      INCREASE_MAX_DFAS; 
    end if; 

    NEWDS := LASTDFA; 

    DSS(NEWDS) := new UNBOUNDED_INT_ARRAY(0 .. NUMSTATES + 1); 

    -- if we haven't already sorted the states in sns, we do so now, so that
    -- future comparisons with it can be made quickly

    if (not DIDSORT) then 
      MISC.BUBBLE(SNS, NUMSTATES); 
    end if; 

    for I in 1 .. NUMSTATES loop
      DSS(NEWDS)(I) := SNS(I); 
    end loop; 

    DFASIZ(NEWDS) := NUMSTATES; 
    DHASH(NEWDS) := HASHVAL; 

    if (NACC = 0) then 
      DFAACC(NEWDS).DFAACC_STATE := 0; 
      ACCSIZ(NEWDS) := 0; 
    else 
    -- find lowest numbered rule so the disambiguating rule will work
      J := NUM_RULES + 1; 

      for I in 1 .. NACC loop
        if (ACCSET(I) < J) then 
          J := ACCSET(I); 
        end if; 
      end loop; 

      DFAACC(NEWDS).DFAACC_STATE := J; 
    end if; 

    NEWDS_ADDR := NEWDS; 
    RESULT := TRUE; 
    return; 

  exception
    when STORAGE_ERROR => 
      MISC.AFLEXFATAL("dynamic memory failure in snstods()"); 
  end SNSTODS; 

  -- symfollowset - follow the symbol transitions one step
  function SYMFOLLOWSET(DS              : in INT_PTR; 
                        DSIZE, TRANSSYM : in INTEGER; 
                        NSET            : in INT_PTR) return INTEGER is 
    NS, TSP, SYM, LENCCL, CH, NUMSTATES, CCLLIST : INTEGER; 
  begin
    NUMSTATES := 0; 

    for I in 1 .. DSIZE loop
    -- for each nfa state ns in the state set of ds
      NS := DS(I); 
      SYM := TRANSCHAR(NS); 
      TSP := TRANS1(NS); 

      if (SYM < 0) then 
      -- it's a character class
        SYM :=  -SYM; 
        CCLLIST := CCLMAP(SYM); 
        LENCCL := CCLLEN(SYM); 

        if (CCLNG(SYM) /= 0) then 
          for J in 0 .. LENCCL - 1 loop
          -- loop through negated character class
            CH := CHARACTER'POS(CCLTBL(CCLLIST + J)); 

            if (CH > TRANSSYM) then 
              exit;  -- transsym isn't in negated ccl
            else 
              if (CH = TRANSSYM) then 
                goto BOTTOM;  -- next 2
              end if; 
            end if; 
          end loop; 

          -- didn't find transsym in ccl
          NUMSTATES := NUMSTATES + 1; 
          NSET(NUMSTATES) := TSP; 
        else 
          for J in 0 .. LENCCL - 1 loop
            CH := CHARACTER'POS(CCLTBL(CCLLIST + J)); 

            if (CH > TRANSSYM) then 
              exit; 
            else 
              if (CH = TRANSSYM) then 
                NUMSTATES := NUMSTATES + 1; 
                NSET(NUMSTATES) := TSP; 
                exit; 
              end if; 
            end if; 
          end loop; 
        end if; 
      else 
        if ((SYM >= CHARACTER'POS('A')) and (SYM <= CHARACTER'POS('Z')) and 
          CASEINS) then 
          MISC.AFLEXFATAL("consistency check failed in symfollowset"); 
        else 
          if (SYM = SYM_EPSILON) then 
            null;  -- do nothing
          else 
            if (ECGROUP(SYM) = TRANSSYM) then 
              NUMSTATES := NUMSTATES + 1; 
              NSET(NUMSTATES) := TSP; 
            end if; 
          end if; 
        end if; 
      end if; 

      <<BOTTOM>> null; 
    end loop; 
    return NUMSTATES; 
  end SYMFOLLOWSET; 

  -- sympartition - partition characters with same out-transitions
  procedure SYMPARTITION(DS        : in INT_PTR; 
                         NUMSTATES : in INTEGER; 
                         SYMLIST   : in out C_SIZE_BOOL_ARRAY; 
                         DUPLIST   : in out C_SIZE_ARRAY) is 
    TCH, J, NS, LENCCL, CCLP, ICH : INTEGER; 
    DUPFWD                        : C_SIZE_ARRAY; 

  -- partitioning is done by creating equivalence classes for those
  -- characters which have out-transitions from the given state.  Thus
  -- we are really creating equivalence classes of equivalence classes.
  begin
    for I in 1 .. NUMECS loop
    -- initialize equivalence class list
      DUPLIST(I) := I - 1; 
      DUPFWD(I) := I + 1; 
    end loop; 

    DUPLIST(1) := NIL; 
    DUPFWD(NUMECS) := NIL; 
    DUPFWD(0) := 0; 

    for I in 1 .. NUMSTATES loop
      NS := DS(I); 
      TCH := TRANSCHAR(NS); 

      if (TCH /= SYM_EPSILON) then 
        if ((TCH <  -LASTCCL) or (TCH > CSIZE)) then 
          MISC.AFLEXFATAL("bad transition character detected in sympartition()")
            ; 
        end if; 

        if (TCH > 0) then 
        -- character transition
          ECS.MKECHAR(ECGROUP(TCH), DUPFWD, DUPLIST); 
          SYMLIST(ECGROUP(TCH)) := TRUE; 
        else 
        -- character class
          TCH :=  -TCH; 

          LENCCL := CCLLEN(TCH); 
          CCLP := CCLMAP(TCH); 
          ECS.MKECCL(CCLTBL(CCLP .. CCLP + LENCCL), LENCCL, DUPFWD, DUPLIST, 
            NUMECS); 

          if (CCLNG(TCH) /= 0) then 
            J := 0; 

            for K in 0 .. LENCCL - 1 loop
              ICH := CHARACTER'POS(CCLTBL(CCLP + K)); 

              J := J + 1; 
              while (J < ICH) loop
                SYMLIST(J) := TRUE; 
                J := J + 1; 
              end loop; 
            end loop; 

            J := J + 1; 
            while (J <= NUMECS) loop
              SYMLIST(J) := TRUE; 
              J := J + 1; 
            end loop; 
          else 
            for K in 0 .. LENCCL - 1 loop
              ICH := CHARACTER'POS(CCLTBL(CCLP + K)); 
              SYMLIST(ICH) := TRUE; 
            end loop; 
          end if; 
        end if; 
      end if; 
    end loop; 
  end SYMPARTITION; 
end DFA; 

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE DFA construction routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION converts non-deterministic finite automatons to finite ones.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/dfa.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS; 
with TEXT_IO; 
package DFA is 
  use MISC_DEFS, TEXT_IO; 
  procedure CHECK_FOR_BACKTRACKING(DS    : in INTEGER; 
                                   STATE : in UNBOUNDED_INT_ARRAY); 
  procedure CHECK_TRAILING_CONTEXT(NFA_STATES : in INT_PTR; 
                                   NUM_STATES : in INTEGER; 
                                   ACCSET     : in INT_PTR; 
                                   NACC       : in INTEGER); 

  procedure DUMP_ASSOCIATED_RULES(F  : in FILE_TYPE; 
                                  DS : in INTEGER); 

  procedure DUMP_TRANSITIONS(F     : in FILE_TYPE; 
                             STATE : in UNBOUNDED_INT_ARRAY); 

  procedure EPSCLOSURE(T                  : in out INT_PTR; 
                       NS_ADDR            : in out INTEGER; 
                       ACCSET             : in out INT_PTR; 
                       NACC_ADDR, HV_ADDR : out INTEGER);

  procedure INCREASE_MAX_DFAS; 

  procedure NTOD; 

  procedure SNSTODS(SNS           : in INT_PTR; 
                    NUMSTATES     : in INTEGER; 
                    ACCSET        : in INT_PTR; 
                    NACC, HASHVAL : in INTEGER; 
                    NEWDS_ADDR    : out INTEGER; 
                    RESULT        : out BOOLEAN); 

  function SYMFOLLOWSET(DS              : in INT_PTR; 
                        DSIZE, TRANSSYM : in INTEGER; 
                        NSET            : in INT_PTR) return INTEGER; 

  procedure SYMPARTITION(DS        : in INT_PTR; 
                         NUMSTATES : in INTEGER; 
                         SYMLIST   : in out C_SIZE_BOOL_ARRAY; 
                         DUPLIST   : in out C_SIZE_ARRAY); 
end DFA; 

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE equivalence class
-- AUTHOR: John Self (UCI)
-- DESCRIPTION finds equivalence classes so DFA will be smaller
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/ecs.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS; 
with Aflex_MISC; use MISC_DEFS; 
package body ECS is 

-- ccl2ecl - convert character classes to set of equivalence classes

  procedure CCL2ECL is 
    use MISC_DEFS; 
    ICH, NEWLEN, CCLP, CCLMEC : INTEGER; 
  begin
    for I in 1 .. LASTCCL loop

      -- we loop through each character class, and for each character
      -- in the class, add the character's equivalence class to the
      -- new "character" class we are creating.  Thus when we are all
      -- done, character classes will really consist of collections
      -- of equivalence classes
      NEWLEN := 0; 
      CCLP := CCLMAP(I); 

      for CCLS in 0 .. CCLLEN(I) - 1 loop
        ICH := CHARACTER'POS(CCLTBL(CCLP + CCLS)); 
        CCLMEC := ECGROUP(ICH); 
        if (CCLMEC > 0) then 
          CCLTBL(CCLP + NEWLEN) := CHARACTER'VAL(CCLMEC); 
          NEWLEN := NEWLEN + 1; 
        end if; 
      end loop; 

      CCLLEN(I) := NEWLEN; 
    end loop; 
  end CCL2ECL; 


  -- cre8ecs - associate equivalence class numbers with class members
  --  fwd is the forward linked-list of equivalence class members.  bck
  --  is the backward linked-list, and num is the number of class members.
  --  Returned is the number of classes.

  procedure CRE8ECS(FWD, BCK : in out C_SIZE_ARRAY; 
                    NUM      : in INTEGER; 
                    RESULT   : out INTEGER) is 
    J, NUMCL : INTEGER; 
  begin
    NUMCL := 0; 

    -- create equivalence class numbers.  From now on, abs( bck(x) )
    -- is the equivalence class number for object x.  If bck(x)
    -- is positive, then x is the representative of its equivalence
    -- class.
    for I in 1 .. NUM loop
      if (BCK(I) = NIL) then 
        NUMCL := NUMCL + 1; 
        BCK(I) := NUMCL; 
        J := FWD(I); 
        while (J /= NIL) loop
          BCK(J) :=  -NUMCL; 
          J := FWD(J); 
        end loop; 
      end if; 
    end loop; 
    RESULT := NUMCL; 
    return; 
  end CRE8ECS; 


  -- mkeccl - update equivalence classes based on character class xtions
  -- where ccls contains the elements of the character class, lenccl is the
  -- number of elements in the ccl, fwd is the forward link-list of equivalent
  -- characters, bck is the backward link-list, and llsiz size of the link-list

  procedure MKECCL(CCLS     : in out CHAR_ARRAY; 
                   LENCCL   : in INTEGER; 
                   FWD, BCK : in out UNBOUNDED_INT_ARRAY; 
                   LLSIZ    : in INTEGER) is 
    use MISC_DEFS, Aflex_MISC; 
    CCLP, OLDEC, NEWEC, CCLM, I, J : INTEGER; 
    PROC_ARRAY                     : BOOLEAN_PTR; 
  begin

    -- note that it doesn't matter whether or not the character class is
    -- negated.  The same results will be obtained in either case.
    CCLP := CCLS'FIRST; 

    -- this array tells whether or not a character class has been processed.
    PROC_ARRAY := new BOOLEAN_ARRAY(CCLS'FIRST .. CCLS'LAST); 
    for CCL_INDEX in CCLS'FIRST .. CCLS'LAST loop
      PROC_ARRAY(CCL_INDEX) := FALSE; 
    end loop; 

    while (CCLP < LENCCL + CCLS'FIRST) loop
      CCLM := CHARACTER'POS(CCLS(CCLP)); 
      OLDEC := BCK(CCLM); 
      NEWEC := CCLM; 

      J := CCLP + 1; 

      I := FWD(CCLM); 
      while ((I /= NIL) and (I <= LLSIZ)) loop

        -- look for the symbol in the character class
        while ((J < LENCCL + CCLS'FIRST) and ((CCLS(J) <= CHARACTER'VAL(I)) or 
          PROC_ARRAY(J))) loop
          if (CCLS(J) = CHARACTER'VAL(I)) then 

            -- we found an old companion of cclm in the ccl.
            -- link it into the new equivalence class and flag it as
            -- having been processed
            BCK(I) := NEWEC; 
            FWD(NEWEC) := I; 
            NEWEC := I; 
            PROC_ARRAY(J) := TRUE; 

            -- set flag so we don't reprocess

            -- get next equivalence class member
            -- continue 2
            goto NEXT_PT; 
          end if; 
          J := J + 1; 
        end loop; 

        -- symbol isn't in character class.  Put it in the old equivalence
        -- class
        BCK(I) := OLDEC; 

        if (OLDEC /= NIL) then 
          FWD(OLDEC) := I; 
        end if; 

        OLDEC := I; 
        <<NEXT_PT>> I := FWD(I); 
      end loop; 

      if ((BCK(CCLM) /= NIL) or (OLDEC /= BCK(CCLM))) then 
        BCK(CCLM) := NIL; 
        FWD(OLDEC) := NIL; 
      end if; 

      FWD(NEWEC) := NIL; 

      -- find next ccl member to process
      CCLP := CCLP + 1; 

      while ((CCLP < LENCCL + CCLS'FIRST) and PROC_ARRAY(CCLP)) loop

        -- reset "doesn't need processing" flag
        PROC_ARRAY(CCLP) := FALSE; 
        CCLP := CCLP + 1; 
      end loop; 
    end loop; 
  exception
    when STORAGE_ERROR => 
      Aflex_MISC.AFLEXFATAL("dynamic memory failure in mkeccl()"); 
  end MKECCL; 


  -- mkechar - create equivalence class for single character

  procedure MKECHAR(TCH      : in INTEGER; 
                    FWD, BCK : in out C_SIZE_ARRAY) is 
  begin

    -- if until now the character has been a proper subset of
    -- an equivalence class, break it away to create a new ec
    if (FWD(TCH) /= NIL) then 
      BCK(FWD(TCH)) := BCK(TCH); 
    end if; 

    if (BCK(TCH) /= NIL) then 
      FWD(BCK(TCH)) := FWD(TCH); 
    end if; 

    FWD(TCH) := NIL; 
    BCK(TCH) := NIL; 
  end MKECHAR; 

end ECS; 

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE equivalence class
-- AUTHOR: John Self (UCI)
-- DESCRIPTION finds equivalence classes so DFA will be smaller
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/ecs.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS; use MISC_DEFS; 
package ECS is 
  procedure CCL2ECL; 
  procedure CRE8ECS(FWD, BCK : in out C_SIZE_ARRAY; 
                    NUM      : in INTEGER; 
                    RESULT   : out INTEGER); 
  procedure MKECCL(CCLS     : in out CHAR_ARRAY; 
                   LENCCL   : in INTEGER; 
                   FWD, BCK : in out UNBOUNDED_INT_ARRAY; 
                   LLSIZ    : in INTEGER); 
  procedure MKECHAR(TCH      : in INTEGER; 
                    FWD, BCK : in out C_SIZE_ARRAY); 
end ECS; 

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE external_file_manager
-- AUTHOR: John Self (UCI)
-- DESCRIPTION opens external files for other functions
-- NOTES This package opens external files, and thus may be system dependent
--       because of limitations on file names.
--       This version is for the VADS 5.5 Ada development system.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/file_manager.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS, TSTRING, TEXT_IO, Aflex_MISC; use MISC_DEFS, TSTRING, TEXT_IO; 

package body EXTERNAL_FILE_MANAGER is 
  package MISC renames Aflex_MISC;

-- FIX comment about compiler dependent

  subtype SUFFIX_TYPE is STRING(1 .. 3); 

  function ADA_SUFFIX return SUFFIX_TYPE is 
  begin
    return "ada"; 
  end ADA_SUFFIX; 

  procedure GET_IO_FILE(F : in out FILE_TYPE) is 
  begin
    if (LEN(INFILENAME) /= 0) then 
      CREATE(F, OUT_FILE, STR(MISC.BASENAME) & "_io." & ADA_SUFFIX); 
    else 
      CREATE(F, OUT_FILE, "aflex_yy_io." & ADA_SUFFIX); 
    end if; 
  exception
    when USE_ERROR | NAME_ERROR => 
      MISC.AFLEXFATAL("could not create IO package file"); 
  end GET_IO_FILE; 

  procedure GET_DFA_FILE(F : in out FILE_TYPE) is 
  begin
    if (LEN(INFILENAME) /= 0) then 
      CREATE(F, OUT_FILE, STR(MISC.BASENAME) & "_dfa." & ADA_SUFFIX); 
    else 
      CREATE(F, OUT_FILE, "aflex_yy_dfa." & ADA_SUFFIX); 
    end if; 
  exception
    when USE_ERROR | NAME_ERROR => 
      MISC.AFLEXFATAL("could not create DFA package file"); 
  end GET_DFA_FILE; 

  procedure GET_SCANNER_FILE(F : in out FILE_TYPE) is 
    OUTFILE_NAME : VSTRING; 
  begin
    if (LEN(INFILENAME) /= 0) then 

      -- give out infile + ada_suffix
      OUTFILE_NAME := MISC.BASENAME & "." & ADA_SUFFIX; 
    else 
      OUTFILE_NAME := VSTR("aflex_yy." & ADA_SUFFIX); 
    end if; 

    CREATE(F, OUT_FILE, STR(OUTFILE_NAME)); 
    SET_OUTPUT(F); 
  exception
    when NAME_ERROR | USE_ERROR => 
      MISC.AFLEXFATAL("can't create scanner file " & OUTFILE_NAME); 
  end GET_SCANNER_FILE; 

  procedure GET_BACKTRACK_FILE(F : in out FILE_TYPE) is 
  begin
    CREATE(F, OUT_FILE, "aflex.backtrack"); 
  exception
    when USE_ERROR | NAME_ERROR => 
      MISC.AFLEXFATAL("could not create backtrack file"); 
  end GET_BACKTRACK_FILE; 

  procedure INITIALIZE_FILES is 
  begin
    null; 

  -- doesn't need to do anything on Verdix
  end INITIALIZE_FILES; 

end EXTERNAL_FILE_MANAGER; 

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE external_file_manager
-- AUTHOR: John Self (UCI)
-- DESCRIPTION opens external files for other functions
-- NOTES This package opens external files, and thus may be system dependent
--       because of limitations on file names.
--       This version is for the VADS 5.5 Ada development system.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/file_manager.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with TEXT_IO; use TEXT_IO; 
package EXTERNAL_FILE_MANAGER is 
  procedure GET_IO_FILE(F : in out FILE_TYPE); 
  procedure GET_DFA_FILE(F : in out FILE_TYPE); 
  procedure GET_SCANNER_FILE(F : in out FILE_TYPE); 
  procedure GET_BACKTRACK_FILE(F : in out FILE_TYPE); 
  procedure INITIALIZE_FILES; 
end EXTERNAL_FILE_MANAGER; 

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE file strings
-- AUTHOR: John Self (UCI)
-- DESCRIPTION used to store lines in the template files
-- NOTES if lines in a template exceed 128 characters we are in trouble
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/file_strings.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with VSTRINGS; 
package FILE_STRING is 
  new VSTRINGS(128); 

pragma Warnings(Off);
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE scanner generation
-- AUTHOR: John Self (UCI)
-- DESCRIPTION
-- NOTES does actual generation (writing) of output aflex scanners
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/gen.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS, TEXT_IO, Aflex_MISC, INT_IO, TSTRING, PARSE_TOKENS; 
with SCANNER, SKELETON_MANAGER, EXTERNAL_FILE_MANAGER; use MISC_DEFS, TEXT_IO, 
  TSTRING, PARSE_TOKENS, EXTERNAL_FILE_MANAGER; 

package body GEN is 
  package MISC renames Aflex_MISC;
  INDENT_LEVEL : INTEGER := 0;  -- each level is 4 spaces

  MAX_SHORT    : constant INTEGER := 32767; 
  procedure INDENT_UP is 
  begin
    INDENT_LEVEL := INDENT_LEVEL + 1; 
  end INDENT_UP; 
  procedure INDENT_DOWN is 
  begin
    INDENT_LEVEL := INDENT_LEVEL - 1; 
  end INDENT_DOWN; 

  procedure SET_INDENT(INDENT_VAL : in INTEGER) is 
  begin
    INDENT_LEVEL := INDENT_VAL; 
  end SET_INDENT; 


  -- indent to the current level

  procedure DO_INDENT is 
    I : INTEGER := INDENT_LEVEL*4; 
  begin
    while (I >= 8) loop
      TEXT_IO.PUT(ASCII.HT); 
      I := I - 8; 
    end loop; 

    while (I > 0) loop
      TEXT_IO.PUT(' '); 
      I := I - 1; 
    end loop; 
  end DO_INDENT; 

  -- generate the code to keep backtracking information

  procedure GEN_BACKTRACKING is 
  begin
    if (NUM_BACKTRACKING = 0) then 
      return; 
    end if; 

    INDENT_PUTS("if ( yy_accept(yy_current_state) /= 0 ) then"); 

    INDENT_UP; 
    INDENT_PUTS("yy_last_accepting_state := yy_current_state;"); 
    INDENT_PUTS("yy_last_accepting_cpos := yy_cp;"); 
    INDENT_DOWN; 
    INDENT_PUTS("end if;"); 
  end GEN_BACKTRACKING; 

  -- generate the code to perform the backtrack

  procedure GEN_BT_ACTION is 
  begin
    if (NUM_BACKTRACKING = 0) then 
      return; 
    end if; 

    SET_INDENT(4); 

    INDENT_PUTS("when 0 => -- must backtrack"); 
    INDENT_PUTS("-- undo the effects of YY_DO_BEFORE_ACTION"); 
    INDENT_PUTS("yy_ch_buf(yy_cp) := yy_hold_char;"); 

    if (FULLTBL) then 
      INDENT_PUTS("yy_cp := yy_last_accepting_cpos + 1;"); 
    else 

      -- backtracking info for compressed tables is taken \after/
      -- yy_cp has been incremented for the next state
      INDENT_PUTS("yy_cp := yy_last_accepting_cpos;"); 
    end if; 

    INDENT_PUTS("yy_current_state := yy_last_accepting_state;"); 
    INDENT_PUTS("goto next_action;"); 
    TEXT_IO.NEW_LINE; 

    SET_INDENT(0); 
  end GEN_BT_ACTION; 

  -- generate equivalence-class table

  procedure GENECS is 
    I       : INTEGER; 
    NUMROWS : INTEGER; 
    use TEXT_IO; 
  begin
    TEXT_IO.PUT("yy_ec : constant array(ASCII.NUL.."); 
    TEXT_IO.PUT_LINE("Character'Last) of short :="); 
    TEXT_IO.PUT_LINE("    (   0,"); 

    for CHAR_COUNT in 1 .. CSIZE loop
      if (CASEINS and ((CHAR_COUNT >= CHARACTER'POS('A')) and (CHAR_COUNT <= 
        CHARACTER'POS('Z')))) then 
        ECGROUP(CHAR_COUNT) := ECGROUP(MISC.CLOWER(CHAR_COUNT)); 
      end if; 

      ECGROUP(CHAR_COUNT) := abs(ECGROUP(CHAR_COUNT)); 
      MISC.MKDATA(ECGROUP(CHAR_COUNT)); 
    end loop; 

    MISC.DATAEND; 

    if (TRACE) then 
      TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      TEXT_IO.PUT(STANDARD_ERROR, "Equivalence Classes:"); 
      TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      NUMROWS := (CSIZE + 1)/8; 

      for J in 1 .. NUMROWS loop
        I := J; 
        while (I <= CSIZE) loop
          TSTRING.PUT(STANDARD_ERROR, MISC.READABLE_FORM(CHARACTER'VAL(I))); 
          TEXT_IO.PUT(STANDARD_ERROR, " = "); 
          INT_IO.PUT(STANDARD_ERROR, ECGROUP(I), 1); 
          TEXT_IO.PUT(STANDARD_ERROR, "   "); 
          I := I + NUMROWS; 
        end loop; 
        TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      end loop; 
    end if; 
  end GENECS; 

  -- generate the code to find the action number

  procedure GEN_FIND_ACTION is 
  begin
    INDENT_PUTS("yy_act := yy_accept(yy_current_state);"); 
  end GEN_FIND_ACTION; 

  -- genftbl - generates full transition table

  procedure GENFTBL is 
    END_OF_BUFFER_ACTION : INTEGER := NUM_RULES + 1; 
    -- *everything* is done in terms of arrays starting at 1, so provide
    -- a null entry for the zero element of all C arrays
    use TEXT_IO; 
  begin
    TEXT_IO.PUT("yy_accept : constant array(0.."); 
    INT_IO.PUT(LASTDFA, 1); 
    TEXT_IO.PUT_LINE(") of short :="); 
    TEXT_IO.PUT_LINE("    (   0,"); 

    DFAACC(END_OF_BUFFER_STATE).DFAACC_STATE := END_OF_BUFFER_ACTION; 

    for I in 1 .. LASTDFA loop
      declare
        ANUM : INTEGER := DFAACC(I).DFAACC_STATE; 
      begin
        MISC.MKDATA(ANUM); 

        if (TRACE and (ANUM /= 0)) then 
          TEXT_IO.PUT(STANDARD_ERROR, "state # "); 
          INT_IO.PUT(STANDARD_ERROR, I, 1); 
          TEXT_IO.PUT(STANDARD_ERROR, " accepts: ["); 
          INT_IO.PUT(STANDARD_ERROR, ANUM, 1); 
          TEXT_IO.PUT(STANDARD_ERROR, "]"); 
          TEXT_IO.NEW_LINE(STANDARD_ERROR); 
        end if; 
      end; 
    end loop; 

    MISC.DATAEND; 

    if (USEECS) then 
      GENECS; 
    end if; 

  -- don't have to dump the actual full table entries - they were created
  -- on-the-fly
  end GENFTBL; 

  -- generate the code to find the next compressed-table state

  procedure GEN_NEXT_COMPRESSED_STATE is 
  begin
    if (USEECS) then 
      INDENT_PUTS("yy_c := yy_ec(yy_ch_buf(yy_cp));"); 
    else 
      INDENT_PUTS("yy_c := yy_ch_buf(yy_cp);"); 
    end if; 

    -- save the backtracking info \before/ computing the next state
    -- because we always compute one more state than needed - we
    -- always proceed until we reach a jam state
    GEN_BACKTRACKING; 

    INDENT_PUTS(
      "while ( yy_chk(yy_base(yy_current_state) + yy_c) /= yy_current_state ) loop"
      ); 
    INDENT_UP; 
    INDENT_PUTS("yy_current_state := yy_def(yy_current_state);"); 

    if (USEMECS) then 

      -- we've arrange it so that templates are never chained
      -- to one another.  This means we can afford make a
      -- very simple test to see if we need to convert to
      -- yy_c's meta-equivalence class without worrying
      -- about erroneously looking up the meta-equivalence
      -- class twice
      DO_INDENT; 

      -- lastdfa + 2 is the beginning of the templates
      TEXT_IO.PUT("if ( yy_current_state >= "); 
      INT_IO.PUT(LASTDFA + 2, 1); 
      TEXT_IO.PUT_LINE(" ) then"); 

      INDENT_UP; 
      INDENT_PUTS("yy_c := yy_meta(yy_c);"); 
      INDENT_DOWN; 
      INDENT_PUTS("end if;"); 
    end if; 

    INDENT_DOWN; 
    INDENT_PUTS("end loop;"); 

    INDENT_PUTS("yy_current_state := yy_nxt(yy_base(yy_current_state) + yy_c);")
      ; 
    INDENT_DOWN; 
  end GEN_NEXT_COMPRESSED_STATE; 

  -- generate the code to find the next match

  procedure GEN_NEXT_MATCH is 
  -- note - changes in here should be reflected in get_next_state
  begin
    if (FULLTBL) then 
      INDENT_PUTS(
        "yy_current_state := yy_nxt(yy_current_state, yy_ch_buf(yy_cp));"); 
      INDENT_PUTS("while ( yy_current_state > 0 ) loop"); 
      INDENT_UP; 
      INDENT_PUTS("yy_cp := yy_cp + 1;"); 
      INDENT_PUTS(
        "yy_current_state := yy_nxt(yy_current_state, yy_ch_buf(yy_cp));"); 
      INDENT_DOWN; 
      INDENT_PUTS("end loop;"); 

      if (NUM_BACKTRACKING > 0) then 
        GEN_BACKTRACKING; 
        TEXT_IO.NEW_LINE; 
      end if; 

      TEXT_IO.NEW_LINE; 
      INDENT_PUTS("yy_current_state := -yy_current_state;"); 
    else 

      -- compressed
      INDENT_PUTS("loop"); 

      INDENT_UP; 

      GEN_NEXT_STATE; 

      INDENT_PUTS("yy_cp := yy_cp + 1;"); 

      if (INTERACTIVE) then
        TEXT_IO.PUT("if ( yy_base(yy_current_state) = ");
        INT_IO.PUT(JAMBASE, 1);
      else
        TEXT_IO.PUT("if ( yy_current_state = "); 
        INT_IO.PUT(JAMSTATE, 1); 
      end if;
      
      TEXT_IO.PUT_LINE(" ) then"); 
      TEXT_IO.PUT_LINE("    exit;"); 
      TEXT_IO.PUT_LINE("end if;"); 

      INDENT_DOWN; 

      DO_INDENT; 

      TEXT_IO.PUT_LINE("end loop;"); 

      if (not INTERACTIVE) then
        INDENT_PUTS("yy_cp := yy_last_accepting_cpos;"); 
        INDENT_PUTS("yy_current_state := yy_last_accepting_state;"); 
      end if;
    end if; 
  end GEN_NEXT_MATCH; 

  -- generate the code to find the next state

  procedure GEN_NEXT_STATE is 
  -- note - changes in here should be reflected in get_next_match
  begin
    INDENT_UP; 
    if (FULLTBL) then 
      INDENT_PUTS("yy_current_state := yy_nxt(yy_current_state,"); 
      INDENT_PUTS("                    yy_ch_buf(yy_cp));"); 
      GEN_BACKTRACKING; 
    else 
      GEN_NEXT_COMPRESSED_STATE; 
    end if; 
  end GEN_NEXT_STATE; 

  -- generate the code to find the start state

  procedure GEN_START_STATE is 
  begin
    INDENT_PUTS("yy_current_state := yy_start;"); 

    if (BOL_NEEDED) then 
      INDENT_PUTS("if ( yy_ch_buf(yy_bp-1) = ASCII.LF ) then"); 
      INDENT_UP; 
      INDENT_PUTS("yy_current_state := yy_current_state + 1;"); 
      INDENT_DOWN; 
      INDENT_PUTS("end if;"); 
    end if; 

  end GEN_START_STATE; 

  -- gentabs - generate data statements for the transition tables

  procedure GENTABS is 
    I, J, K, NACC, TOTAL_STATES : INTEGER; 
    ACCSET, ACC_ARRAY           : INT_PTR; 
    ACCNUM                      : INTEGER; 
    END_OF_BUFFER_ACTION        : INTEGER := NUM_RULES + 1; 
    -- *everything* is done in terms of arrays starting at 1, so provide
    -- a null entry for the zero element of all C arrays

    C_LONG_DECL                 : STRING(1 .. 44) := 
      "static const long int %s[%d] =\n    {   0,\n"; 
    C_SHORT_DECL                : STRING(1 .. 45) := 
      "static const short int %s[%d] =\n    {   0,\n"; 
    C_CHAR_DECL                 : STRING(1 .. 40) := 
      "static const char %s[%d] =\n    {   0,\n"; 
  begin
    ACC_ARRAY := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_DFAS); 
    NUMMT := 0; 

    -- the compressed table format jams by entering the "jam state",
    -- losing information about the previous state in the process.
    -- In order to recover the previous state, we effectively need
    -- to keep backtracking information.
    NUM_BACKTRACKING := NUM_BACKTRACKING + 1; 

    DFAACC(END_OF_BUFFER_STATE).DFAACC_STATE := END_OF_BUFFER_ACTION; 

    for CNT in 1 .. LASTDFA loop
      ACC_ARRAY(CNT) := DFAACC(CNT).DFAACC_STATE; 
    end loop; 


    ACC_ARRAY(LASTDFA + 1) := 0; 

    -- add accepting number for the jam state

    -- spit out ALIST array, dumping the accepting numbers.

    -- "lastdfa + 2" is the size of ALIST; includes room for arrays
    -- beginning at 0 and for "jam" state
    K := LASTDFA + 2; 

    TEXT_IO.PUT("yy_accept : constant array(0.."); 
    INT_IO.PUT(K - 1, 1); 
    TEXT_IO.PUT_LINE(") of short :="); 
    TEXT_IO.PUT_LINE("    (   0,"); 
    for CNT in 1 .. LASTDFA loop
      MISC.MKDATA(ACC_ARRAY(CNT)); 

      if (TRACE and (ACC_ARRAY(CNT) /= 0)) then 
        TEXT_IO.PUT(STANDARD_ERROR, "state # "); 
        INT_IO.PUT(STANDARD_ERROR, CNT, 1); 
        TEXT_IO.PUT(STANDARD_ERROR, " accepts: ["); 
        INT_IO.PUT(STANDARD_ERROR, ACC_ARRAY(CNT), 1); 
        TEXT_IO.PUT(STANDARD_ERROR, ']'); 
        TEXT_IO.NEW_LINE(STANDARD_ERROR); 
      end if; 
    end loop; 

    -- add entry for "jam" state
    MISC.MKDATA(ACC_ARRAY(LASTDFA + 1)); 

    MISC.DATAEND; 

    if (USEECS) then 
      GENECS; 
    end if; 

    if (USEMECS) then 

      -- write out meta-equivalence classes (used to index templates with)
      if (TRACE) then 
        TEXT_IO.NEW_LINE(STANDARD_ERROR); 
        TEXT_IO.NEW_LINE(STANDARD_ERROR); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, "Meta-Equivalence Classes:"); 
      end if; 

      TEXT_IO.PUT("yy_meta : constant array(0.."); 
      INT_IO.PUT(NUMECS, 1); 
      TEXT_IO.PUT_LINE(") of short :="); 
      TEXT_IO.PUT_LINE("    (   0,"); 
      for CNT in 1 .. NUMECS loop
        if (TRACE) then 
          INT_IO.PUT(STANDARD_ERROR, CNT, 1); 
          TEXT_IO.PUT(STANDARD_ERROR, " = "); 
          INT_IO.PUT(STANDARD_ERROR, abs(TECBCK(CNT)), 1); 
          TEXT_IO.NEW_LINE(STANDARD_ERROR); 
        end if; 
        MISC.MKDATA(abs(TECBCK(CNT))); 
      end loop; 

      MISC.DATAEND; 
    end if; 

    TOTAL_STATES := LASTDFA + NUMTEMPS; 

    TEXT_IO.PUT("yy_base : constant array(0.."); 
    INT_IO.PUT(TOTAL_STATES, 1); 
    if (TBLEND > MAX_SHORT) then 
      TEXT_IO.PUT_LINE(") of integer :="); 
    else 
      TEXT_IO.PUT_LINE(") of short :="); 
    end if; 
    TEXT_IO.PUT_LINE("    (   0,"); 

    for CNT in 1 .. LASTDFA loop
      declare
        D : INTEGER := DEF(CNT); 
      begin
        if (BASE(CNT) = JAMSTATE_CONST) then 
          BASE(CNT) := JAMBASE; 
        end if; 

        if (D = JAMSTATE_CONST) then 
          DEF(CNT) := JAMSTATE; 
        else 
          if (D < 0) then 

            -- template reference
            TMPUSES := TMPUSES + 1; 
            DEF(CNT) := LASTDFA - D + 1; 
          end if; 
        end if; 
        MISC.MKDATA(BASE(CNT)); 
      end; 
    end loop; 

    -- generate jam state's base index
    I := LASTDFA + 1; 
    MISC.MKDATA(BASE(I)); 

    -- skip jam state
    I := I + 1; 

    for CNT in I .. TOTAL_STATES loop
      MISC.MKDATA(BASE(CNT)); 
      DEF(CNT) := JAMSTATE; 
    end loop; 

    MISC.DATAEND; 

    TEXT_IO.PUT("yy_def : constant array(0.."); 
    INT_IO.PUT(TOTAL_STATES, 1); 
    if (TBLEND > MAX_SHORT) then 
      TEXT_IO.PUT_LINE(") of integer :="); 
    else 
      TEXT_IO.PUT_LINE(") of short :="); 
    end if; 
    TEXT_IO.PUT_LINE("    (   0,"); 

    for CNT in 1 .. TOTAL_STATES loop
      MISC.MKDATA(DEF(CNT)); 
    end loop; 

    MISC.DATAEND; 
    TEXT_IO.PUT("yy_nxt : constant array(0.."); 
    INT_IO.PUT(TBLEND, 1); 
    if (LASTDFA > MAX_SHORT) then 
      TEXT_IO.PUT_LINE(") of integer :="); 
    else 
      TEXT_IO.PUT_LINE(") of short :="); 
    end if; 
    TEXT_IO.PUT_LINE("    (   0,"); 

    for CNT in 1 .. TBLEND loop
      if ((NXT(CNT) = 0) or (CHK(CNT) = 0)) then 
        NXT(CNT) := JAMSTATE; 

      -- new state is the JAM state
      end if; 
      MISC.MKDATA(NXT(CNT)); 
    end loop; 

    MISC.DATAEND; 

    TEXT_IO.PUT("yy_chk : constant array(0.."); 
    INT_IO.PUT(TBLEND, 1); 
    if (LASTDFA > MAX_SHORT) then 
      TEXT_IO.PUT_LINE(") of integer :="); 
    else 
      TEXT_IO.PUT_LINE(") of short :="); 
    end if; 
    TEXT_IO.PUT_LINE("    (   0,"); 

    for CNT in 1 .. TBLEND loop
      if (CHK(CNT) = 0) then 
        NUMMT := NUMMT + 1; 
      end if; 

      MISC.MKDATA(CHK(CNT)); 
    end loop; 

    MISC.DATAEND; 
  exception
    when STORAGE_ERROR => 
      MISC.AFLEXFATAL("dynamic memory failure in gentabs()"); 
  end GENTABS; 

  -- write out a string at the current indentation level, adding a final
  -- newline

  procedure INDENT_PUTS(STR : in STRING) is 
  begin
    DO_INDENT; 
    TEXT_IO.PUT_LINE(STR); 
  end INDENT_PUTS; 

  -- do_sect3_out - dumps section 3.

  procedure DO_SECT3_OUT is 
    GARBAGE : TOKEN; 
  begin
    SCANNER.CALL_YYLEX := TRUE; 
    GARBAGE := SCANNER.GET_TOKEN; 
  end DO_SECT3_OUT; 

  -- make_tables - generate transition tables
  --
  --
  -- Generates transition tables and finishes generating output file

  procedure MAKE_TABLES is 
    DID_EOF_RULE      : BOOLEAN := FALSE; 
    TRANS_OFFSET_TYPE : STRING(1 .. 7); 
    TOTAL_TABLE_SIZE  : INTEGER := TBLEND + NUMECS + 1; 
    BUF               : VSTRING; 
  begin
    if (not FULLTBL) then 

      -- if we used full tables this is already output
      DO_SECT3_OUT; 

      -- intent of this call is to get everything up to ##
      SKELETON_MANAGER.SKELOUT; 

    -- output YYLex code up to part about tables.
    end if; 

    TEXT_IO.PUT("YY_END_OF_BUFFER : constant := "); 
    INT_IO.PUT(NUM_RULES + 1, 1); 
    TEXT_IO.PUT_LINE(";"); 

    INDENT_PUTS("subtype yy_state_type is integer;"); 
    INDENT_PUTS("yy_current_state : yy_state_type;"); 

    -- now output the constants for the various start conditions
    RESET(DEF_FILE, IN_FILE); 

    while (not TEXT_IO.END_OF_FILE(DEF_FILE)) loop
      TSTRING.GET_LINE(DEF_FILE, BUF); 
      TSTRING.PUT_LINE(BUF); 
    end loop; 

    if (FULLTBL) then 
      GENFTBL; 
    else 
      GENTABS; 
    end if; 

    RESET(TEMP_ACTION_FILE, IN_FILE); 

    -- generate code for yy_get_previous_state
    SET_INDENT(1); 
    SKELETON_MANAGER.SKELOUT; 

    if (BOL_NEEDED) then 
      INDENT_PUTS("yy_bp : integer := yytext_ptr;"); 
    end if; 
    SKELETON_MANAGER.SKELOUT; 

    GEN_START_STATE; 
    SKELETON_MANAGER.SKELOUT; 
    GEN_NEXT_STATE; 
    SKELETON_MANAGER.SKELOUT; 

    SET_INDENT(2); 

    INDENT_PUTS("yy_bp := yy_cp;"); 

    GEN_START_STATE; 
    GEN_NEXT_MATCH; 

    SKELETON_MANAGER.SKELOUT; 

    SET_INDENT(3); 
    GEN_FIND_ACTION; 

    SET_INDENT(1); 
    SKELETON_MANAGER.SKELOUT; 

    INDENT_UP; 
    GEN_BT_ACTION; 

    MISC.ACTION_OUT; 
    MISC.ACTION_OUT; 

    -- generate cases for any missing EOF rules
    for I in 1 .. LASTSC loop
      if (not SCEOF(I)) then 
        DO_INDENT; 
        if (not DID_EOF_RULE) then 
          TEXT_IO.PUT("when "); 
        else 
          TEXT_IO.PUT_LINE("|"); 
        end if; 
        TEXT_IO.PUT("YY_END_OF_BUFFER + "); 
        TSTRING.PUT(SCNAME(I)); 
        TEXT_IO.PUT(" + 1 "); 
        DID_EOF_RULE := TRUE; 
      end if; 
    end loop; 
    if (DID_EOF_RULE) then 
      TEXT_IO.PUT_LINE("=> "); 
    end if; 

    if (DID_EOF_RULE) then 
      INDENT_UP; 
      INDENT_PUTS("return End_Of_Input;"); 
      INDENT_DOWN; 
    end if; 

    SKELETON_MANAGER.SKELOUT; 

    -- copy remainder of input to output
    MISC.LINE_DIRECTIVE_OUT; 
    DO_SECT3_OUT; 

  -- copy remainder of input, after ##, to the scanner file.
  end MAKE_TABLES; 

end GEN; 

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE scanner generation
-- AUTHOR: John Self (UCI)
-- DESCRIPTION
-- NOTES does actual generation (writing) of output aflex scanners
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/gen.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS; use MISC_DEFS; 
package GEN is 
  procedure DO_INDENT; 
  procedure GEN_BACKTRACKING; 
  procedure GEN_BT_ACTION; 
  procedure GEN_FIND_ACTION; 
  procedure GEN_NEXT_COMPRESSED_STATE; 
  procedure GEN_NEXT_MATCH; 
  procedure GEN_NEXT_STATE; 
  procedure GEN_START_STATE; 
  procedure GENECS; 
  procedure GENFTBL; 
  procedure INDENT_PUTS(STR : in STRING); 
  procedure GENTABS; 
  procedure INDENT_DOWN; 
  procedure INDENT_UP; 
  procedure SET_INDENT(INDENT_VAL : in INTEGER); 
  procedure MAKE_TABLES; 
  procedure DO_SECT3_OUT; 
  pragma Inline(Indent_Up);
  pragma Inline(Indent_Down);
end GEN; 

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE integer IO
-- AUTHOR: John Self (UCI)
-- DESCRIPTION instantiation of integer IO generic for integers
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/int_io.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with TEXT_IO; 
package INT_IO is 
  new TEXT_IO.INTEGER_IO(INTEGER); 

pragma Warnings(Off);
pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE main body
-- AUTHOR: John Self (UCI)
-- DESCRIPTION driver routines for aflex.  Calls drivers for all
-- high level routines from other packages.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/main.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

with MISC_DEFS, Aflex_MISC, Aflex_COMMAND_LINE_INTERFACE, DFA, ECS, GEN, TEXT_IO, Aflex_PARSER; 
with MAIN_BODY, TSTRING, PARSE_TOKENS, SKELETON_MANAGER, EXTERNAL_FILE_MANAGER; 
with EXTERNAL_FILE_MANAGER, INT_IO; use MISC_DEFS, Aflex_COMMAND_LINE_INTERFACE, 
  TSTRING, EXTERNAL_FILE_MANAGER; 

package body MAIN_BODY is 
  package MISC renames Aflex_MISC;
  OUTFILE_CREATED    : BOOLEAN := FALSE; 
  AFLEX_VERSION      : CONSTANT STRING := "1.4a"; 
  STARTTIME, ENDTIME : VSTRING; 

  -- aflexend - terminate aflex
  --
  -- note
  --    This routine does not return.

  procedure AFLEXEND(STATUS : in INTEGER) is 
    use TEXT_IO; 
    TBLSIZ : INTEGER; 
  begin
    TERMINATION_STATUS := STATUS; 

    -- we'll return this value of the OS.
    if (IS_OPEN(SKELFILE)) then 
      CLOSE(SKELFILE); 
    end if; 

    if (IS_OPEN(TEMP_ACTION_FILE)) then 
      DELETE(TEMP_ACTION_FILE); 
    end if; 

    if (IS_OPEN(DEF_FILE)) then 
      DELETE(DEF_FILE); 
    end if; 

    if (BACKTRACK_REPORT) then 
      if (NUM_BACKTRACKING = 0) then 
        TEXT_IO.PUT_LINE(BACKTRACK_FILE, "No backtracking."); 
      else 
        if (FULLTBL) then 
          INT_IO.PUT(BACKTRACK_FILE, NUM_BACKTRACKING, 0); 
          TEXT_IO.PUT_LINE(BACKTRACK_FILE, 
            " backtracking (non-accepting) states."); 
        else 
          TEXT_IO.PUT_LINE(BACKTRACK_FILE, "Compressed tables always backtrack."
            ); 
        end if; 
      end if; 

      CLOSE(BACKTRACK_FILE); 
    end if; 

    if (PRINTSTATS) then 
      ENDTIME := MISC.AFLEX_GETTIME; 

      TEXT_IO.PUT_LINE(STANDARD_ERROR, "aflex version " & AFLEX_VERSION & 
        " usage statistics:"); 

      TSTRING.PUT_LINE(STANDARD_ERROR, "  started at " & STARTTIME & 
        ", finished at " & ENDTIME); 
      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, LASTNFA, 0); 
      TEXT_IO.PUT(STANDARD_ERROR, '/'); 
      INT_IO.PUT(STANDARD_ERROR, CURRENT_MNS, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, "  NFA states"); 

      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, LASTDFA, 0); 
      TEXT_IO.PUT(STANDARD_ERROR, '/'); 
      INT_IO.PUT(STANDARD_ERROR, CURRENT_MAX_DFAS, 0); 
      TEXT_IO.PUT(STANDARD_ERROR, " DFA states ("); 
      INT_IO.PUT(STANDARD_ERROR, TOTNST, 0); 
      TEXT_IO.PUT(STANDARD_ERROR, "  words)"); 

      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, NUM_RULES - 1, 0); 

      -- - 1 for def. rule
      TEXT_IO.PUT_LINE(STANDARD_ERROR, "  rules"); 

      if (NUM_BACKTRACKING = 0) then 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, "  No backtracking"); 
      else 
        if (FULLTBL) then 
          TEXT_IO.PUT(STANDARD_ERROR, "  "); 
          INT_IO.PUT(STANDARD_ERROR, NUM_BACKTRACKING, 0); 
          TEXT_IO.PUT_LINE(STANDARD_ERROR, 
            "  backtracking (non-accepting) states"); 
        else 
          TEXT_IO.PUT_LINE(STANDARD_ERROR, " compressed tables always backtrack"
            ); 
        end if; 
      end if; 

      if (BOL_NEEDED) then 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, "  Beginning-of-line patterns used"); 
      end if; 

      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, LASTSC, 0); 
      TEXT_IO.PUT(STANDARD_ERROR, '/'); 
      INT_IO.PUT(STANDARD_ERROR, CURRENT_MAX_SCS, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, " start conditions"); 

      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, NUMEPS, 0); 
      TEXT_IO.PUT(STANDARD_ERROR, " epsilon states, "); 
      INT_IO.PUT(STANDARD_ERROR, EPS2, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, "  double epsilon states"); 

      if (LASTCCL = 0) then 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, "  no character classes"); 
      else 
        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, LASTCCL, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, '/'); 
        INT_IO.PUT(STANDARD_ERROR, CURRENT_MAXCCLS, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, " character classes needed "); 
        INT_IO.PUT(STANDARD_ERROR, CCLMAP(LASTCCL) + CCLLEN(LASTCCL), 0); 
        TEXT_IO.PUT(STANDARD_ERROR, '/'); 
        INT_IO.PUT(STANDARD_ERROR, CURRENT_MAX_CCL_TBL_SIZE, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, " words of storage, "); 
        INT_IO.PUT(STANDARD_ERROR, CCLREUSE, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, "reused"); 
      end if; 

      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, NUMSNPAIRS, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, " state/nextstate pairs created"); 

      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, NUMUNIQ, 0); 
      TEXT_IO.PUT(STANDARD_ERROR, '/'); 
      INT_IO.PUT(STANDARD_ERROR, NUMDUP, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, " unique/duplicate transitions"); 

      if (FULLTBL) then 
        TBLSIZ := LASTDFA*NUMECS; 
        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, TBLSIZ, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, " table entries"); 
      else 
        TBLSIZ := 2*(LASTDFA + NUMTEMPS) + 2*TBLEND; 

        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, LASTDFA + NUMTEMPS, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, '/'); 
        INT_IO.PUT(STANDARD_ERROR, CURRENT_MAX_DFAS, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, " base-def entries created"); 

        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, TBLEND, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, '/'); 
        INT_IO.PUT(STANDARD_ERROR, CURRENT_MAX_XPAIRS, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, " (peak "); 
        INT_IO.PUT(STANDARD_ERROR, PEAKPAIRS, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, ") nxt-chk entries created"); 

        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, NUMTEMPS*NUMMECS, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, '/'); 
        INT_IO.PUT(STANDARD_ERROR, CURRENT_MAX_TEMPLATE_XPAIRS, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, " (peak "); 
        INT_IO.PUT(STANDARD_ERROR, NUMTEMPS*NUMECS, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, ") template nxt-chk entries created"); 

        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, NUMMT, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, " empty table entries"); 
        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, NUMPROTS, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, " protos created"); 
        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, NUMTEMPS, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, " templates created, "); 
        INT_IO.PUT(STANDARD_ERROR, TMPUSES, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, "uses"); 
      end if; 

      if (USEECS) then 
        TBLSIZ := TBLSIZ + CSIZE; 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, NUMECS, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, '/'); 
        INT_IO.PUT(STANDARD_ERROR, CSIZE, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, " equivalence classes created"); 
      end if; 

      if (USEMECS) then 
        TBLSIZ := TBLSIZ + NUMECS; 
        TEXT_IO.PUT(STANDARD_ERROR, "  "); 
        INT_IO.PUT(STANDARD_ERROR, NUMMECS, 0); 
        TEXT_IO.PUT(STANDARD_ERROR, '/'); 
        INT_IO.PUT(STANDARD_ERROR, CSIZE, 0); 
        TEXT_IO.PUT_LINE(STANDARD_ERROR, " meta-equivalence classes created"); 
      end if; 

      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, HSHCOL, 0); 
      TEXT_IO.PUT(STANDARD_ERROR, " ("); 
      INT_IO.PUT(STANDARD_ERROR, HSHSAVE, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, " saved) hash collisions, "); 
      INT_IO.PUT(STANDARD_ERROR, DFAEQL, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, " DFAs equal"); 

      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, NUM_REALLOCS, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, " sets of reallocations needed"); 
      TEXT_IO.PUT(STANDARD_ERROR, "  "); 
      INT_IO.PUT(STANDARD_ERROR, TBLSIZ, 0); 
      TEXT_IO.PUT_LINE(STANDARD_ERROR, " total table entries needed"); 
    end if; 

    if (STATUS /= 0) then 
      raise AFLEX_TERMINATE; 
    end if; 
  end AFLEXEND; 

  -- aflexinit - initialize aflex

  procedure AFLEXINIT is 
    use TEXT_IO, TSTRING; 
    SAWCMPFLAG, USE_STDOUT : BOOLEAN; 
    OUTPUT_FILE            : FILE_TYPE; 
    INPUT_FILE             : FILE_TYPE; 
    I                      : INTEGER; 
    ARG_CNT                : INTEGER; 
    FLAG_POS               : INTEGER; 
    ARG                    : VSTRING; 
    SKELNAME               : VSTRING; 
    SKELNAME_USED          : BOOLEAN := FALSE; 
  begin
    PRINTSTATS := FALSE; 
    SYNTAXERROR := FALSE; 
    TRACE := FALSE; 
    SPPRDFLT := FALSE; 
    INTERACTIVE := FALSE; 
    CASEINS := FALSE; 
    BACKTRACK_REPORT := FALSE; 
    PERFORMANCE_REPORT := FALSE; 
    DDEBUG := FALSE; 
    FULLTBL := FALSE; 
    CONTINUED_ACTION := FALSE; 
    GEN_LINE_DIRS := TRUE; 
    USEMECS := TRUE; 
    USEECS := TRUE; 

    SAWCMPFLAG := FALSE; 
    USE_STDOUT := FALSE; 

    -- read flags
    Aflex_COMMAND_LINE_INTERFACE.INITIALIZE_COMMAND_LINE; 

    -- load up argv
    EXTERNAL_FILE_MANAGER.INITIALIZE_FILES; 

    -- do external files setup

    -- loop through the list of arguments
    ARG_CNT := 1; 
    while (ARG_CNT <= ARGC - 1) loop
      if ((CHAR(ARGV(ARG_CNT), 1) /= '-') or (LEN(ARGV(ARG_CNT)) < 2)) then 
        exit; 
      end if; 

      -- loop through the flags in this argument.
      ARG := ARGV(ARG_CNT); 
      FLAG_POS := 2; 
      while (FLAG_POS <= LEN(ARG)) loop
        case CHAR(ARG, FLAG_POS) is 
          when 'b' => 
            BACKTRACK_REPORT := TRUE; 
          when 'd' => 
            DDEBUG := TRUE; 
          when 'f' => 
            USEECS := FALSE; 
            USEMECS := FALSE; 
            FULLTBL := TRUE; 
          when 'I' => 
            INTERACTIVE := TRUE; 
          when 'i' => 
            CASEINS := TRUE; 
          when 'L' => 
            GEN_LINE_DIRS := FALSE; 
          when 'p' => 
            PERFORMANCE_REPORT := TRUE; 
          when 'S' => 
            if (FLAG_POS /= 2) then 
              MISC.AFLEXERROR("-S flag must be given separately"); 
            end if; 
            SKELNAME := SLICE(ARG, FLAG_POS + 1, LEN(ARG)); 
            SKELNAME_USED := TRUE; 
            goto GET_NEXT_ARG; 
          when 's' => 
            SPPRDFLT := TRUE; 
          when 't' => 
            USE_STDOUT := TRUE; 
          when 'T' => 
            TRACE := TRUE; 
          when 'v' => 
            PRINTSTATS := TRUE; 
-- UMASS CODES :
--    Added an flag to indicate whether or not the aflex generated
--    codes will be used by Ayacc extension. Ayacc extension has
--    more power in error recovery.
          when 'E' =>
            Ayacc_Extension_Flag := TRUE;
-- END OF UMASS CODES.
          when others => 
            MISC.AFLEXERROR("unknown flag " & CHAR(ARG, FLAG_POS)); 
        end case; 
        FLAG_POS := FLAG_POS + 1; 
      end loop; 
      <<GET_NEXT_ARG>> ARG_CNT := ARG_CNT + 1; 

    -- go on to next argument from list.
    end loop; 

    if (FULLTBL and USEMECS) then 
      MISC.AFLEXERROR("full table and -cm don't make sense together"); 
    end if; 

    if (FULLTBL and INTERACTIVE) then 
      MISC.AFLEXERROR("full table and -I are (currently) incompatible"); 
    end if; 

    if (ARG_CNT < ARGC) then 
      begin
        if (ARG_CNT - ARGC > 1) then 
          MISC.AFLEXERROR("extraneous argument(s) given"); 
        end if; 

        -- Tell aflex where to read input from.
        INFILENAME := ARGV(ARG_CNT); 
        OPEN(INPUT_FILE, IN_FILE, STR(ARGV(ARG_CNT))); 
        SET_INPUT(INPUT_FILE); 
      exception
        when NAME_ERROR => 
          MISC.AFLEXFATAL("can't open " & INFILENAME); 
      end; 
    end if; 

    if (not USE_STDOUT) then 
      EXTERNAL_FILE_MANAGER.GET_SCANNER_FILE(OUTPUT_FILE); 
      OUTFILE_CREATED := TRUE; 
    end if; 

    if (BACKTRACK_REPORT) then 
      EXTERNAL_FILE_MANAGER.GET_BACKTRACK_FILE(BACKTRACK_FILE); 
    end if; 

    LASTCCL := 0; 
    LASTSC := 0; 


    --initialize the statistics
    STARTTIME := MISC.AFLEX_GETTIME; 

    begin

      -- open the skeleton file
      if (SKELNAME_USED) then 
        OPEN(SKELFILE, IN_FILE, STR(SKELNAME)); 
        SKELETON_MANAGER.SET_EXTERNAL_SKELETON; 
      end if; 
    exception
      when USE_ERROR | NAME_ERROR => 
        MISC.AFLEXFATAL("couldn't open skeleton file " & SKELNAME); 
    end; 

    -- without a third argument create make an anonymous temp file.
    begin
      CREATE(TEMP_ACTION_FILE, OUT_FILE); 
      CREATE(DEF_FILE, OUT_FILE); 
    exception
      when USE_ERROR | NAME_ERROR => 
        MISC.AFLEXFATAL("can't create temporary file"); 
    end; 

    LASTDFA := 0; 
    LASTNFA := 0; 
    NUM_RULES := 0; 
    NUMAS := 0; 
    NUMSNPAIRS := 0; 
    TMPUSES := 0; 
    NUMECS := 0; 
    NUMEPS := 0; 
    EPS2 := 0; 
    NUM_REALLOCS := 0; 
    HSHCOL := 0; 
    DFAEQL := 0; 
    TOTNST := 0; 
    NUMUNIQ := 0; 
    NUMDUP := 0; 
    HSHSAVE := 0; 
    EOFSEEN := FALSE; 
    DATAPOS := 0; 
    DATALINE := 0; 
    NUM_BACKTRACKING := 0; 
    ONESP := 0; 
    NUMPROTS := 0; 
    VARIABLE_TRAILING_CONTEXT_RULES := FALSE; 
    BOL_NEEDED := FALSE; 

    LINENUM := 1; 
    SECTNUM := 1; 
    FIRSTPROT := NIL; 

    -- used in mkprot() so that the first proto goes in slot 1
    -- of the proto queue

    LASTPROT := 1; 

    if (USEECS) then 
    -- set up doubly-linked equivalence classes
      ECGROUP(1) := NIL; 

      for CNT in 2 .. CSIZE loop
        ECGROUP(CNT) := CNT - 1; 
        NEXTECM(CNT - 1) := CNT; 
      end loop; 

      NEXTECM(CSIZE) := NIL; 
    else 
    -- put everything in its own equivalence class
      for CNT in 1 .. CSIZE loop
        ECGROUP(CNT) := CNT; 
        NEXTECM(CNT) := BAD_SUBSCRIPT;  -- to catch errors
      end loop; 
    end if; 

    SET_UP_INITIAL_ALLOCATIONS; 


  end AFLEXINIT; 

  -- readin - read in the rules section of the input file(s)
  procedure READIN is 
  begin
    SKELETON_MANAGER.SKELOUT; 
    TEXT_IO.PUT("with " & TSTRING.STR(MISC.BASENAME) & "_dfa" & "; "); 
    TEXT_IO.PUT_LINE("use " & TSTRING.STR(MISC.BASENAME) & "_dfa" & "; "); 
    TEXT_IO.PUT("with " & TSTRING.STR(MISC.BASENAME) & "_io" & "; "); 
    TEXT_IO.PUT_LINE("use " & TSTRING.STR(MISC.BASENAME) & "_io" & "; "); 
    MISC.LINE_DIRECTIVE_OUT; 

    Aflex_PARSER.YYPARSE; 

    if (USEECS) then 
      ECS.CRE8ECS(NEXTECM, ECGROUP, CSIZE, NUMECS); 
      ECS.CCL2ECL; 
    else 
      NUMECS := CSIZE; 
    end if; 
  exception
    when PARSE_TOKENS.SYNTAX_ERROR => 
      MISC.AFLEXERROR("fatal parse error at line " & INTEGER'IMAGE(LINENUM)); 
      MAIN_BODY.AFLEXEND(1); 
  end READIN; 

  -- set_up_initial_allocations - allocate memory for internal tables
  procedure SET_UP_INITIAL_ALLOCATIONS is 
  begin
    CURRENT_MNS := INITIAL_MNS; 
    FIRSTST := ALLOCATE_INTEGER_ARRAY(CURRENT_MNS); 
    LASTST := ALLOCATE_INTEGER_ARRAY(CURRENT_MNS); 
    FINALST := ALLOCATE_INTEGER_ARRAY(CURRENT_MNS); 
    TRANSCHAR := ALLOCATE_INTEGER_ARRAY(CURRENT_MNS); 
    TRANS1 := ALLOCATE_INTEGER_ARRAY(CURRENT_MNS); 
    TRANS2 := ALLOCATE_INTEGER_ARRAY(CURRENT_MNS); 
    ACCPTNUM := ALLOCATE_INTEGER_ARRAY(CURRENT_MNS); 
    ASSOC_RULE := ALLOCATE_INTEGER_ARRAY(CURRENT_MNS); 
    STATE_TYPE := ALLOCATE_STATE_ENUM_ARRAY(CURRENT_MNS); 

    CURRENT_MAX_RULES := INITIAL_MAX_RULES; 
    RULE_TYPE := ALLOCATE_RULE_ENUM_ARRAY(CURRENT_MAX_RULES); 
    RULE_LINENUM := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_RULES); 

    CURRENT_MAX_SCS := INITIAL_MAX_SCS; 
    SCSET := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_SCS); 
    SCBOL := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_SCS); 
    SCXCLU := ALLOCATE_BOOLEAN_ARRAY(CURRENT_MAX_SCS); 
    SCEOF := ALLOCATE_BOOLEAN_ARRAY(CURRENT_MAX_SCS); 
    SCNAME := ALLOCATE_VSTRING_ARRAY(CURRENT_MAX_SCS); 
    ACTVSC := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_SCS); 

    CURRENT_MAXCCLS := INITIAL_MAX_CCLS; 
    CCLMAP := ALLOCATE_INTEGER_ARRAY(CURRENT_MAXCCLS); 
    CCLLEN := ALLOCATE_INTEGER_ARRAY(CURRENT_MAXCCLS); 
    CCLNG := ALLOCATE_INTEGER_ARRAY(CURRENT_MAXCCLS); 

    CURRENT_MAX_CCL_TBL_SIZE := INITIAL_MAX_CCL_TBL_SIZE; 
    CCLTBL := ALLOCATE_CHARACTER_ARRAY(CURRENT_MAX_CCL_TBL_SIZE); 

    CURRENT_MAX_DFA_SIZE := INITIAL_MAX_DFA_SIZE; 

    CURRENT_MAX_XPAIRS := INITIAL_MAX_XPAIRS; 
    NXT := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_XPAIRS); 
    CHK := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_XPAIRS); 

    CURRENT_MAX_TEMPLATE_XPAIRS := INITIAL_MAX_TEMPLATE_XPAIRS; 
    TNXT := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_TEMPLATE_XPAIRS); 

    CURRENT_MAX_DFAS := INITIAL_MAX_DFAS; 
    BASE := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_DFAS); 
    DEF := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_DFAS); 
    DFASIZ := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_DFAS); 
    ACCSIZ := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_DFAS); 
    DHASH := ALLOCATE_INTEGER_ARRAY(CURRENT_MAX_DFAS); 
    DSS := ALLOCATE_INT_PTR_ARRAY(CURRENT_MAX_DFAS); 
    DFAACC := ALLOCATE_DFAACC_UNION(CURRENT_MAX_DFAS); 
  end SET_UP_INITIAL_ALLOCATIONS; 
end MAIN_BODY; 

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE main body
-- AUTHOR: John Self (UCI)
-- DESCRIPTION driver routines for aflex.  Calls drivers for all
-- high level routines from other packages.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/main.ads,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

-- aflex - tool to generate fast lexical analyzers
package MAIN_BODY is 
  procedure AFLEXEND(STATUS : in INTEGER); 
  procedure AFLEXINIT; 
  procedure READIN; 
  procedure SET_UP_INITIAL_ALLOCATIONS; 
  AFLEX_TERMINATE    : exception; 
  TERMINATION_STATUS : INTEGER; 
end MAIN_BODY; 

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE miscellaneous definitions
-- AUTHOR: John Self (UCI)
-- DESCRIPTION contains all global variables used in aflex.
--             also some subprograms which are commonly used.
-- NOTES The real purpose of this file is to contain all miscellaneous
--       items (functions, MACROS, variables definitions) which were at the
--       top level of flex.
-- $Header: /Users/stt/_parasail/_aflex_ayacc/_adamagic/aflex/RCS/misc_defs.adb,v 1.1 2011/03/02 22:14:39 stt Exp stt $ 

package body MISC_DEFS is 

-- returns true if an nfa state has an epsilon out-transition slot
-- that can be used.  This definition is currently not used.

  function FREE_EPSILON(STATE : in INTEGER) return BOOLEAN is 
  begin
    return ((TRANSCHAR(STATE) = SYM_EPSILON) and (TRANS2(STATE) = NO_TRANSITION)
      and (FINALST(STATE) /= STATE)); 
  end FREE_EPSILON; 

  -- returns true if an nfa state has an epsilon out-transition character
  -- and both slots are free

  function SUPER_FREE_EPSILON(STATE : in INTEGER) return BOOLEAN is 
  begin
    return ((TRANSCHAR(STATE) = SYM_EPSILON) and (TRANS1(STATE) = NO_TRANSITION)
      ); 
  end SUPER_FREE_EPSILON; 

  function ALLOCATE_INTEGER_ARRAY(SIZE : in INTEGER) return INT_PTR is 
  begin
    return new UNBOUNDED_INT_ARRAY(0 .. SIZE); 
  end ALLOCATE_INTEGER_ARRAY; 

  procedure REALLOCATE_INTEGER_ARRAY(ARR  : in out INT_PTR; 
                                     SIZE : in INTEGER) is 
    NEW_ARR : INT_PTR; 
  begin
    NEW_ARR := ALLOCATE_INTEGER_ARRAY(SIZE); 
    NEW_ARR(0 .. ARR'LAST) := ARR(0 .. ARR'LAST); 
    ARR := NEW_ARR; 
  end REALLOCATE_INTEGER_ARRAY; 

  procedure REALLOCATE_STATE_ENUM_ARRAY(ARR  : in out STATE_ENUM_PTR; 
                                        SIZE : in INTEGER) is 
    NEW_ARR : STATE_ENUM_PTR; 
  begin
    NEW_ARR := ALLOCATE_STATE_ENUM_ARRAY(SIZE); 
    NEW_ARR(0 .. ARR'LAST) := ARR(0 .. ARR'LAST); 
    ARR := NEW_ARR; 
  end REALLOCATE_STATE_ENUM_ARRAY; 

  procedure REALLOCATE_RULE_ENUM_ARRAY(ARR  : in out RULE_ENUM_PTR; 
                                       SIZE : in INTEGER) is 
    NEW_ARR : RULE_ENUM_PTR; 
  begin
    NEW_ARR := ALLOCATE_RULE_ENUM_ARRAY(SIZE); 
    NEW_ARR(0 .. ARR'LAST) := ARR(0 .. ARR'LAST); 
    ARR := NEW_ARR; 
  end REALLOCATE_RULE_ENUM_ARRAY; 

  function ALLOCATE_INT_PTR_ARRAY(SIZE : in INTEGER) return INT_STAR_PTR is 
  begin
    return new UNBOUNDED_INT_STAR_ARRAY(0 .. SIZE); 
  end ALLOCATE_INT_PTR_ARRAY; 

  function ALLOCATE_RULE_ENUM_ARRAY(SIZE : in INTEGER) return RULE_ENUM_PTR is 
  begin
    return new UNBOUNDED_RULE_ENUM_ARRAY(0 .. SIZE); 
  end ALLOCATE_RULE_ENUM_ARRAY; 

  function ALLOCATE_STATE_ENUM_ARRAY(SIZE : in INTEGER) return STATE_ENUM_PTR
    is 
  begin
    return new UNBOUNDED_STATE_ENUM_ARRAY(0 .. SIZE); 
  end ALLOCATE_STATE_ENUM_ARRAY; 

  function ALLOCATE_BOOLEAN_ARRAY(SIZE : in INTEGER) return BOOLEAN_PTR is 
  begin
    return new BOOLEAN_ARRAY(0 .. SIZE); 
  end ALLOCATE_BOOLEAN_ARRAY; 

  function ALLOCATE_VSTRING_ARRAY(SIZE : in INTEGER) return VSTRING_PTR is 
  begin
    return new UNBOUNDED_VSTRING_ARRAY(0 .. SIZE); 
  end ALLOCATE_VSTRING_ARRAY; 

  function ALLOCATE_DFAACC_UNION(SIZE : in INTEGER) return DFAACC_PTR is 
  begin
    return new UNBOUNDED_DFAACC_ARRAY(0 .. SIZE); 
  end ALLOCATE_DFAACC_UNION; 

  procedure REALLOCATE_INT_PTR_ARRAY(ARR  : in out INT_STAR_PTR; 
                                     SIZE : in INTEGER) is 
    NEW_ARR : INT_STAR_PTR; 
  begin
    NEW_ARR := ALLOCATE_INT_PTR_ARRAY(SIZE); 
    NEW_ARR(0 .. ARR'LAST) := ARR(0 .. ARR'LAST); 
    ARR := NEW_ARR; 
  end REALLOCATE_INT_PTR_ARRAY; 

  procedure REALLOCATE_CHARACTER_ARRAY(ARR  : in out CHAR_PTR; 
                                       SIZE : in INTEGER) is 
    NEW_ARR : CHAR_PTR; 
  begin
    NEW_ARR := ALLOCATE_CHARACTER_ARRAY(SIZE); 
    NEW_ARR(0 .. ARR'LAST) := ARR(0 .. ARR'LAST); 
    ARR := NEW_ARR; 
  end REALLOCATE_CHARACTER_ARRAY; 

  procedure REALLOCATE_VSTRING_ARRAY(ARR  : in out VSTRING_PTR; 
                                     SIZE : in INTEGER) is 
    NEW_ARR : VSTRING_PTR; 
  begin
    NEW_ARR := ALLOCATE_VSTRING_ARRAY(SIZE); 
    NEW_ARR(0 .. ARR'LAST) := ARR(0 .. ARR'LAST); 
    ARR := NEW_ARR; 
  end REALLOCATE_VSTRING_ARRAY; 

  function ALLOCATE_CHARACTER_ARRAY(SIZE : in INTEGER) return CHAR_PTR is 
  begin
    return new CHAR_ARRAY(0 .. SIZE); 
  end ALLOCATE_CHARACTER_ARRAY; 

  procedure REALLOCATE_DFAACC_UNION(ARR  : in out DFAACC_PTR; 
                                    SIZE : in INTEGER) is 
    NEW_ARR : DFAACC_PTR; 
  begin
    NEW_ARR := ALLOCATE_DFAACC_UNION(SIZE); 
    NEW_ARR(0 .. ARR'LAST) := ARR(0 .. ARR'LAST); 
    ARR := NEW_ARR; 
  end REALLOCATE_DFAACC_UNION; 

  procedure REALLOCATE_BOOLEAN_ARRAY(ARR  : in out BOOLEAN_PTR; 
                                     SIZE : in INTEGER) is 
    NEW_ARR : BOOLEAN_PTR; 
  begin
    NEW_ARR := ALLOCATE_BOOLEAN_ARRAY(SIZE); 
    NEW_ARR(0 .. ARR'LAST) := ARR(0 .. ARR'LAST); 
    ARR := NEW_ARR; 
  end REALLOCATE_BOOLEAN_ARRAY; 

  function MAX(X, Y : in INTEGER) return INTEGER is 
  begin
    if (X > Y) then 
      return X; 
    else 
      return Y; 
    end if; 
  end MAX; 

  function MIN(X, Y : in INTEGER) return INTEGER is 
  begin
    if (X < Y) then 
      return X; 
    else 
      return Y; 
    end if; 
  end MIN; 

end MISC_DEFS; 

pragma Style_Checks(Off);
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE miscellaneous definitions
-- AUTHOR: John Self (UCI)
-- DESCRIPTION contains all global variables used in aflex.
--             also some subprograms which are commonly used.
-- NOTES The real purpose of this file is to contain all miscellaneous
--       items (functions, MACROS, variables definitions) which were at the
--       top level of flex.
-- $Header: /co/ua/self/arcadia/alex/ada/RCS/misc_defsS.a,v 1.8 90/01/04 13:39:
-- 33 self Exp Locker: self $ 

with TEXT_IO, TSTRING;
use TEXT_IO, TSTRING;

package MISC_DEFS is

-- UMASS CODES :
  Ayacc_Extension_Flag : Boolean := False;
  -- Indicates whether or not aflex generated codes will be
  -- used by Ayacc extension. Ayacc extension has more power
  -- in error recovery. True means that generated codes will
  -- be used by Ayacc extension.
-- END OF UMASS CODES.

  -- various definitions that were in parse.y
  PAT, SCNUM, EPS, HEADCNT, TRAILCNT, ANYCCL, LASTCHAR, ACTVP, RULELEN : INTEGER
    ;
  TRLCONTXT, XCLUFLG, CCLSORTED, VARLENGTH, VARIABLE_TRAIL_RULE : BOOLEAN;

  MADEANY : BOOLEAN := FALSE;  -- whether we've made the '.' character class 
  PREVIOUS_CONTINUED_ACTION : BOOLEAN; -- whether the previous rule's action wa
                                       -- s '|'

  -- maximum line length we'll have to deal with 
  MAXLINE : constant INTEGER := 1024;

  -- These typees are needed for the various allocators.
  type UNBOUNDED_INT_ARRAY is array ( INTEGER range <> ) of INTEGER;
  type INT_PTR is access UNBOUNDED_INT_ARRAY;
  type INT_STAR is access INTEGER;
  type UNBOUNDED_INT_STAR_ARRAY is array ( INTEGER range <> ) of INT_PTR;
  type INT_STAR_PTR is access UNBOUNDED_INT_STAR_ARRAY;
  type UNBOUNDED_VSTRING_ARRAY is array ( INTEGER range <> ) of VSTRING;
  type VSTRING_PTR is access UNBOUNDED_VSTRING_ARRAY;
  type BOOLEAN_ARRAY is array ( INTEGER range <> ) of BOOLEAN;
  type BOOLEAN_PTR is access BOOLEAN_ARRAY;
  type CHAR_ARRAY is array ( INTEGER range <> ) of CHARACTER;
  type CHAR_PTR is access CHAR_ARRAY;

  -- different types of states; values are useful as masks, as well, for
  -- routines like check_trailing_context()

  type STATE_ENUM is (STATE_NORMAL, STATE_TRAILING_CONTEXT);

  type UNBOUNDED_STATE_ENUM_ARRAY is array ( INTEGER range <> ) of STATE_ENUM;
  type STATE_ENUM_PTR is access UNBOUNDED_STATE_ENUM_ARRAY;

  -- different types of rules
  type RULE_ENUM is (RULE_NORMAL, RULE_VARIABLE);

  type UNBOUNDED_RULE_ENUM_ARRAY is array ( INTEGER range <> ) of RULE_ENUM;
  type RULE_ENUM_PTR is access UNBOUNDED_RULE_ENUM_ARRAY;

  type DFAACC_TYPE is
    record
      DFAACC_SET : INT_PTR;
      DFAACC_STATE : INTEGER;
    end record;

  type UNBOUNDED_DFAACC_ARRAY is array ( INTEGER range <> ) of DFAACC_TYPE;
  type DFAACC_PTR is access UNBOUNDED_DFAACC_ARRAY;

  -- maximum size of file name 

  FILENAMESIZE : constant INTEGER := 1024;

  function MIN (X, Y : in INTEGER) return INTEGER;
  function MAX (X, Y : in INTEGER) return INTEGER;

  -- special chk[] values marking the slots taking by end-of-buffer and action
  -- numbers

  EOB_POSITION : constant INTEGER := - 1;
  ACTION_POSITION : constant INTEGER := - 2;

  -- number of data items per line for -f output
  NUMDATAITEMS : constant INTEGER := 10;

  -- number of lines of data in -f output before inserting a blank line for
  -- readability.

  NUMDATALINES : constant INTEGER := 10;

  -- transition_struct_out() definitions
  TRANS_STRUCT_PRINT_LENGTH : constant INTEGER := 15;

  -- returns true if an nfa state has an epsilon out-transition slot
  -- that can be used.  This definition is currently not used.

  function FREE_EPSILON ( STATE : in INTEGER) return BOOLEAN;

  -- returns true if an nfa state has an epsilon out-transition character
  -- and both slots are free

  function SUPER_FREE_EPSILON (STATE : in INTEGER) return BOOLEAN;

  -- maximum number of NFA states that can comprise a DFA state.  It's real
  -- big because if there's a lot of rules, the initial state will have a
  -- huge epsilon closure.

  INITIAL_MAX_DFA_SIZE : constant INTEGER := 750;
  MAX_DFA_SIZE_INCREMENT : constant INTEGER := 750;

  -- a note on the following masks.  They are used to mark accepting numbers
  -- as being special.  As such, they implicitly limit the number of accepting
  -- numbers (i.e., rules) because if there are too many rules the rule numbers
  -- will overload the mask bits.  Fortunately, this limit is \large/ (0x2000 ==
  -- 8192) so unlikely to actually cause any problems.  A check is made in
  -- new_rule() to ensure that this limit is not reached.

  -- mask to mark a trailing context accepting number
  -- #define YY_TRAILING_MASK 0x2000
  YY_TRAILING_MASK : constant INTEGER := 16#2000#;


  -- mask to mark the accepting number of the "head" of a trailing context rule
  -- #define YY_TRAILING_HEAD_MASK 0x4000
  YY_TRAILING_HEAD_MASK : constant INTEGER := 16#4000#;

  -- maximum number of rules, as outlined in the above note
  MAX_RULE : constant INTEGER := YY_TRAILING_MASK - 1;


  -- NIL must be 0.  If not, its special meaning when making equivalence classes
  -- (it marks the representative of a given e.c.) will be unidentifiable

  NIL : constant INTEGER := 0;

  JAM : constant INTEGER := - 1; -- to mark a missing DFA transition 
  NO_TRANSITION : constant INTEGER := NIL;
  UNIQUE : constant INTEGER := - 1; -- marks a symbol as an e.c. representative
  INFINITY : constant INTEGER := - 1; -- for x{5,} constructions

  -- size of input alphabet - should be size of ASCII set
  CSIZE : constant INTEGER := 255;  -- ##stt 3/2/2011 was 127

  INITIAL_MAX_CCLS : constant INTEGER := 100; -- max number of unique character
                                              --  classes
  MAX_CCLS_INCREMENT : constant INTEGER := 100;

  -- size of table holding members of character classes
  INITIAL_MAX_CCL_TBL_SIZE : constant INTEGER := 500;
  MAX_CCL_TBL_SIZE_INCREMENT : constant INTEGER := 250;
  INITIAL_MAX_RULES : constant INTEGER := 100;
  -- default maximum number of rules
  MAX_RULES_INCREMENT : constant INTEGER := 100;

  INITIAL_MNS : constant INTEGER := 2000; -- default maximum number of nfa stat
                                          -- es
  MNS_INCREMENT : constant INTEGER := 1000; -- amount to bump above by if it's 
                                            -- not enough

  INITIAL_MAX_DFAS : constant INTEGER := 1000; -- default maximum number of dfa
                                               --  states
  MAX_DFAS_INCREMENT : constant INTEGER := 1000;

  JAMSTATE_CONST : constant INTEGER := - 32766; -- marks a reference to the sta
                                                -- te that always jams

  -- enough so that if it's subtracted from an NFA state number, the result
  -- is guaranteed to be negative

  MARKER_DIFFERENCE : constant INTEGER := 32000;
  MAXIMUM_MNS : constant INTEGER := 31999;

  -- maximum number of nxt/chk pairs for non-templates
  INITIAL_MAX_XPAIRS : constant INTEGER := 2000;
  MAX_XPAIRS_INCREMENT : constant INTEGER := 2000;

  -- maximum number of nxt/chk pairs needed for templates
  INITIAL_MAX_TEMPLATE_XPAIRS : constant INTEGER := 2500;
  MAX_TEMPLATE_XPAIRS_INCREMENT : constant INTEGER := 2500;

  SYM_EPSILON : constant INTEGER := 0; -- to mark transitions on the symbol eps
                                       -- ilon

  INITIAL_MAX_SCS : constant INTEGER := 40; -- maximum number of start conditio
                                            -- ns
  MAX_SCS_INCREMENT : constant INTEGER := 40; -- amount to bump by if it's not 
                                              -- enough

  ONE_STACK_SIZE : constant INTEGER := 500; -- stack of states with only one ou
                                            -- t-transition
  SAME_TRANS : constant INTEGER := - 1; -- transition is the same as "default" 
                                        -- entry for state

  -- the following percentages are used to tune table compression:
  --
  -- the percentage the number of out-transitions a state must be of the
  -- number of equivalence classes in order to be considered for table
  -- compaction by using protos

  PROTO_SIZE_PERCENTAGE : constant INTEGER := 15;

  -- the percentage the number of homogeneous out-transitions of a state
  -- must be of the number of total out-transitions of the state in order
  -- that the state's transition table is first compared with a potential 
  -- template of the most common out-transition instead of with the first
  --proto in the proto queue

  CHECK_COM_PERCENTAGE : constant INTEGER := 50;

  -- the percentage the number of differences between a state's transition
  -- table and the proto it was first compared with must be of the total
  -- number of out-transitions of the state in order to keep the first
  -- proto as a good match and not search any further

  FIRST_MATCH_DIFF_PERCENTAGE : constant INTEGER := 10;

  -- the percentage the number of differences between a state's transition
  -- table and the most similar proto must be of the state's total number
  -- of out-transitions to use the proto as an acceptable close match

  ACCEPTABLE_DIFF_PERCENTAGE : constant INTEGER := 50;

  -- the percentage the number of homogeneous out-transitions of a state
  -- must be of the number of total out-transitions of the state in order
  -- to consider making a template from the state

  TEMPLATE_SAME_PERCENTAGE : constant INTEGER := 60;

  -- the percentage the number of differences between a state's transition
  -- table and the most similar proto must be of the state's total number
  -- of out-transitions to create a new proto from the state

  NEW_PROTO_DIFF_PERCENTAGE : constant INTEGER := 20;

  -- the percentage the total number of out-transitions of a state must be
  -- of the number of equivalence classes in order to consider trying to
  -- fit the transition table into "holes" inside the nxt/chk table.

  INTERIOR_FIT_PERCENTAGE : constant INTEGER := 15;

  -- size of region set aside to cache the complete transition table of
  -- protos on the proto queue to enable quick comparisons

  PROT_SAVE_SIZE : constant INTEGER := 2000;

  MSP : constant INTEGER := 50; -- maximum number of saved protos (protos on th
                                -- e proto queue)

  -- maximum number of out-transitions a state can have that we'll rummage
  -- around through the interior of the internal fast table looking for a
  -- spot for it

  MAX_XTIONS_FULL_INTERIOR_FIT : constant INTEGER := 4;

  -- maximum number of rules which will be reported as being associated
  -- with a DFA state

  MAX_ASSOC_RULES : constant INTEGER := 100;

  -- number that, if used to subscript an array, has a good chance of producing
  -- an error; should be small enough to fit into a short

  BAD_SUBSCRIPT : constant INTEGER := - 32767;

  -- Declarations for global variables.

  -- variables for symbol tables:
  -- sctbl - start-condition symbol table
  -- ndtbl - name-definition symbol table
  -- ccltab - character class text symbol table

  type HASH_ENTRY;
  type HASH_LINK is access HASH_ENTRY;
  type HASH_ENTRY is
    record
      PREV, NEXT : HASH_LINK;
      NAME, STR_VAL : VSTRING;
      INT_VAL : INTEGER;
    end record;

  type HASH_TABLE is array ( INTEGER range <> ) of HASH_LINK;

  NAME_TABLE_HASH_SIZE : constant INTEGER := 101;
  START_COND_HASH_SIZE : constant INTEGER := 101;
  CCL_HASH_SIZE : constant INTEGER := 101;

  subtype NDTBL_TYPE is HASH_TABLE (0 .. NAME_TABLE_HASH_SIZE - 1);
  NDTBL : NDTBL_TYPE;
  subtype SCTBL_TYPE is HASH_TABLE (0 .. START_COND_HASH_SIZE - 1);
  SCTBL : SCTBL_TYPE;
  subtype CCLTAB_TYPE is HASH_TABLE (0 .. CCL_HASH_SIZE);
  CCLTAB : CCLTAB_TYPE;

  -- variables for flags:
  -- printstats - if true (-v), dump statistics
  -- syntaxerror - true if a syntax error has been found
  -- eofseen - true if we've seen an eof in the input file
  -- ddebug - if true (-d), make a "debug" scanner
  -- trace - if true (-T), trace processing
  -- spprdflt - if true (-s), suppress the default rule
  -- interactive - if true (-I), generate an interactive scanner
  -- caseins - if true (-i), generate a case-insensitive scanner
  -- useecs - if true (-ce flag), use equivalence classes
  -- fulltbl - if true (-cf flag), don't compress the DFA state table
  -- usemecs - if true (-cm flag), use meta-equivalence classes
  -- gen_line_dirs - if true (i.e., no -L flag), generate #line directives
  -- performance_report - if true (i.e., -p flag), generate a report relating
  --   to scanner performance
  -- backtrack_report - if true (i.e., -b flag), generate "lex.backtrack" file
  --   listing backtracking states
  -- continued_action - true if this rule's action is to "fall through" to
  --                    the next rule's action (i.e., the '|' action)

  PRINTSTATS, DDEBUG, SPPRDFLT,
  INTERACTIVE, CASEINS, USEECS, FULLTBL, USEMECS,
  GEN_LINE_DIRS, PERFORMANCE_REPORT, BACKTRACK_REPORT,
  TRACE, EOFSEEN, CONTINUED_ACTION : BOOLEAN;

  SYNTAXERROR : BOOLEAN;

  -- variables used in the aflex input routines:
  -- datapos - characters on current output line
  -- dataline - number of contiguous lines of data in current data
  --    statement.  Used to generate readable -f output
  -- skelfile - the skeleton file
  -- yyin - input file
  -- temp_action_file - temporary file to hold actions
  -- backtrack_file - file to summarize backtracking states to
  -- infilename - name of input file
  -- linenum - current input line number

  DATAPOS, DATALINE, LINENUM : INTEGER;

  SKELFILE, YYIN, TEMP_ACTION_FILE, BACKTRACK_FILE, DEF_FILE : FILE_TYPE;
  INFILENAME : VSTRING;

  -- variables for stack of states having only one out-transition:
  -- onestate - state number
  -- onesym - transition symbol
  -- onenext - target state
  -- onedef - default base entry
  -- onesp - stack pointer

  ONESTATE, ONESYM, ONENEXT, ONEDEF : array (0 .. ONE_STACK_SIZE - 1) of INTEGER
    ;
  ONESP : INTEGER;


  -- variables for nfa machine data:
  -- current_mns - current maximum on number of NFA states
  -- num_rules - number of the last accepting state; also is number of
  --             rules created so far
  -- current_max_rules - current maximum number of rules
  -- lastnfa - last nfa state number created
  -- firstst - physically the first state of a fragment
  -- lastst - last physical state of fragment
  -- finalst - last logical state of fragment
  -- transchar - transition character
  -- trans1 - transition state
  -- trans2 - 2nd transition state for epsilons
  -- accptnum - accepting number
  -- assoc_rule - rule associated with this NFA state (or 0 if none)
  -- state_type - a STATE_xxx type identifying whether the state is part
  --              of a normal rule, the leading state in a trailing context
  --              rule (i.e., the state which marks the transition from
  --              recognizing the text-to-be-matched to the beginning of
  --              the trailing context), or a subsequent state in a trailing
  --              context rule
  -- rule_type - a RULE_xxx type identifying whether this a a ho-hum
  --             normal rule or one which has variable head & trailing
  --             context
  -- rule_linenum - line number associated with rule

  CURRENT_MNS, NUM_RULES, CURRENT_MAX_RULES, LASTNFA : INTEGER;
  FIRSTST, LASTST, FINALST, TRANSCHAR, TRANS1, TRANS2 : INT_PTR;
  ACCPTNUM, ASSOC_RULE, RULE_LINENUM : INT_PTR;
  RULE_TYPE : RULE_ENUM_PTR;
  STATE_TYPE : STATE_ENUM_PTR;

  -- global holding current type of state we're making

  CURRENT_STATE_ENUM : STATE_ENUM;

  -- true if the input rules include a rule with both variable-length head
  -- and trailing context, false otherwise

  VARIABLE_TRAILING_CONTEXT_RULES : BOOLEAN;


  -- variables for protos:
  -- numtemps - number of templates created
  -- numprots - number of protos created
  -- protprev - backlink to a more-recently used proto
  -- protnext - forward link to a less-recently used proto
  -- prottbl - base/def table entry for proto
  -- protcomst - common state of proto
  -- firstprot - number of the most recently used proto
  -- lastprot - number of the least recently used proto
  -- protsave contains the entire state array for protos

  NUMTEMPS, NUMPROTS, FIRSTPROT, LASTPROT : INTEGER;
  PROTPREV, PROTNEXT, PROTTBL, PROTCOMST : array (0 .. MSP - 1) of INTEGER;
  PROTSAVE : array (0 .. PROT_SAVE_SIZE - 1) of INTEGER;


  -- variables for managing equivalence classes:
  -- numecs - number of equivalence classes
  -- nextecm - forward link of Equivalence Class members
  -- ecgroup - class number or backward link of EC members
  -- nummecs - number of meta-equivalence classes (used to compress
  --   templates)
  -- tecfwd - forward link of meta-equivalence classes members
  -- * tecbck - backward link of MEC's

  NUMECS, NUMMECS : INTEGER;
  subtype C_SIZE_ARRAY is UNBOUNDED_INT_ARRAY (0 .. CSIZE);
  type C_SIZE_BOOL_ARRAY is array (0 .. CSIZE) of BOOLEAN;
  NEXTECM, ECGROUP, TECFWD, TECBCK : C_SIZE_ARRAY;


  -- variables for start conditions:
  -- lastsc - last start condition created
  -- current_max_scs - current limit on number of start conditions
  -- scset - set of rules active in start condition
  -- scbol - set of rules active only at the beginning of line in a s.c.
  -- scxclu - true if start condition is exclusive
  -- sceof - true if start condition has EOF rule
  -- scname - start condition name
  -- actvsc - stack of active start conditions for the current rule

  LASTSC, CURRENT_MAX_SCS : INTEGER;
  SCSET, SCBOL : INT_PTR;
  SCXCLU, SCEOF : BOOLEAN_PTR;
  ACTVSC : INT_PTR;
  SCNAME : VSTRING_PTR;


  -- variables for dfa machine data:
  -- current_max_dfa_size - current maximum number of NFA states in DFA
  -- current_max_xpairs - current maximum number of non-template xtion pairs
  -- current_max_template_xpairs - current maximum number of template pairs
  -- current_max_dfas - current maximum number DFA states
  -- lastdfa - last dfa state number created
  -- nxt - state to enter upon reading character
  -- chk - check value to see if "nxt" applies
  -- tnxt - internal nxt table for templates
  -- base - offset into "nxt" for given state
  -- def - where to go if "chk" disallows "nxt" entry
  -- tblend - last "nxt/chk" table entry being used
  -- firstfree - first empty entry in "nxt/chk" table
  -- dss - nfa state set for each dfa
  -- dfasiz - size of nfa state set for each dfa
  -- dfaacc - accepting set for each dfa state (or accepting number, if
  --    -r is not given)
  -- accsiz - size of accepting set for each dfa state
  -- dhash - dfa state hash value
  -- numas - number of DFA accepting states created; note that this
  --    is not necessarily the same value as num_rules, which is the analogous
  --    value for the NFA
  -- numsnpairs - number of state/nextstate transition pairs
  -- jambase - position in base/def where the default jam table starts
  -- jamstate - state number corresponding to "jam" state
  -- end_of_buffer_state - end-of-buffer dfa state number

  CURRENT_MAX_DFA_SIZE, CURRENT_MAX_XPAIRS : INTEGER;
  CURRENT_MAX_TEMPLATE_XPAIRS, CURRENT_MAX_DFAS : INTEGER;
  LASTDFA, LASTTEMP : INTEGER;
  NXT, CHK, TNXT : INT_PTR;
  BASE, DEF , DFASIZ : INT_PTR;
  TBLEND, FIRSTFREE : INTEGER;
  DSS : INT_STAR_PTR;
  DFAACC : DFAACC_PTR;

  -- type declaration for dfaacc_type moved above

  ACCSIZ, DHASH : INT_PTR;
  END_OF_BUFFER_STATE, NUMSNPAIRS, JAMBASE, JAMSTATE, NUMAS : INTEGER;

  -- variables for ccl information:
  -- lastccl - ccl index of the last created ccl
  -- current_maxccls - current limit on the maximum number of unique ccl's
  -- cclmap - maps a ccl index to its set pointer
  -- ccllen - gives the length of a ccl
  -- cclng - true for a given ccl if the ccl is negated
  -- cclreuse - counts how many times a ccl is re-used
  -- current_max_ccl_tbl_size - current limit on number of characters needed
  --	to represent the unique ccl's
  -- ccltbl - holds the characters in each ccl - indexed by cclmap

  CURRENT_MAX_CCL_TBL_SIZE, LASTCCL, CURRENT_MAXCCLS, CCLREUSE : INTEGER;
  CCLMAP, CCLLEN, CCLNG : INT_PTR;

  CCLTBL : CHAR_PTR;


  -- variables for miscellaneous information:
  -- starttime - real-time when we started
  -- endtime - real-time when we ended
  -- nmstr - last NAME scanned by the scanner
  -- sectnum - section number currently being parsed
  -- nummt - number of empty nxt/chk table entries
  -- hshcol - number of hash collisions detected by snstods
  -- dfaeql - number of times a newly created dfa was equal to an old one
  -- numeps - number of epsilon NFA states created
  -- eps2 - number of epsilon states which have 2 out-transitions
  -- num_reallocs - number of times it was necessary to realloc() a group
  --		  of arrays
  -- tmpuses - number of DFA states that chain to templates
  -- totnst - total number of NFA states used to make DFA states
  -- peakpairs - peak number of transition pairs we had to store internally
  -- numuniq - number of unique transitions
  -- numdup - number of duplicate transitions
  -- hshsave - number of hash collisions saved by checking number of states
  -- num_backtracking - number of DFA states requiring back-tracking
  -- bol_needed - whether scanner needs beginning-of-line recognition

  NMSTR : VSTRING;
  SECTNUM, NUMMT, HSHCOL, DFAEQL, NUMEPS, EPS2, NUM_REALLOCS : INTEGER;
  TMPUSES, TOTNST, PEAKPAIRS, NUMUNIQ, NUMDUP, HSHSAVE : INTEGER;
  NUM_BACKTRACKING : INTEGER;
  BOL_NEEDED : BOOLEAN;

  function ALLOCATE_INTEGER_ARRAY (SIZE : in INTEGER) return INT_PTR;

  function ALLOCATE_INT_PTR_ARRAY (SIZE : in INTEGER) return INT_STAR_PTR;



  function ALLOCATE_VSTRING_ARRAY (SIZE : in INTEGER) return VSTRING_PTR;

  function ALLOCATE_DFAACC_UNION (SIZE : in INTEGER) return DFAACC_PTR;

  function  ALLOCATE_CHARACTER_ARRAY (SIZE : in INTEGER) return CHAR_PTR;

  function ALLOCATE_RULE_ENUM_ARRAY (SIZE : in INTEGER) return RULE_ENUM_PTR;

  function ALLOCATE_STATE_ENUM_ARRAY (SIZE : in INTEGER) return STATE_ENUM_PTR;

  function ALLOCATE_BOOLEAN_ARRAY (SIZE : in INTEGER) return BOOLEAN_PTR;

  procedure REALLOCATE_INTEGER_ARRAY (ARR : in out INT_PTR;
       SIZE : in INTEGER);

  procedure REALLOCATE_INT_PTR_ARRAY (ARR : in out INT_STAR_PTR;
       SIZE : in INTEGER);

  procedure REALLOCATE_VSTRING_ARRAY (ARR : in out VSTRING_PTR;
        SIZE : in INTEGER);

  procedure REALLOCATE_DFAACC_UNION (ARR : in out DFAACC_PTR;
      SIZE : in INTEGER);

  procedure REALLOCATE_CHARACTER_ARRAY (ARR : in out CHAR_PTR;
       SIZE : in INTEGER);

  procedure REALLOCATE_RULE_ENUM_ARRAY (ARR : in out RULE_ENUM_PTR;
       SIZE : in INTEGER);

  procedure REALLOCATE_STATE_ENUM_ARRAY (ARR : in out STATE_ENUM_PTR;
       SIZE : in INTEGER);

  procedure REALLOCATE_BOOLEAN_ARRAY (ARR : in out BOOLEAN_PTR;
       SIZE : in INTEGER);

end MISC_DEFS;