DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦82fc99f39⟧ Ada Source

    Length: 26624 (0x6800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Main_Body, seg_030b33

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

E3 Source Code



with Misc_Defs, Misc, Command_Line_Interface, Dfa, Ecs, Gen, Text_Io, Parser;
with Main_Body, Tstring, Parse_Tokens, Skeleton_Manager, External_File_Manager;
with External_File_Manager, Int_Io;
use Misc_Defs, Command_Line_Interface, Tstring, External_File_Manager;

package body Main_Body is
    Outfile_Created : Boolean := False;
    Aflex_Version : constant String := "1.1d";
    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 (Backtrack_Report : Boolean := False;
                         Ddebug : Boolean := False;
                         Useecs : Boolean := True;
                         Usemecs : Boolean := True;
                         Fulltbl : Boolean := False;
                         Interactive : Boolean := False;
                         Caseins : Boolean := False;
                         Gen_Line_Dirs : Boolean := True;
                         Performance_Report : Boolean := False;
                         Spprdflt : Boolean := False;
                         Use_Stdout : Boolean := False;
                         Trace : Boolean := False;
                         Printstats : Boolean := False) 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
        Syntaxerror := False;
        Continued_Action := False;

        Sawcmpflag := False;

        -- read flags
        Command_Line_Interface.Initialize_Command_Line;

        -- load up argv
        External_File_Manager.Initialize_Files;

        -- do external files setup


        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;

        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;
-- 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: /co/ua/self/arcadia/aflex/ada/src/RCS/mainS.a,v 1.5 90/01/12 15:20:14 self Exp Locker: self $

-- aflex - tool to generate fast lexical analyzers

E3 Meta Data

    nblk1=19
    nid=a
    hdr6=28
        [0x00] rec0=21 rec1=00 rec2=01 rec3=03c
        [0x01] rec0=1a rec1=00 rec2=15 rec3=088
        [0x02] rec0=16 rec1=00 rec2=12 rec3=054
        [0x03] rec0=17 rec1=00 rec2=11 rec3=010
        [0x04] rec0=13 rec1=00 rec2=10 rec3=04a
        [0x05] rec0=15 rec1=00 rec2=0f rec3=016
        [0x06] rec0=13 rec1=00 rec2=0e rec3=05a
        [0x07] rec0=11 rec1=00 rec2=0d rec3=06a
        [0x08] rec0=18 rec1=00 rec2=17 rec3=046
        [0x09] rec0=18 rec1=00 rec2=0b rec3=038
        [0x0a] rec0=1a rec1=00 rec2=18 rec3=004
        [0x0b] rec0=1e rec1=00 rec2=0c rec3=044
        [0x0c] rec0=22 rec1=00 rec2=09 rec3=00a
        [0x0d] rec0=25 rec1=00 rec2=08 rec3=072
        [0x0e] rec0=21 rec1=00 rec2=07 rec3=088
        [0x0f] rec0=1b rec1=00 rec2=06 rec3=018
        [0x10] rec0=14 rec1=00 rec2=05 rec3=00a
        [0x11] rec0=15 rec1=00 rec2=04 rec3=020
        [0x12] rec0=13 rec1=00 rec2=03 rec3=056
        [0x13] rec0=0b rec1=00 rec2=14 rec3=000
        [0x14] rec0=03 rec1=00 rec2=03 rec3=046
        [0x15] rec0=15 rec1=00 rec2=14 rec3=020
        [0x16] rec0=06 rec1=00 rec2=13 rec3=000
        [0x17] rec0=00 rec1=00 rec2=00 rec3=000
        [0x18] rec0=00 rec1=00 rec2=00 rec3=000
    tail 0x21529835684a6577e42b1 0x42a00088462060003
Free Block Chain:
  0xa: 0000  00 16 00 14 80 11 68 65 6e 20 4e 61 6d 65 5f 45  ┆      hen Name_E┆
  0x16: 0000  00 13 03 fc 80 11 20 20 20 20 20 20 77 68 65 6e  ┆            when┆
  0x13: 0000  00 02 03 fc 00 0f 20 20 20 20 20 20 20 20 65 6e  ┆              en┆
  0x2: 0000  00 19 03 fc 00 0f 20 20 20 20 20 20 20 20 65 6e  ┆              en┆
  0x19: 0000  00 00 00 04 80 01 20 01 e0 80 25 7e 7c 00 00 00  ┆          %~|   ┆