|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 22528 (0x5800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Template_Manager, seg_030ab3
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with File_String, Misc_Defs, Text_Io, External_File_Manager, Misc, Tstring;
use File_String, Misc_Defs, Text_Io;
package body Template_Manager is
type File_Array is array (Positive range <>) of Vstring;
Dfa_Template : File_Array (1 .. 66) :=
(
--DFA TEMPLATE START
Vstr ("yytext_ptr : integer; -- points to start of yytext in buffer"),
Vstr (""),
Vstr
("-- yy_ch_buf has to be 2 characters longer than YY_BUF_SIZE because we need"),
Vstr
("-- to put in 2 end-of-buffer characters (this is explained where it is"),
Vstr ("-- done) at the end of yy_ch_buf"),
Vstr ("YY_READ_BUF_SIZE : constant integer := 8192;"),
Vstr
("YY_BUF_SIZE : constant integer := YY_READ_BUF_SIZE * 2; -- size of input buffer"),
Vstr
("type unbounded_character_array is array(integer range <>) of character;"),
Vstr
("subtype ch_buf_type is unbounded_character_array(0..YY_BUF_SIZE + 1);"),
Vstr ("yy_ch_buf : ch_buf_type;"),
Vstr ("yy_cp, yy_bp : integer;"), Vstr (""),
Vstr ("-- yy_hold_char holds the character lost when yytext is formed"),
Vstr ("yy_hold_char : character;"),
Vstr
("yy_c_buf_p : integer; -- points to current character in buffer"),
Vstr (""), Vstr ("function YYText return string;"),
Vstr ("function YYLength return integer;"),
Vstr ("procedure YY_DO_BEFORE_ACTION;"),
Vstr ("--These variables are needed between calls to YYLex."),
Vstr ("yy_init : boolean := true; -- do we need to initialize YYLex?"),
Vstr ("yy_start : integer := 0; -- current start state number"),
Vstr ("subtype yy_state_type is integer;"),
Vstr ("yy_last_accepting_state : yy_state_type;"),
Vstr ("yy_last_accepting_cpos : integer;"), Vstr ("%%"),
Vstr ("function YYText return string is"),
Vstr (" i : integer;"), Vstr (" str_loc : integer := 1;"),
Vstr (" buffer : string(1..1024);"),
Vstr (" EMPTY_STRING : constant string := """";"), Vstr ("begin"),
Vstr (" -- find end of buffer"), Vstr (" i := yytext_ptr;"),
Vstr (" while ( yy_ch_buf(i) /= ASCII.NUL ) loop"),
Vstr (" buffer(str_loc ) := yy_ch_buf(i);"),
Vstr (" i := i + 1;"),
Vstr (" str_loc := str_loc + 1;"), Vstr (" end loop;"),
Vstr ("-- return yy_ch_buf(yytext_ptr.. i - 1);"), Vstr (""),
Vstr (" if (str_loc < 2) then"),
Vstr (" return EMPTY_STRING;"), Vstr (" else"),
Vstr (" return buffer(1..str_loc-1);"), Vstr (" end if;"),
Vstr (""), Vstr ("end;"), Vstr (""),
Vstr ("-- returns the length of the matched text"),
Vstr ("function YYLength return integer is"), Vstr ("begin"),
Vstr (" return yy_cp - yy_bp;"),
Vstr ("end YYLength;"), Vstr (""),
Vstr
("-- done after the current pattern has been matched and before the"),
Vstr ("-- corresponding action - sets up yytext"),
Vstr (""), Vstr ("procedure YY_DO_BEFORE_ACTION is"),
Vstr ("begin"), Vstr (" yytext_ptr := yy_bp;"),
Vstr (" yy_hold_char := yy_ch_buf(yy_cp);"),
Vstr (" yy_ch_buf(yy_cp) := ASCII.NUL;"),
Vstr (" yy_c_buf_p := yy_cp;"),
Vstr ("end YY_DO_BEFORE_ACTION;"), Vstr ("")
--DFA TEMPLATE END
);
Dfa_Current_Line : Integer := 1;
Io_Template : File_Array (1 .. 264) :=
(
--IO TEMPLATE START
Vstr ("with text_io; use text_io;"), Vstr (""),
Vstr ("%%"), Vstr ("NULL_IN_INPUT : exception;"),
Vstr ("AFLEX_INTERNAL_ERROR : exception;"),
Vstr ("UNEXPECTED_LAST_MATCH : exception;"),
Vstr ("PUSHBACK_OVERFLOW : exception;"),
Vstr ("AFLEX_SCANNER_JAMMED : exception;"),
Vstr ("type eob_action_type is ( EOB_ACT_RESTART_SCAN,"),
Vstr (" EOB_ACT_END_OF_FILE,"),
Vstr (" EOB_ACT_LAST_MATCH );"),
Vstr ("YY_END_OF_BUFFER_CHAR : constant character:= ASCII.NUL;"),
Vstr
("yy_n_chars : integer; -- number of characters read into yy_ch_buf"),
Vstr (""),
Vstr ("-- true when we've seen an EOF for the current input file"),
Vstr ("yy_eof_has_been_seen : boolean;"),
Vstr (""),
Vstr
("procedure YY_INPUT(buf: out unbounded_character_array; result: out integer; max_size: in integer);"),
Vstr ("function yy_get_next_buffer return eob_action_type;"),
Vstr ("procedure yyunput( c : character; yy_bp: in out integer );"),
Vstr ("procedure unput(c : character);"),
Vstr ("function input return character;"),
Vstr ("procedure output(c : character);"),
Vstr ("function yywrap return boolean;"),
Vstr ("procedure Open_Input(fname : in String);"),
Vstr ("procedure Close_Input;"),
Vstr ("procedure Create_Output(fname : in String := """");"),
Vstr ("procedure Close_Output;"), Vstr ("%%"),
Vstr
("-- gets input and stuffs it into 'buf'. number of characters read, or YY_NULL,"),
Vstr ("-- is returned in 'result'."), Vstr (""),
Vstr
("procedure YY_INPUT(buf: out unbounded_character_array; result: out integer; max_size: in integer) is"),
Vstr (" c : character;"), Vstr (" i : integer := 1;"),
Vstr (" loc : integer := buf'first;"), Vstr ("begin"),
Vstr (" while ( i <= max_size ) loop"),
Vstr
(" if (end_of_line) then -- Ada ate our newline, put it back on the end."),
Vstr (" buf(loc) := ASCII.LF;"),
Vstr (" skip_line(1);"), Vstr ("%%"), Vstr (" else"),
Vstr (" get(buf(loc));"), Vstr (" end if; "),
Vstr (" "), Vstr (" loc := loc + 1;"),
Vstr (" i := i + 1;"), Vstr (" end loop;"), Vstr (" "),
Vstr (" result := i - 1; "), Vstr (" exception"),
Vstr (" when END_ERROR => result := i - 1;"),
Vstr (" -- when we hit EOF we need to set yy_eof_has_been_seen"),
Vstr (" yy_eof_has_been_seen := true;"), Vstr ("end YY_INPUT;"),
Vstr (""), Vstr ("-- yy_get_next_buffer - try to read in new buffer"),
Vstr ("--"), Vstr ("-- returns a code representing an action"),
Vstr ("-- EOB_ACT_LAST_MATCH - "),
Vstr ("-- EOB_ACT_RESTART_SCAN - restart the scanner"),
Vstr ("-- EOB_ACT_END_OF_FILE - end of file"), Vstr (""),
Vstr ("function yy_get_next_buffer return eob_action_type is"),
Vstr (" dest : integer := 0;"),
Vstr
(" source : integer := yytext_ptr - 1; -- copy prev. char, too"),
Vstr (" number_to_move : integer;"),
Vstr (" ret_val : eob_action_type;"),
Vstr (" num_to_read : integer;"), Vstr ("begin "),
Vstr (" if ( yy_c_buf_p > yy_n_chars + 1 ) then"),
Vstr (" raise NULL_IN_INPUT;"), Vstr (" end if;"), Vstr (""),
Vstr (" -- try to read more data"), Vstr (""),
Vstr (" -- first move last chars to start of buffer"),
Vstr (" number_to_move := yy_c_buf_p - yytext_ptr;"), Vstr (""),
Vstr (" for i in 0..number_to_move - 1 loop"),
Vstr (" yy_ch_buf(dest) := yy_ch_buf(source);"),
Vstr (" dest := dest + 1;"), Vstr (" source := source + 1;"),
Vstr (" end loop;"), Vstr (" "),
Vstr (" if ( yy_eof_has_been_seen ) then"),
Vstr
(" -- don't do the read, it's not guaranteed to return an EOF,"),
Vstr (" -- just force an EOF"), Vstr (""),
Vstr (" yy_n_chars := 0;"), Vstr (" else"),
Vstr (" num_to_read := YY_BUF_SIZE - number_to_move - 1;"),
Vstr (""), Vstr (" if ( num_to_read > YY_READ_BUF_SIZE ) then"),
Vstr (" num_to_read := YY_READ_BUF_SIZE;"),
Vstr (" end if;"), Vstr (""),
Vstr (" -- read in more data"),
Vstr
(" YY_INPUT( yy_ch_buf(number_to_move..yy_ch_buf'last), yy_n_chars, num_to_read );"),
Vstr (" end if;"), Vstr (" if ( yy_n_chars = 0 ) then"),
Vstr (" if ( number_to_move = 1 ) then"),
Vstr (" ret_val := EOB_ACT_END_OF_FILE;"), Vstr (" else"),
Vstr (" ret_val := EOB_ACT_LAST_MATCH;"),
Vstr (" end if;"), Vstr (""),
Vstr (" yy_eof_has_been_seen := true;"), Vstr (" else"),
Vstr (" ret_val := EOB_ACT_RESTART_SCAN;"),
Vstr (" end if;"), Vstr (" "),
Vstr (" yy_n_chars := yy_n_chars + number_to_move;"),
Vstr (" yy_ch_buf(yy_n_chars) := YY_END_OF_BUFFER_CHAR;"),
Vstr (" yy_ch_buf(yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;"),
Vstr (""), Vstr (" -- yytext begins at the second character in"),
Vstr (" -- yy_ch_buf; the first character is the one which"),
Vstr (" -- preceded it before reading in the latest buffer;"),
Vstr (" -- it needs to be kept around in case it's a"),
Vstr (" -- newline, so yy_get_previous_state() will have"),
Vstr (" -- with '^' rules active"),
Vstr (""), Vstr (" yytext_ptr := 1;"),
Vstr (""), Vstr (" return ret_val;"),
Vstr ("end yy_get_next_buffer;"), Vstr (""),
Vstr ("procedure yyunput( c : character; yy_bp: in out integer ) is"),
Vstr (" number_to_move : integer;"),
Vstr (" dest : integer;"), Vstr (" source : integer;"),
Vstr (" tmp_yy_cp : integer;"), Vstr ("begin"),
Vstr (" tmp_yy_cp := yy_c_buf_p;"),
Vstr
(" yy_ch_buf(tmp_yy_cp) := yy_hold_char; -- undo effects of setting up yytext"),
Vstr (""), Vstr (" if ( tmp_yy_cp < 2 ) then"),
Vstr (" -- need to shift things up to make room"),
Vstr (" number_to_move := yy_n_chars + 2; -- +2 for EOB chars"),
Vstr (" dest := YY_BUF_SIZE + 2;"),
Vstr (" source := number_to_move;"), Vstr (""),
Vstr (" while ( source > 0 ) loop"),
Vstr (" dest := dest - 1;"),
Vstr (" source := source - 1;"),
Vstr (" yy_ch_buf(dest) := yy_ch_buf(source);"),
Vstr (" end loop;"), Vstr (""),
Vstr (" tmp_yy_cp := tmp_yy_cp + dest - source;"),
Vstr (" yy_bp := yy_bp + dest - source;"),
Vstr (" yy_n_chars := YY_BUF_SIZE;"), Vstr (""),
Vstr (" if ( tmp_yy_cp < 2 ) then"),
Vstr (" raise PUSHBACK_OVERFLOW;"),
Vstr (" end if;"), Vstr (" end if;"), Vstr (""),
Vstr
(" if ( tmp_yy_cp > yy_bp and then yy_ch_buf(tmp_yy_cp-1) = ASCII.LF ) then"),
Vstr (" yy_ch_buf(tmp_yy_cp-2) := ASCII.LF;"), Vstr (" end if;"),
Vstr (""), Vstr (" tmp_yy_cp := tmp_yy_cp - 1;"),
Vstr (" yy_ch_buf(tmp_yy_cp) := c;"), Vstr (""),
Vstr ("-- Note: this code is the text of YY_DO_BEFORE_ACTION, only"),
Vstr ("-- here we get different yy_cp and yy_bp's"),
Vstr (" yytext_ptr := yy_bp;"),
Vstr (" yy_hold_char := yy_ch_buf(tmp_yy_cp);"),
Vstr (" yy_ch_buf(tmp_yy_cp) := ASCII.NUL;"),
Vstr (" yy_c_buf_p := tmp_yy_cp;"), Vstr ("end yyunput;"), Vstr (""),
Vstr ("procedure unput(c : character) is"), Vstr ("begin"),
Vstr (" yyunput( c, yy_bp );"), Vstr ("end unput;"), Vstr (""),
Vstr ("function input return character is"),
Vstr (" c : character;"),
Vstr (" yy_cp : integer := yy_c_buf_p;"), Vstr ("begin"),
Vstr (" yy_ch_buf(yy_cp) := yy_hold_char;"), Vstr (""),
Vstr (" if ( yy_ch_buf(yy_c_buf_p) = YY_END_OF_BUFFER_CHAR ) then"),
Vstr (" -- need more input"),
Vstr (" yytext_ptr := yy_c_buf_p;"),
Vstr (" yy_c_buf_p := yy_c_buf_p + 1;"), Vstr (""),
Vstr (" case yy_get_next_buffer is"),
Vstr
(" -- this code, unfortunately, is somewhat redundant with"),
Vstr (" -- that above"), Vstr (""),
Vstr (" when EOB_ACT_END_OF_FILE =>"),
Vstr (" if ( yywrap ) then"),
Vstr (" yy_c_buf_p := yytext_ptr;"),
Vstr (" return ASCII.NUL;"),
Vstr (" end if;"), Vstr (""),
Vstr (" yy_ch_buf(0) := ASCII.LF;"),
Vstr (" yy_n_chars := 1;"),
Vstr (" yy_ch_buf(yy_n_chars) := YY_END_OF_BUFFER_CHAR;"),
Vstr (" yy_ch_buf(yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;"),
Vstr (" yy_eof_has_been_seen := false;"),
Vstr (" yy_c_buf_p := 1;"),
Vstr (" yytext_ptr := yy_c_buf_p;"),
Vstr (" yy_hold_char := yy_ch_buf(yy_c_buf_p);"), Vstr (""),
Vstr (" return ( input );"),
Vstr (" when EOB_ACT_RESTART_SCAN =>"),
Vstr (" yy_c_buf_p := yytext_ptr;"), Vstr (""),
Vstr (" when EOB_ACT_LAST_MATCH =>"),
Vstr (" raise UNEXPECTED_LAST_MATCH;"),
Vstr (" when others => null;"), Vstr (" end case;"),
Vstr (" end if;"), Vstr (""),
Vstr (" c := yy_ch_buf(yy_c_buf_p);"),
Vstr (" yy_c_buf_p := yy_c_buf_p + 1;"),
Vstr (" yy_hold_char := yy_ch_buf(yy_c_buf_p);"),
Vstr (""), Vstr (" return c;"),
Vstr ("end input;"), Vstr (""),
Vstr ("procedure output(c : character) is"), Vstr ("begin"),
Vstr (" text_io.put(c);"),
Vstr ("end output;"), Vstr (""),
Vstr ("-- default yywrap function - always treat EOF as an EOF"),
Vstr ("function yywrap return boolean is"),
Vstr ("begin"), Vstr (" return true;"),
Vstr ("end yywrap;"), Vstr (""),
Vstr ("procedure Open_Input(fname : in String) is"),
Vstr (" f : file_type;"), Vstr ("begin"),
Vstr (" yy_init := true;"),
Vstr (" open(f, in_file, fname);"), Vstr (" set_input(f);"),
Vstr ("end Open_Input;"), Vstr (""),
Vstr ("procedure Create_Output(fname : in String := """") is"),
Vstr (" f : file_type;"), Vstr ("begin"),
Vstr (" if (fname /= """") then"),
Vstr (" create(f, out_file, fname);"),
Vstr (" set_output(f);"), Vstr (" end if;"),
Vstr ("end Create_Output;"), Vstr (""),
Vstr ("procedure Close_Input is"),
Vstr ("begin"), Vstr (" null;"),
Vstr ("end Close_Input;"), Vstr (""),
Vstr ("procedure Close_Output is"),
Vstr ("begin"), Vstr (" null;"),
Vstr ("end Close_Output;"), Vstr ("")
--IO TEMPLATE END
);
Io_Current_Line : Integer := 1;
procedure Template_Out (Outfile : in File_Type;
Current_Template : in File_Array;
Line_Number : in out Integer) is
Buf : Vstring;
begin
while (not (Line_Number > Current_Template'Last)) loop
Buf := Current_Template (Line_Number);
Line_Number := Line_Number + 1;
if ((File_String.Len (Buf) >= 2) and then
((Char (Buf, 1) = '%') and (Char (Buf, 2) = '%'))) then
exit;
else
File_String.Put_Line (Outfile, Buf);
end if;
end loop;
end Template_Out;
procedure Generate_Dfa_File is
Dfa_Out_File : File_Type;
begin
External_File_Manager.Get_Dfa_File (Dfa_Out_File);
Text_Io.Put_Line
(Dfa_Out_File, "package " & Tstring.Str (Misc.Basename) &
"_dfa" & " is");
if (Ddebug) then
-- make a scanner that output acceptance information
Text_Io.Put_Line (Dfa_Out_File, "aflex_debug : boolean := true;");
else
Text_Io.Put_Line (Dfa_Out_File, "aflex_debug : boolean := false;");
end if;
Template_Out (Dfa_Out_File, Dfa_Template, Dfa_Current_Line);
Text_Io.Put_Line (Dfa_Out_File,
"end " & Tstring.Str (Misc.Basename) & "_dfa;");
Text_Io.New_Line (Dfa_Out_File);
Text_Io.Put (Dfa_Out_File,
"with " & Tstring.Str (Misc.Basename) & "_dfa" & "; ");
Text_Io.Put_Line (Dfa_Out_File,
"use " & Tstring.Str (Misc.Basename) & "_dfa" & "; ");
Text_Io.Put_Line
(Dfa_Out_File, "package body " & Tstring.Str (Misc.Basename) &
"_dfa" & " is");
Template_Out (Dfa_Out_File, Dfa_Template, Dfa_Current_Line);
Text_Io.Put_Line (Dfa_Out_File,
"end " & Tstring.Str (Misc.Basename) & "_dfa;");
end Generate_Dfa_File;
procedure Generate_Io_File is
Io_Out_File : File_Type;
begin
External_File_Manager.Get_Io_File (Io_Out_File);
Text_Io.Put (Io_Out_File,
"with " & Tstring.Str (Misc.Basename) & "_dfa" & "; ");
Text_Io.Put_Line (Io_Out_File,
"use " & Tstring.Str (Misc.Basename) & "_dfa" & "; ");
Template_Out (Io_Out_File, Io_Template, Io_Current_Line);
Text_Io.Put_Line
(Io_Out_File, "package " & Tstring.Str (Misc.Basename) &
"_io" & " is");
Template_Out (Io_Out_File, Io_Template, Io_Current_Line);
Text_Io.Put_Line (Io_Out_File,
"end " & Tstring.Str (Misc.Basename) & "_io;");
Text_Io.New_Line (Io_Out_File);
Text_Io.Put_Line
(Io_Out_File, "package body " & Tstring.Str (Misc.Basename) &
"_io" & " is");
Template_Out (Io_Out_File, Io_Template, Io_Current_Line);
-- If we're generating a scanner for interactive mode we need to generate
-- a YY_INPUT that stops at the end of each line
if Interactive then
Text_Io.Put_Line
(Io_Out_File,
" i := i + 1; -- update counter, miss end of loop");
Text_Io.Put_Line
(Io_Out_File,
" exit; -- in interactive mode return at end of line.");
end if;
Template_Out (Io_Out_File, Io_Template, Io_Current_Line);
Text_Io.Put_Line (Io_Out_File,
"end " & Tstring.Str (Misc.Basename) & "_io;");
end Generate_Io_File;
end Template_Manager;
-- 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 template manager
-- AUTHOR: John Self (UCI)
-- DESCRIPTION supports output of internalized templates for the IO and DFA
-- packages.
-- NOTES This package is quite a memory hog, and is really only useful on
-- virtual memory systems. It could use an external file to store the
-- templates like the skeleton manager. This would save memory at the
-- cost of a slight reduction in speed and the necessity of keeping
-- copies of the template files in a known place.
-- $Header: /co/ua/self/arcadia/aflex/ada/src/RCS/template_managerS.a,v 1.3 90/01/12 15:20:49 self Exp Locker: self $
nblk1=15
nid=0
hdr6=2a
[0x00] rec0=18 rec1=00 rec2=01 rec3=04e
[0x01] rec0=11 rec1=00 rec2=02 rec3=012
[0x02] rec0=10 rec1=00 rec2=03 rec3=020
[0x03] rec0=17 rec1=00 rec2=04 rec3=05e
[0x04] rec0=12 rec1=00 rec2=05 rec3=016
[0x05] rec0=11 rec1=00 rec2=06 rec3=004
[0x06] rec0=0f rec1=00 rec2=07 rec3=062
[0x07] rec0=10 rec1=00 rec2=08 rec3=06a
[0x08] rec0=11 rec1=00 rec2=09 rec3=05c
[0x09] rec0=10 rec1=00 rec2=0a rec3=00a
[0x0a] rec0=12 rec1=00 rec2=0b rec3=004
[0x0b] rec0=0f rec1=00 rec2=0c rec3=040
[0x0c] rec0=12 rec1=00 rec2=0d rec3=090
[0x0d] rec0=12 rec1=00 rec2=0e rec3=052
[0x0e] rec0=13 rec1=00 rec2=0f rec3=004
[0x0f] rec0=1b rec1=00 rec2=10 rec3=03a
[0x10] rec0=16 rec1=00 rec2=11 rec3=086
[0x11] rec0=15 rec1=00 rec2=12 rec3=048
[0x12] rec0=14 rec1=00 rec2=13 rec3=020
[0x13] rec0=14 rec1=00 rec2=14 rec3=01e
[0x14] rec0=0d rec1=00 rec2=15 rec3=000
tail 0x2172a412c84a64eb2c53e 0x42a00088462060003