# This is a shell archive. Remove anything before this line, # then unpack it by saving it in a file and typing "sh file". # # Wrapped by eve!rshock on Mon Jan 29 06:50:53 EST 1990 # Contents: README.vhdl_tools code.shar shell_scripts.shar text_files.shar echo x - README.vhdl_tools sed 's/^@//' > "README.vhdl_tools" <<'@//E*O*F README.vhdl_tools//' There are three shar files: 1) text_files.shar the unix command sh text_files.shar separates this file into these text files installation.guide : read this guide first help.guide postscript_header.file user.guide 2) code.shar This shar file contains the ada source code and instructions to create executable images that will be used in the shell scripts 3) shell_scripts.shar This shar file contains the code (commands) of the shell scripts * The unix command sh X.shar separates X.shar into the required files. @//E*O*F README.vhdl_tools// chmod u=rw,g=,o= README.vhdl_tools echo x - code.shar sed 's/^@//' > "code.shar" <<'@//E*O*F code.shar//' # This is a shell archive. Remove anything before this line, # then unpack it by saving it in a file and typing "sh file". # # Wrapped by eve!rshock on Mon Jan 29 03:07:46 EST 1990 # Contents: COMPILE_ORDER.VHDL_TOOLS io_unit_.a io_unit__.a # transliterate_gn__.a vhdl_build_.a vhdl_build__.a # vhdl_letter_set_style.a vhdl_lexicon_.a vhdl_lexicon__.a # vhdl_lexicon_letter_style__.a vhdl_lexicon_scroll_style__.a # vhdl_lexicon_shape_style_.a vhdl_lexicon_shape_style__.a # vhdl_lexicon_type_style__.a vhdl_name_.a vhdl_name__.a # vhdl_scroll_set_style.a vhdl_separate_shape_style_.a # vhdl_shape_set_style.a vhdl_shape_type_standard.a vhdl_type_set_style.a echo x - COMPILE_ORDER.VHDL_TOOLS sed 's/^@//' > "COMPILE_ORDER.VHDL_TOOLS" <<'@//E*O*F COMPILE_ORDER.VHDL_TOOLS//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- TOPIC: Compilation order Notation: xxxx_.a package specification xxxx__.a package body or package specification + package body xxxx.a procedure UNIT: lexicon -- compile units IN ORDER io_unit_.a io_unit__.a transliterate_gn__.a -- compile these IN ORDER vhdl_lexicon_.a vhdl_name_.a vhdl_name_.a vhdl_build_.a vhdl_build_.a vhdl_lexicon__.a COMPILATION UNITS: letter_style, type_style, shape_style, scroll_style UNIT: letter_style -- Compile in order vhdl_lexicon_letter_style__.a -- compile in any order ( procedure ) vhdl_letter_set_style.a ( image is: vhdl_letter_set_style.e ) UNIT: shape_style -- Compile in order vhdl_lexicon_shape_style_.a vhdl_lexicon_shape_style__.a vhdl_separate_shape_style__.a -- Compile in any order ( procedures ) vhdl_shape_set_style.a ( image is: vhdl_shape_set_style.e ) UNIT: type_style -- Compile in order vhdl_lexicon_type_style__.a -- Compile in any order ( procedures ) vhdl_type_set_style.a ( image is: vhdl_type_set_style.e ) UNIT: scroll_style -- ASSUMPTION: these package are compliled: vhdl_lexicon_shape_style_.a vhdl_lexicon_shape_style__.a vhdl_separate_shape_style__.a -- Compile in any order ( procedure ) vhdl_scroll_set_style.a ( image is: vhdl_scroll_set_style.e ) SPECIAL UNIT: combined shape and type -- ASSUMPTION: these package are compliled: vhdl_lexicon_shape_style_.a vhdl_lexicon_shape_style__.a vhdl_separate_shape_style__.a vhdl_lexicon_type_style__.a -- Compile ( procedure ) vhdl_shape_type_standard.a ( image is: vhdl_shape_type_standard.e) @@//E*O*F COMPILE_ORDER.VHDL_TOOLS// chmod u=rw,g=,o= COMPILE_ORDER.VHDL_TOOLS echo x - io_unit_.a sed 's/^@//' > "io_unit_.a" <<'@//E*O*F io_unit_.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- Source: io_unit_.a -- -- ABSTRACT OVERVIEW: package io_unit -- -- << Purpose >> -- The package io_unit provides the mechanism to treat independent of a machine these terminators: end_file, end_page, end_line. -- Each terminator is assigned a unique character and the 'put' procedure below executes the corresponding function associated with the terminator character; Example: put ( the_end_line_character ) outputs "text_io.new_line". -- -- << Input stream >> -- The input stream has two components: user_stack and input_filter ( defined by G. Booch ) The input stream has a logical/hypothetical pointer called cursor that identifies exactly one character of the input stream. The rules that govern the cursor are below. -- DEFINE CURSOR: the cursor points to -- the top of the user_stack when the user_stack is not empty. -- the next character of the input_filter when the user_stack is empty and -- not at end of the standard input -- the_end_line_character otherwise -- -- ACCESS CURSOR: -- The function 'next_character_is' returns the cursor value and its logical action is described by: -- if the user stack /= empty, then return the top and then pop the stack -- elsif not at end of the standard input then -- return the next character of the input stream -- else return 'the_end_file_character' -- -- CONTROL PAGE TERMINATOR: -- The procedure 'set_process_page_terminator' will pass 'the_end_page_character' to the input stream, while 'set_bypass_page_terminator' does not pass 'the_end_page_character' -- -- ASSUMPTION: the package body code call 'set_bypass_page_terminator' -- -- -- << user_stack >> -- The user_stack is bounded by 'the_number_of_push_back_character'. The procedure 'push_back' pushes a character on the user_stack; when the stack is full 'push_back' removes the last element of the stack and place the character on the top of the stack. -- Suppose the bound is three and five consecutive calls of 'push_back' are made. Then the last three characters are stored, the first two pushed are lost. -- package io_unit is -- input mechanism -- define end text terminators the_end_file_character: constant character := ascii.eot; the_end_page_character: constant character := ascii.ff; the_end_line_character: constant character := ascii.lf; the_number_of_push_back_characters: constant natural := 4; function next_character_is return character; -- Effect: -- if the user stack /= empty, then return the top and then pop the stack -- elsif not at end of the standard input then -- return the next character of the input stream -- else return 'the_end_file_character' -- Note: if 'set_the_bypass_page_terminator' is set, then Ada logical page terminator is not passed to the input stream, that is, the associated character, 'the_end_page_character' is not passed to the input stream function next_line_is return string; -- Effect: return the slice:: current input character .. (including) the_end_line_character when not at end of file -- otherwise return the string ( 'the_end_page_character', 'the_end_file_character' ) on the first call when at the end of file and return the string ( 'the_end_file_character' ) on all other calls -- Note: if 'set_the_bypass_page_terminator' is set, then Ada logical page terminator is not passed to the input stream, that is, the associated character, 'the_end_page_character' is not passed to the input stream -- CONSTRUCTORS procedure clear; -- Effect: sets all internal states to a begin state; the user_stack is empty procedure set_bypass_the_page_terminator; -- Effect: does not pass the logical page terminator to the input stream procedure set_process_the_page_terminator; -- Effect: does pass the logical page terminator to the input stream procedure get ( the_character: out character ); -- Effect: assigns the value returned from 'next_character_is' procedure push_back ( the_character: in character ); -- Effect: push 'the_character' onto the user_stack by the rules stated above -- output mechanism procedure put ( the_character: in character ); -- Effect: for each terminator character in the string the associated function is executed while text_io.put is used to print ( put ) all other characters. -- Note, the action of put ( 'the_end_file_character ') is null, that is no terminator is printed; procedure put ( the_string: in string ); -- Effect: for each terminator character in the string the associated function is executed while text_io.put is used to print ( put ) all other characters. -- ITERATOR: passive over characters -- passes to process once each character of the input stream; note the last character passed is 'the_end_file_character' generic with procedure process ( the_character: in character; continue: out boolean ); procedure iterate_input_stream; -- ITERATOR: passive over lines -- passes once to the process each line defined by 'next_line_is' generic with procedure process ( the_line: in string; continue: out boolean ); procedure iterate_input_stream_with_lines; end io_unit; @@//E*O*F io_unit_.a// chmod u=rw,g=,o= io_unit_.a echo x - io_unit__.a sed 's/^@//' > "io_unit__.a" <<'@//E*O*F io_unit__.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- source: io_unit__.a with text_io; package body io_unit is type stack_element is record the_character: character := ' '; is_known: boolean := false; end record; g_stack: array ( 1 .. the_number_of_push_back_characters ) of stack_element; g_bypass_the_page_terminator: boolean := true; -- goal: instantiate the imported 'input_filter' generic type item is private; line_terminator : item; page_terminator : item; file_terminator : item; with procedure get (the_item : out item); with procedure skip_line; with procedure skip_page; with function is_end_of_line return boolean; with function is_end_of_page return boolean; with function is_end_of_file return boolean; package input_filter is procedure clear; procedure input (the_item : out item); end input_filter; --remarks: copied from Booch, Software Components With Ada p 449 generic type item is private; line_terminator : item; page_terminator : item; file_terminator : item; with procedure put ( the_item : in item ); with procedure new_line; with procedure new_page; with procedure end_file; package output_filter is procedure output ( the_item : in item ); end output_filter; --remark: code copied from Booch, Software Components With Ada pp 442-443 package body input_filter is lookahead : array ( 1 .. 2 ) of item; count : natural := 0; procedure clear is begin count := 0; end clear; procedure input ( the_item : out item ) is begin if count = 0 then if is_end_of_line then the_item := line_terminator; if is_end_of_page then lookahead ( 1 ) := page_terminator; count := 1; if is_end_of_file then lookahead ( 2 ) := file_terminator; count := 2; else skip_page; end if; else skip_line; end if; else get ( the_item ); end if; else the_item := lookahead ( 1 ); if lookahead ( 1 ) /= file_terminator then lookahead ( 1 ) := lookahead ( 2 ); count := count - 1; end if; end if; end input; end input_filter; --remarks: copied from Booch, Software Components With Ada p 449 package body output_filter is procedure output ( the_item : in item ) is begin if the_item = line_terminator then new_line; elsif the_item = page_terminator then new_page; elsif the_item = file_terminator then end_file; else put ( the_item ); end if; end output; end output_filter; procedure skip_line is begin text_io.skip_line; end skip_line; package input_stream is new input_filter ( item => character, line_terminator => the_end_line_character, page_terminator => the_end_page_character, file_terminator => the_end_file_character, get => text_io.get, skip_line => skip_line, skip_page => text_io.skip_page, is_end_of_line => text_io.end_of_line, is_end_of_page => text_io.end_of_page, is_end_of_file => text_io.end_of_file ); -- goal: to instantiate output_filter procedure new_line is begin text_io.new_line; end new_line; procedure new_page is begin text_io.new_page; end new_page; procedure end_file is begin null; end end_file; package output_stream is new output_filter ( item => character, line_terminator => the_end_line_character, page_terminator => the_end_page_character, file_terminator => the_end_file_character, put => text_io.put, new_line => new_line, new_page => new_page, end_file => end_file ); --------------------------------------------------------------------------- -- Code section build entirely from the above input output filters -- Text_io is never used in the code below procedure clear is begin g_stack := ( others => ( ' ', false ) ); end clear; procedure set_bypass_the_page_terminator is begin g_bypass_the_page_terminator := true; end set_bypass_the_page_terminator; procedure set_process_the_page_terminator is begin g_bypass_the_page_terminator := false; end set_process_the_page_terminator; function next_character_is return character is the_char: character; begin << repeat >> if not g_stack ( g_stack'first ).is_known then input_stream.input ( the_char ); else the_char := g_stack ( g_stack'first ).the_character; g_stack ( g_stack'first .. g_stack'last - 1 ) := g_stack ( g_stack'first + 1 .. g_stack'last ); g_stack ( g_stack'last ).is_known := false; end if; if g_bypass_the_page_terminator then if the_char = the_end_page_character then goto repeat; end if; end if; return the_char; end next_character_is; function next_line_is return string is the_char: character := next_character_is; begin if the_char = the_end_line_character or the_char = the_end_file_character then return ( 1 => the_char ); else return ( 1 => the_char ) & next_line_is; end if; end next_line_is; procedure get ( the_character: out character ) is begin the_character := next_character_is; end get; procedure push_back ( the_character: in character ) is begin g_stack ( g_stack'first + 1 .. g_stack'last ) := g_stack ( g_stack'first .. g_stack'last - 1 ); g_stack ( g_stack'first).is_known := true; g_stack ( g_stack'first).the_character := the_character; end push_back; -- output procedure put ( the_character: in character ) is begin output_stream.output ( the_character ); end put; procedure put ( the_string: in string ) is begin for index in the_string'range loop output_stream.output ( the_string ( index ) ); end loop; end put; ----- ITERATOR: passive procedure iterate_input_stream is continue: boolean := false; the_char: character := ' '; begin loop the_char := next_character_is; process ( the_char, continue ); exit when ( not continue ) or ( the_char = the_end_file_character ); end loop; end iterate_input_stream; -- ITERATOR: passive over lines procedure iterate_input_stream_with_lines is continue: boolean := false; procedure examine ( the_string: in string ) is -- examine the last character begin process ( the_string, continue ); if continue then continue := ( the_string ( the_string'last ) /= the_end_file_character ); end if; end examine; begin loop examine ( next_line_is ); exit when not continue; end loop; end iterate_input_stream_with_lines; begin -- PACKAGE CODE clear; set_bypass_the_page_terminator; end io_unit; @@//E*O*F io_unit__.a// chmod u=rw,g=,o= io_unit__.a echo x - transliterate_gn__.a sed 's/^@//' > "transliterate_gn__.a" <<'@//E*O*F transliterate_gn__.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- Source: transliterate_gn__.a -- generic type item is private; type enum is ( <> ); type array_range_enum is array ( enum ) of item; array_values: array_range_enum; with function equal ( the_left_item: in item; the_right_item: in item ) return boolean is <>; package transliterate_gn is function is_a_member ( for_the_item: in item ) return boolean; function value_is return enum; no_value_exception: exception; end transliterate_gn; ------------------------------------------------------------------------------------------------------------------ package body transliterate_gn is g_value_is_known: boolean := false; g_the_enumeration_value: enum; function is_a_member ( for_the_item: in item ) return boolean is begin for element in enum loop if equal ( array_values ( element ), for_the_item ) then g_value_is_known := true; g_the_enumeration_value := element; return true; end if; end loop; g_value_is_known := false; return false; end is_a_member; function value_is return enum is begin if g_value_is_known then return g_the_enumeration_value; else raise no_value_exception; end if; end value_is; end transliterate_gn; @@//E*O*F transliterate_gn__.a// chmod u=rw,g=,o= transliterate_gn__.a echo x - vhdl_build_.a sed 's/^@//' > "vhdl_build_.a" <<'@//E*O*F vhdl_build_.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- source: vhdl_build_.a -- -- OVERVIEW: package vhdl_build -- -- A value function is a function whose name is of this form 'value_< lexical_element >_is'. -- Assume that the first character of the current input ( defined by io.next_character_is ) identifies an lexical element say identifier. -- Then a call to 'value_identifier_is' returns the string value of the identifier and the next input character is the first character following the last character of the identifier. -- Furthermore, a call to 'lexicon_subtype_is' returns the vhdl_lexicon.element_subtype and a call to 'lexical_name_is' returns the name of the lexical item. -- with vhdl_lexicon; package vhdl_build is function value_separator_is return string; -- Effect: accesses and returns only the string value of an lexical element separator -- Assumption: the first character of the input stream is the first character of some separator. -- Note: no mechanism is provided for an assumption violation function value_delimiter_is return string; -- Effect: accesses and returns only the string value of an lexical element delimiter -- Assumption: the first character of the input stream is the first character of some delimiter. -- Note: no mechanism is provided for an assumption violation function value_identifier_is return string; -- Effect: accesses and returns only the string value of an lexical element identifier -- Assumption: the first character of the input stream is the first character of some identifier. -- Note: no mechanism is provided for an assumption violation function value_abstract_literal_is return string; -- Effect: accesses and returns only the string value of an lexical element abstract_literal -- Assumption: the first character of the input stream is the first character of some abstract_literal. -- Note: no mechanism is provided for an assumption violation function value_character_literal_is return string; -- Effect: accesses and returns the string value of an lexical element character_literal -- Assumption: the first character of the input stream is the first character of some character_literal. -- Note: no mechanism is provided for an assumption violation function value_string_literal_is return string; -- Effect: accesses and returns only the string value of an lexical element string_literal -- Assumption: the first character of the input stream is the first character of some string_literal. -- Note: when a matching ( second ) " is not found then one is add to the end of the line, also embeds an error message function value_bit_string_literal_is return string; -- Effect: accesses and returns the string value of an lexical element bit_string_literal -- Assumption: the first character of the input stream is the first character of some bit_string_literal. -- Note: no mechanism is provided for an assumption violation function value_comment_is return string; -- Effect: accesses and returns only the string value of an lexical element comment_literal -- Assumption: the first character of the input stream is the first character of some comment_literal -- Note: no mechanism is provided for an assumption violation -- RETURN TYPE NAMES function lexicon_subtype_is return vhdl_lexicon.element_subtype; -- Effect: returns the vhdl_lexicon.element_subtype of the current defined lexical element function lexical_name_is return vhdl_lexicon.element_name; -- Effect: returns the name of the current defined lexical element end vhdl_build; @@//E*O*F vhdl_build_.a// chmod u=rw,g=,o= vhdl_build_.a echo x - vhdl_build__.a sed 's/^@//' > "vhdl_build__.a" <<'@//E*O*F vhdl_build__.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- source: vhdl_build__.a with vhdl_name; with vhdl_lexicon; with io_unit; package body vhdl_build is function "=" ( the_left: in vhdl_lexicon.element_name; the_right: in vhdl_lexicon.element_name ) return boolean renames vhdl_lexicon."="; type body_values is array ( character ) of boolean; -- CONSTANTS identifier_unit_body: constant body_values := body_values' ( 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' => true, others => false); string_body: constant body_values := body_values' ( '"' | io_unit.the_end_line_character => false, others => true ); comment_unit_body: constant body_values := body_values' ( io_unit.the_end_line_character => false, others => true ); digit_unit_body: constant body_values := body_values' ( '0' .. '9' | '_' => true, others => false); -- GLOBAL OBJECTS g_lexicon_element_subtype: vhdl_lexicon.element_subtype := vhdl_lexicon.separator_end_of_line; g_lexical_name: vhdl_lexicon.element_name := vhdl_lexicon.space_character; -- CONSTRUCTORS function construct ( from_the_lexical_body: in body_values ) return string is -- Effect: calls io_unit.next_character to construct a lexical element defined by 'from_the_lexical_body'. -- Note, after a call to construct, a call to 'io.next_character_is' points the first character following this lexical element function data return string is the_string: string ( 1 .. 1 ) := ( others => ' ' ); begin the_string ( 1 ) := io_unit.next_character_is; if from_the_lexical_body ( the_string ( 1 ) ) then return the_string & data; else io_unit.push_back ( the_string ( 1 ) ); return ""; end if; end data; begin return data; end construct; function value_identifier_is return string is function value_is ( the_value: in string ) return string is begin if vhdl_name.is_reserve_word ( the_value ) then g_lexicon_element_subtype := vhdl_lexicon.identifier_reserved; g_lexical_name := vhdl_name.reserve_word_name_is; else g_lexicon_element_subtype := vhdl_lexicon.identifier_not_reserved; g_lexical_name := vhdl_lexicon.identifier_not_rw_id; end if; return the_value; end value_is; begin return value_is ( construct ( from_the_lexical_body =>identifier_unit_body )); end value_identifier_is; function value_separator_is return string is the_string: string ( 1 .. 1 ) := ( others => io_unit.next_character_is ); begin if vhdl_name.is_separator ( the_string ( 1 ) ) then g_lexical_name := vhdl_name.separator_name_is; if g_lexical_name = vhdl_lexicon.line_feed then g_lexicon_element_subtype := vhdl_lexicon.separator_end_of_line; elsif g_lexical_name = vhdl_lexicon.form_feed then g_lexicon_element_subtype := vhdl_lexicon.separator_end_of_page; elsif g_lexical_name = vhdl_lexicon.end_file then g_lexicon_element_subtype := vhdl_lexicon.separator_end_of_file; else g_lexicon_element_subtype := vhdl_lexicon.separator_format_effector; end if; end if; return the_string; end value_separator_is; function value_delimiter_is return string is the_string: string ( 1 .. 2 ) := ( others => ' ' ); begin the_string ( 1 ) := io_unit.next_character_is; the_string ( 2 ) := io_unit.next_character_is; if vhdl_name.is_compound_delimiter ( the_string ) then g_lexicon_element_subtype := vhdl_lexicon.delimiter_double; g_lexical_name := vhdl_name.compound_delimiter_name_is; return the_string; elsif vhdl_name.is_single_delimiter ( the_string ( 1 ) ) then g_lexicon_element_subtype := vhdl_lexicon.delimiter_single; g_lexical_name := vhdl_name.single_delimiter_name_is; io_unit.push_back ( the_string ( 2 ) ); -- last character, not in delimiter_body return the_string ( 1 .. 1 ); end if; end value_delimiter_is; function value_character_literal_is return string is the_value: string ( 1 .. 3 ) := ( others => ' ' ); begin the_value ( 1 ) := io_unit.next_character_is; the_value ( 2 ) := io_unit.next_character_is; the_value ( 3 ) := io_unit.next_character_is; g_lexicon_element_subtype := vhdl_lexicon.literal_character; g_lexical_name := vhdl_lexicon.character_literal; return the_value; end value_character_literal_is; function value_abstract_literal_is return string is -- function exponent_is ( the_current_value: in string ) return string is the_look_ahead: string ( 1 .. 2 ) := ( others => ' ' ); begin the_look_ahead ( 1 ) := io_unit.next_character_is; if the_look_ahead ( 1 ) = 'E' or the_look_ahead ( 1 ) = 'e' then the_look_ahead ( 2 ) := io_unit.next_character_is; return the_current_value & the_look_ahead & construct ( from_the_lexical_body => digit_unit_body ); else io_unit.push_back ( the_look_ahead ( 1 ) ); return the_current_value; end if; end exponent_is; -- function value_is ( the_integer: in string ) return string is the_look_ahead: character := io_unit.next_character_is; begin -- value_is case the_look_ahead is when '.' => g_lexicon_element_subtype := vhdl_lexicon.literal_abstract_decimal; g_lexical_name := vhdl_lexicon.real_literal; return exponent_is ( the_integer & ( '.' ) & construct ( from_the_lexical_body => digit_unit_body ) ); when 'E' | 'e' => g_lexicon_element_subtype := vhdl_lexicon.literal_abstract_decimal; g_lexical_name := vhdl_lexicon.integer_exponent_literal; io_unit.push_back ( the_look_ahead ); return exponent_is ( the_integer ); when '#' => based_literal_code: declare based_integer_extended: constant body_values := body_values' ( 'a' .. 'f' | 'A' .. 'F' | '0' .. '9' | '.' | '_' => true, others => false ); function extend ( the_string: in string ) return string is the_string_1: string ( 1 .. 1 ) := ( others => ' ' ); begin the_string_1 ( 1 ) := io_unit.next_character_is; return exponent_is ( the_string & the_string_1 ); end extend; begin g_lexicon_element_subtype := vhdl_lexicon.literal_abstract_based; g_lexical_name := vhdl_lexicon.based_literal; return extend ( the_integer & ( the_look_ahead ) & construct ( based_integer_extended ) ); end based_literal_code; when others => g_lexicon_element_subtype := vhdl_lexicon.literal_abstract_decimal; g_lexical_name := vhdl_lexicon.integer_literal; io_unit.push_back ( the_look_ahead ); return the_integer; end case; end value_is; begin return value_is ( construct ( from_the_lexical_body => digit_unit_body ) ); end value_abstract_literal_is; function value_string_literal_is return string is the_string_1: string ( 1 .. 1 ) := ( 1 => io_unit.next_character_is ); function build_the_string ( the_value: in string ) return string is the_look_ahead_string: string ( 1 .. 2 ) := ( others => ' ' ); begin the_look_ahead_string ( 1 ) := io_unit.next_character_is; the_look_ahead_string ( 2 ) := io_unit.next_character_is; if the_look_ahead_string ( 2 ) = '"' then -- special case of double quots return the_value & the_look_ahead_string & build_the_string ( construct ( from_the_lexical_body => string_body ) ); elsif the_look_ahead_string ( 1 ) = '"' then -- standard comment line io_unit.push_back ( the_look_ahead_string ( 2 ) ); return the_value & the_look_ahead_string ( 1 .. 1 ); else -- case of error io_unit.push_back ( the_look_ahead_string ( 2 ) ); io_unit.push_back ( the_look_ahead_string ( 1 ) ); return the_value & " -- E R R O R"""; end if; end build_the_string; begin g_lexicon_element_subtype := vhdl_lexicon.literal_string; g_lexical_name := vhdl_lexicon.string_literal; return the_string_1 & build_the_string ( construct ( from_the_lexical_body => string_body ) ); end value_string_literal_is; function value_bit_string_literal_is return string is the_look_ahead: string ( 1 .. 2 ) := ( others => ' ' ); begin the_look_ahead ( 1 ) := io_unit.next_character_is; the_look_ahead ( 2 ) := io_unit.next_character_is; g_lexicon_element_subtype := vhdl_lexicon.literal_bit_string; g_lexical_name := vhdl_lexicon.bit_string_B; if the_look_ahead ( 1 ) = 'o' or the_look_ahead ( 1 ) = 'O' then g_lexical_name := vhdl_lexicon.bit_string_O; elsif the_look_ahead ( 1 ) = 'x' or the_look_ahead ( 1 ) = 'X' then g_lexical_name := vhdl_lexicon.bit_string_X; end if; -- add to make correct return the_look_ahead & construct ( from_the_lexical_body => string_body ) & ( io_unit.next_character_is ); -- must be '"' end value_bit_string_literal_is; function value_comment_is return string is begin g_lexicon_element_subtype := vhdl_lexicon.comment; g_lexical_name := vhdl_lexicon.comment; return construct ( from_the_lexical_body => comment_unit_body ); end value_comment_is; function lexicon_subtype_is return vhdl_lexicon.element_subtype is begin return g_lexicon_element_subtype; end lexicon_subtype_is; function lexical_name_is return vhdl_lexicon.element_name is begin return g_lexical_name; end lexical_name_is; end vhdl_build; @@//E*O*F vhdl_build__.a// chmod u=rw,g=,o= vhdl_build__.a echo x - vhdl_letter_set_style.a sed 's/^@//' > "vhdl_letter_set_style.a" <<'@//E*O*F vhdl_letter_set_style.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- -- Purpose -- Letter style defines the case of a letter. The letter style of a lexical element ( say word Vhdl_leXicoN ) are lower_case ( vhdl_lexicon ), upper_case ( VHDL_LEXICON ), mix_case (Vhdl_Lexicon ) and unchanged_case ( Vhdl_leXicoN ). -- -- The procedure vhdl_letter_set_style allows one to change the letter style of a lexical element without recompiling code. The input stream requires the letter_style specification first followed by the source code. The approach allows the operating system language commands to arrange a variety of ways to format source code. -- Assumptions and process overview -- Input: device = text_io.standard_input; -- data = letter specification + vhdl (syntax) source code -- * the exact format of the letter specification is defined by 'is_initializing' of package 'vhdl_lexicon_letter_style' -- -- Output: device = text_io.standard_output -- data = text format with specifications defined in the input stream -- Suggested use -- Change the letter_style without recompiling source code. This can be done by using the shell script: vletter_set_style -- -- with text_io; with vhdl_lexicon_letter_style; procedure vhdl_letter_set_style is begin vhdl_lexicon_letter_style.iterate_code ( with_the_specification => vhdl_lexicon_letter_style.is_initializing ( text_io.standard_input ) ); end vhdl_letter_set_style; @@//E*O*F vhdl_letter_set_style.a// chmod u=rw,g=,o= vhdl_letter_set_style.a echo x - vhdl_lexicon_.a sed 's/^@//' > "vhdl_lexicon_.a" <<'@//E*O*F vhdl_lexicon_.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- source: vhdl_lexicon_.a -- -- -- OVERVIEW: package vhdl_lexicon -- -- << Background on vhdl lexicon >> -- A vhdl source code is defined to be a text file that conforms to the specifications of the IEEE-VHDL-LRM ( it compiles ). Its logical data structure is a linear ordered set ( sequence ) of lexical elements. -- << Purpose >> -- The main objective is to provide several iterators each of which will iterate over the logical sequential data structure of a vhdl source code. Hence, each lexical element can be accessed separately and in order. -- << Lexicon Hierarchy >> -- The vhdl Reference Manual lists the lexicon elements as enumerated in type "element_type". The type "element_subtype" further decomposes each "element_type". The type "element_name" assigns a unique name to each constant lexical value; these values represent each separator, each delimiter and each reserved word. -- << Content >> -- Five sections make up the package vhdl_lexicon. -- Hierarchy Of Types: element_type, element_subtype, element_name -- Output Mechanism: -- Passive Iterator: "iterate_vhdl_code" -- Passive Iterator With Parameters: "iterate_vhdl_code_with_parameters" -- Active Iterator: selectors are "value_is" "type_is", "subtype_is", "name_is". -- << Assumptions >> -- Input: device = text_io.standard_input; -- data = vhdl (syntax) source code -- Note: there is no restriction on the size ( string length ) of a lexical element. The current environment may have a buffer constraint. -- Limited Robustness. When the source file violates vhdl syntax by having the first character of an element type to be unrecognizable such as '#','%; , the line ( from the incompatible character.. to the end of line ) is outputted as a comment line. -- << Design decisions and organizations >> -- The decision to have one package house all the information about the lexical elements forces this package to be lengthly. The rationale is that this high level self containment provides an easy of use; the user needs only to consult one package. -- Design strategy. The source code is a sequence of lexicon elements, some are identified uniquely by their first character ( identifier, abstract_literal, string_literal, delimiters ), the others require at most the first three characters for identification. -- STEP 1. Identify the current lexicon element. Assume the input cursor points to the first character and the process ends with the input cursor pointing to this first character. -- STEP 2. Build the lexicon element and pass the information to these selectors: "value_is" "type_is", "subtype_is", "name_is". Assume the input cursor points to the first character and the process ends with the input cursor pointing to the first character of the next lexical element. -- NOTE, the call to "value_is" activates step 1 and step 2. with text_io; with io_unit; package vhdl_lexicon is type element_type is ( separator, delimiter, identifier, abstract_literal, character_literal, string_literal, bit_string_literal, comment ); type element_subtype is ( separator_end_of_file, separator_end_of_page, separator_end_of_line, separator_format_effector, -- delimiters delimiter_single, delimiter_double, -- identifiers identifier_reserved, identifier_not_reserved, -- abstract literal literal_abstract_decimal, literal_abstract_based, -- literal_character, literal_string, literal_bit_string, comment ); type element_name is ( -- RESERVE WORDS abs_id, access_id, after_id, alias_id, all_id, and_id, architecture_id, array_id, assert_id, attribute_id, begin_id, block_id, body_id, buffer_id, bus_id, case_id, component_id, configuration_id, constant_id, disconnect_id, downto_id, else_id, elsif_id, end_id, entity_id, exit_id, file_id, for_id, function_id, generate_id, generic_id, guarded_id, if_id, in_id, inout_id, is_id, label_id, library_id, linkage_id, loop_id, map_id, mod_id, name_id, new_id, next_id, nor_id, not_id, null_id, of_id, on_id, open_id, or_id, others_id, out_id, package_id, port_id, procedure_id, process_id, range_id, record_id, register_id, rem_id, report_id, return_id, select_id, severity_id, signal_id, subtype_id, then_id, to_id, transport_id, type_id, units_id, until_id, use_id, variable_id, wait_id, when_id, while_id, with_id, xor_id, -- SINGLE DELIMITER ampersand, apostrophe, left_parenthesis, right_parenthesis, star, plus, comma, hyphen, dot, slash, colon, semicolon, less_than, equal, greater_than, vertical_bar, -- COMPOUND DELIMITER arrow, double_star, assignment_variable, inequality, greater_than_equal, less_than_equal, box, -- QUOT quotation, -- SEPARATORS = format effectors, space_character, end_file horizontal_tab, vertical_tab, carriage_return, line_feed, form_feed, space_character, end_file, -- SPECIAL CHARACTERS sharp, underline, dollar, percent, question_mark, commercial_at, left_bracket, right_bracket, back_slash, circumflex, grave_accent, right_brace, left_brace, tilde, -- IDENTIFIER NOT A RESERVE WORD identifier_not_rw_id, -- ABSTRACT LITERAL integer_literal, integer_exponent_literal, real_literal, based_literal, -- CHARACTER LITERAL character_literal, -- STRING LITERAL string_literal, -- BIT_STRING_LITERAL bit_string_B, bit_string_O, bit_string_X, -- COMMENT comment ); -- SECTION: OUTPUT MECHANISM -- -- logical file terminators -- the_end_file_character: character renames io_unit.the_end_file_character; the_end_page_character: character renames io_unit.the_end_page_character; the_end_line_character: character renames io_unit.the_end_line_character; procedure put ( the_string: in string ); -- Effect: puts each ( non_terminator ) character to the standard output and executes the associated function of each terminator character. The terminator character names are end_file, end_page, end_line. procedure put ( the_element_type: in element_type; the_field_width: in text_io.field := 18; -- 18 characters in largest type the_type_set: in text_io.type_set := text_io.lower_case ); -- Effect: puts the enumerated type to standard output procedure put ( the_element_subtype: in element_subtype; the_field_width: in text_io.field := 25; -- 25 characters in largest type the_type_set: in text_io.type_set := text_io.lower_case ); -- Effect: puts the enumerated type to standard output procedure put ( the_element_name: in element_name; the_field_width: in text_io.field := 28; -- 28 characters in largest type the_type_set: in text_io.type_set := text_io.lower_case ); -- Effect: puts the enumerated type to standard output -- SECTION: PASSIVE ITERATOR -- -- pass the attributes ( value, type, subtype, name ) of each lexical element of a vhdl source code generic with procedure process ( the_value: in string; the_type: in element_type; the_subtype: in element_subtype; the_name: in element_name; continue: out boolean ); procedure iterate_vhdl_code; -- SECTION: PASSIVE ITERATOR WITH PARAMETERS -- generic type external_type_in is limited private; type external_type_in_out is limited private; with procedure process ( -- the external data -- the_external_data_in: in external_type_in; the_external_data_in_out: in out external_type_in_out; -- the iterative data -- the_value: in string; the_type: in element_type; the_subtype: in element_subtype; the_name: in element_name; continue: out boolean ); procedure iterate_vhdl_code_with_parameters ( the_external_data_in: in external_type_in; the_external_data_in_out: in out external_type_in_out ); -- SECTION: ACTIVE ITERATOR -- function value_is return string; -- Effect: defines the current lexical element and returns its character value function type_is return element_type; -- Effect: returns the "element_type" of the current lexical element function subtype_is return element_subtype; -- Effect: returns the "element_subtype" of the current lexical element function name_is return element_name; -- Effect: returns the "element_name" of the current lexical element -- INTENDED USAGE for active iterator -- iterate: -- loop -- process ( value_is ); -- -- use if needed type_is, subtype_is, name_is ); -- exit iterate when subtype_is = separator_end_of_file; -- end loop -- iterate; end vhdl_lexicon; @@//E*O*F vhdl_lexicon_.a// chmod u=rw,g=,o= vhdl_lexicon_.a echo x - vhdl_lexicon__.a sed 's/^@//' > "vhdl_lexicon__.a" <<'@//E*O*F vhdl_lexicon__.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- with io_unit; with vhdl_name; with vhdl_build; with text_io; package body vhdl_lexicon is package element_type_io is new text_io.enumeration_io ( element_type ); package element_subtype_io is new text_io.enumeration_io ( element_subtype ); package element_name_io is new text_io.enumeration_io ( element_name ); g_element_type: element_type := comment; function value_is return string is the_look_ahead_1: character := ( io_unit.next_character_is ); the_look_ahead_2: character := ( ' ' ); the_look_ahead_3: character := ( ' ' ); begin case the_look_ahead_1 is -- UNAMBIGUOUS CASES: ie, the first character identifies uniquely a lexical element when '0' .. '9' => -- ABSTRACT LITERAL io_unit.push_back ( the_look_ahead_1 ); g_element_type := abstract_literal; return vhdl_build.value_abstract_literal_is; when '"' => -- STRING LITERAL io_unit.push_back ( the_look_ahead_1 ); g_element_type := string_literal; return vhdl_build.value_string_literal_is; when 'a' | 'c' .. 'n' | 'p' .. 'w' | 'y' .. 'z' | 'A' | 'C' .. 'N' | 'P' .. 'W' | 'Y' .. 'Z' => -- IDENTIFIER io_unit.push_back ( the_look_ahead_1 ); g_element_type := identifier; return vhdl_build.value_identifier_is; when '&' | '(' .. ',' | '.' | '/' | ':' .. '>' | '|' => -- DELIMITER io_unit.push_back ( the_look_ahead_1 ); g_element_type := delimiter; return vhdl_build.value_delimiter_is; -- AMBIGUOUS CASES: ie, requires more than one look ahead character when '-' => -- COMMENT or DELIMITER hyphen the_look_ahead_2 := io_unit.next_character_is; io_unit.push_back ( the_look_ahead_2 ); io_unit.push_back ( the_look_ahead_1 ); if the_look_ahead_2 = '-' then -- comment g_element_type := comment; return vhdl_build.value_comment_is; else -- delimiter g_element_type := delimiter; return vhdl_build.value_delimiter_is; end if; when 'B' | 'b' | 'O' | 'o' | 'X' | 'x' => -- IDENTIFIER or BIT_STRING_LITERAL the_look_ahead_2 := io_unit.next_character_is; io_unit.push_back ( the_look_ahead_2 ); io_unit.push_back ( the_look_ahead_1 ); if the_look_ahead_2 = '"' then -- bit_string_literal g_element_type := bit_string_literal; return vhdl_build.value_bit_string_literal_is; else -- identifier g_element_type := identifier; return vhdl_build.value_identifier_is; end if; when ''' => -- CHARACTER LITERAL or DELIMITER apostrophe the_look_ahead_2 := io_unit.next_character_is; the_look_ahead_3 := io_unit.next_character_is; io_unit.push_back ( the_look_ahead_3 ); io_unit.push_back ( the_look_ahead_2 ); io_unit.push_back ( the_look_ahead_1 ); if the_look_ahead_2 /= the_end_line_character and then the_look_ahead_3 = ''' then -- it is a character_literal g_element_type := character_literal; return vhdl_build.value_character_literal_is; else -- it is a delimiter g_element_type := delimiter; return vhdl_build.value_delimiter_is; end if; when the_end_file_character | the_end_page_character | the_end_line_character | ascii.ht | ' ' => -- SEPARATORS io_unit.push_back ( the_look_ahead_1 ); g_element_type := separator; return vhdl_build.value_separator_is; when others => -- check first for other separators if the_look_ahead_1 = ascii.cr or the_look_ahead_1 = ascii.lf or the_look_ahead_1 = ascii.ff or the_look_ahead_1 = ascii.vt then -- the character is an effector, valid vhdl syntax io_unit.push_back ( the_look_ahead_1 ); g_element_type := separator; return vhdl_build.value_separator_is; else -- invalid vhdl syntax io_unit.push_back ( the_look_ahead_1 ); g_element_type := comment; return "--* " & vhdl_build.value_comment_is; end if; end case; end value_is; function type_is return element_type is begin return g_element_type; end type_is; function subtype_is return element_subtype is begin return vhdl_build.lexicon_subtype_is; end subtype_is; function name_is return element_name is begin return vhdl_build.lexical_name_is; end name_is; ---- OUTPUT IO ---- procedure put ( the_string: in string ) is begin io_unit.put ( the_string ); end put; procedure put ( the_element_type: in element_type; the_field_width: in text_io.field := 18; -- 18 characters in largest type the_type_set: in text_io.type_set := text_io.lower_case ) is begin element_type_io.put ( the_element_type, the_field_width, the_type_set ); end put; procedure put ( the_element_subtype: in element_subtype; the_field_width: in text_io.field := 25; -- 25 characters in largest type the_type_set: in text_io.type_set := text_io.lower_case ) is begin element_subtype_io.put ( the_element_subtype, the_field_width, the_type_set ); end put; procedure put ( the_element_name: in element_name; the_field_width: in text_io.field := 28; -- 28 characters in largest type the_type_set: in text_io.type_set := text_io.lower_case ) is -- the problem: reserved words ( end ) is not allowed to be a value in an enumerated type 'element_name'; end is represented as 'end_id' in 'element_name'. -- Hence, when the last three characters = "_id", remove them. the_length: natural := element_name'image ( the_element_name )'length; the_value: string ( 1 .. the_length ); begin element_name_io.put ( to => the_value ( 1 .. the_length ), item => the_element_name, set => the_type_set ); if the_value'length > 3 then if ( the_value ( the_value'last - 2 .. the_value'last ) = "_id" or the_value ( the_value'last - 2 .. the_value'last ) = "_ID" ) then the_length := the_length - 3; end if; end if; if the_field_width = 0 then text_io.put ( the_value ( 1 .. the_length ) ); elsif the_field_width < the_length then text_io.put ( the_value ( 1 .. the_field_width ) ); else text_io.put ( the_value ( 1 .. the_length) & ( the_length + 1 .. the_field_width => ' ' ) ); end if; end put; procedure iterate_vhdl_code is continue: boolean := false; the_subtype: element_subtype := separator_end_of_file; procedure execute_the_function_value_is ( the_value: in string ) is begin the_subtype := subtype_is; process ( the_value, type_is, the_subtype, name_is, continue ); end execute_the_function_value_is; begin iterate: loop execute_the_function_value_is ( value_is ); exit iterate when not continue or the_subtype = separator_end_of_file; end loop iterate; end iterate_vhdl_code; procedure iterate_vhdl_code_with_parameters ( the_external_data_in: in external_type_in; the_external_data_in_out: in out external_type_in_out ) is continue: boolean := false; the_subtype: element_subtype := separator_end_of_line; procedure execute_the_function_value_is ( the_value: in string ) is begin the_subtype := subtype_is; process ( the_external_data_in, the_external_data_in_out, the_value, type_is, the_subtype, name_is, continue ); end execute_the_function_value_is; begin iterate: loop execute_the_function_value_is ( value_is ); exit iterate when not continue or the_subtype = separator_end_of_file; end loop iterate; end iterate_vhdl_code_with_parameters; end vhdl_lexicon; @@//E*O*F vhdl_lexicon__.a// chmod u=rw,g=,o= vhdl_lexicon__.a echo x - vhdl_lexicon_letter_style__.a sed 's/^@//' > "vhdl_lexicon_letter_style__.a" <<'@//E*O*F vhdl_lexicon_letter_style__.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- -- Purpose -- Letter style defines the case of a letter. The letter style of a lexical element ( say word Vhdl_leXicoN ) are lower_case ( vhdl_lexicon ), upper_case ( VHDL_LEXICON ), mix_case (Vhdl_Lexicon ) and unchanged_case ( Vhdl_leXicoN ). -- -- The main purpose is to standardize the letter style of vhdl source code. Precisely, the objective is provide a passive iterator over a sequence of vhdl lexical elements that uniformizes the letter style of each set of objects of each each lexical element category. See procedure iterate_code. with vhdl_lexicon; with text_io; package vhdl_lexicon_letter_style is -- TYPES -- type selection is ( lower_case, upper_case, mix_case, unchanged_case ); type specification is array ( vhdl_lexicon.element_subtype ) of selection; -- associates each lexical subtype to a unique letter style ( selection ) -- SELECTORS -- function is_initializing ( use_the_file_variable: in text_io.file_type ) return specification; -- Effect: transfers the letter style specification on text file to a letter style specification -- Assumption: The values of the letter style on the text file appear in this consecutive line order: -- lower_case -- identifier reserved ( line 1 ) -- mix_case -- identifier not reserved ( line 2 ) -- upper_case -- literal_abstract decimal lexical subtype ( line 3 ) -- upper_case -- literal_abstract based lexical subtype ( line 4 ) -- upper_case -- literal bit string ( line 5 ) -- unchanged_case -- comment ( line 6 ) -- Note, all other lexical subtypes are associated with selection.unchanged_case -- Assumption violation: all exceptions are promulgated function is_initializing ( use_the_file_name: in string ) return specification; -- Effect: opens the file "use_the_file_name", calls is_initializing ( formal parameter is of file_type ), closes the file -- Assumption: file exits and values are of type selection -- Assumption violation: all exceptions are promulgated function is_standardizing ( the_string: in string; to_the_letter_style: in selection ) return string; -- Effect: returns the contents of 'the_string' with letter style = 'to_the_letter_style' -- CONSTRUCTOR -- procedure iterate_code ( with_the_specification: in specification ); -- INPUT device: standard input data: vhdl source code -- OUTPUT device: standard output data: vhdl source code with letter style defined by 'with_the_specification' -- EFFECT: each object of each lexical subtype category is of the same letter_style end vhdl_lexicon_letter_style; --------------------- package body vhdl_lexicon_letter_style --------------------- with text_io; with vhdl_lexicon; package body vhdl_lexicon_letter_style is function is_initializing ( use_the_file_variable: in text_io.file_type ) return specification is -- Note: promulgate name error exception when the file is not found the_specification: specification := ( others => unchanged_case ); package selection_io is new text_io.enumeration_io ( selection ); begin selection_io.get ( use_the_file_variable, the_specification ( vhdl_lexicon.identifier_reserved ) ); text_io.skip_line ( use_the_file_variable ); selection_io.get ( use_the_file_variable, the_specification ( vhdl_lexicon.identifier_not_reserved ) ); text_io.skip_line ( use_the_file_variable ); selection_io.get ( use_the_file_variable, the_specification ( vhdl_lexicon.literal_abstract_decimal ) ); text_io.skip_line ( use_the_file_variable ); selection_io.get ( use_the_file_variable, the_specification ( vhdl_lexicon.literal_abstract_based ) ); text_io.skip_line ( use_the_file_variable ); selection_io.get ( use_the_file_variable, the_specification ( vhdl_lexicon.literal_bit_string ) ); text_io.skip_line ( use_the_file_variable ); selection_io.get ( use_the_file_variable, the_specification ( vhdl_lexicon.comment ) ); text_io.skip_line ( use_the_file_variable ); return the_specification; end is_initializing; function is_initializing ( use_the_file_name: in string ) return specification is the_specification: specification := ( others => unchanged_case ); the_file_variable: text_io.file_type; -- Note: promulgate name error exception when the file is not found begin text_io.open ( the_file_variable, text_io.in_file, use_the_file_name ); the_specification := is_initializing ( the_file_variable ); text_io.close ( the_file_variable ); return the_specification; end is_initializing; procedure iterate_code ( with_the_specification: in specification ) is procedure standardize_the_letter_style ( the_value: in string; the_type: in vhdl_lexicon.element_type; the_subtype: in vhdl_lexicon.element_subtype; the_name: in vhdl_lexicon.element_name; continue: out boolean ); procedure iterate_vhdl_code_with_letter_style is new vhdl_lexicon.iterate_vhdl_code ( process => standardize_the_letter_style ); procedure standardize_the_letter_style ( the_value: in string; the_type: in vhdl_lexicon.element_type; the_subtype: in vhdl_lexicon.element_subtype; the_name: in vhdl_lexicon.element_name; continue: out boolean ) is begin vhdl_lexicon.put ( the_string => is_standardizing ( the_string => the_value, to_the_letter_style => with_the_specification ( the_subtype ) ) ); continue := true; end standardize_the_letter_style; begin iterate_vhdl_code_with_letter_style; end iterate_code; ------------------------------------------------------------------------- function to_upper_case ( the_string: in string ) return string is the_temporary_string: string ( the_string'range ) := the_string; begin for index in the_temporary_string'range loop if the_temporary_string ( index ) in 'a' .. 'z' then the_temporary_string ( index ) := character'val ( character'pos ( the_temporary_string ( index ) ) - character'pos ( 'a' ) + character'pos ( 'A' ) ); end if; end loop; return the_temporary_string; end to_upper_case; function to_lower_case ( the_string: in string ) return string is the_temporary_string: string ( the_string'range ) := the_string; begin for index in the_temporary_string'range loop if the_temporary_string ( index ) in 'A' .. 'Z' then the_temporary_string ( index ) := character'val ( character'pos ( the_temporary_string ( index ) ) - character'pos ( 'A' ) + character'pos ( 'a' ) ); end if; end loop; return the_temporary_string; end to_lower_case; function to_mix_case ( the_string: in string ) return string is convert_to_upper_case: boolean := true; the_temporary_string: string ( the_string'range ) := the_string; begin for index in the_string'range loop if convert_to_upper_case then the_temporary_string ( index ) := to_upper_case ( the_string ( index .. index ) ) ( index ); else the_temporary_string ( index ) := to_lower_case ( the_string ( index .. index ) ) ( index ); end if; convert_to_upper_case := the_temporary_string ( index ) = '_'; end loop; return the_temporary_string; end to_mix_case; function is_standardizing ( the_string: in string; to_the_letter_style: in selection ) return string is begin case to_the_letter_style is when upper_case => return to_upper_case ( the_string ); when lower_case => return to_lower_case ( the_string ); when mix_case => return to_mix_case ( the_string ); when unchanged_case => return the_string; end case; end is_standardizing; end vhdl_lexicon_letter_style; @@//E*O*F vhdl_lexicon_letter_style__.a// chmod u=rw,g=,o= vhdl_lexicon_letter_style__.a echo x - vhdl_lexicon_scroll_style__.a sed 's/^@//' > "vhdl_lexicon_scroll_style__.a" <<'@//E*O*F vhdl_lexicon_scroll_style__.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- -- source: vhdl_lexicon_scroll_style__.a -- -- -- Purpose -- The package houses the procedure iterate_to_standard_output that preserves the shape of vhdl source code, while scrolling it to the output screen in a fixed number of rows per screen. No lexical unit except the comment line is separated. -- Assumptions and process overview -- Input: device = text_io.standard_input; -- data = vhdl (syntax) source code -- Output: device = text_io.standard_output -- data = text format defined by a scroll specification -- Note, there is no restriction on the line length = maximum characters per column -- The scroll specification is defined as ' -- shape specification -- see vhdl_lexicon_shape_style -- the_rows_per_screen -- positive; -- the_prompt_message -- string; -- Suggested use -- Use when creating tools that scrolls vhdl source code to a scroll specification with vhdl_lexicon_shape_style; package vhdl_lexicon_scroll_style is -- PASSIVE ITERATOR PROCEDURE -- procedure iterate_to_standard_output ( with_the_shape_specification: in vhdl_lexicon_shape_style.specification; with_the_rows_per_screen: in positive; the_prompt_message: in string; the_file_name: in string ); -- Effect: program's output is scrolled to the standard output with specifications defined in "with_the_shape_specification" in blocks of "with_the_rows_per_screen" number of lines -- INPUT device: standard input data: vhdl source code -- OUTPUT device: standard output data: vhdl source code with shape style defined by 'with_the_shape_specification' end vhdl_lexicon_scroll_style; ---------------------------------------------------------------- with vhdl_lexicon; with vhdl_lexicon_shape_style; with text_io; package body vhdl_lexicon_scroll_style is procedure iterate_to_standard_output ( with_the_shape_specification: in vhdl_lexicon_shape_style.specification; with_the_rows_per_screen: in positive; the_prompt_message: in string; the_file_name: in string ) is type type_external_in is record the_rows_per_screen: positive := with_the_rows_per_screen; the_file_variable: text_io.file_type; end record; type type_external_in_out is record the_row_counter: natural := 0; the_line: string ( 1 .. with_the_shape_specification.the_column_width + 2 ) := ( others => ' ' ); -- note the + 2 the_line_length: natural := 0; end record; the_external_data: type_external_in; the_external_data_in_out: type_external_in_out; procedure process ( -- external data -- the_external_in: in type_external_in; the_external_in_out: in out type_external_in_out; -- internal data: object being iterated -- the_value: in string; the_type: in vhdl_lexicon.element_type; the_subtype: in vhdl_lexicon.element_subtype; the_name: in vhdl_lexicon.element_name; continue: out boolean ); procedure shape_vhdl_code is new vhdl_lexicon_shape_style.iterate_with_parameters ( -- external instantiation -- external_type_in => type_external_in, external_type_in_out => type_external_in_out, -- internal instantiation -- process_lexical_element => process ); -- PROCEDURE process -- Note implicitly pass the constant: 'the_prompt_message' procedure process ( -- external data -- the_external_in: in type_external_in; the_external_in_out: in out type_external_in_out; -- internal data: object being iterated -- the_value: in string; the_type: in vhdl_lexicon.element_type; the_subtype: in vhdl_lexicon.element_subtype; the_name: in vhdl_lexicon.element_name; continue: out boolean ) is begin the_external_in_out.the_line ( the_external_in_out.the_line_length + 1 .. the_external_in_out.the_line_length + the_value'length ) := the_value; the_external_in_out.the_line_length := the_external_in_out.the_line_length + the_value'length; continue := true; -- if vhdl_lexicon."=" ( the_subtype, vhdl_lexicon.separator_end_of_line ) then text_io.put_line ( the_external_in_out.the_line ( 1 .. the_external_in_out.the_line_length - 1 ) ); -- NOTE USED TEXT_IO in place of vhdl_lexicon.put because terminal outputs one line in a smooth uniform manner with text_io; it 'jerks' (on some compilers ) with io subprograms in vhdl_lexicon. the_external_in_out.the_line_length := 0; -- count the row -- the_external_in_out.the_row_counter := natural'succ ( the_external_in_out.the_row_counter ); if the_external_in_out.the_row_counter = the_external_in.the_rows_per_screen then text_io.set_input ( text_io.standard_input ); if the_prompt_message'length > 0 then text_io.put_line ( the_prompt_message ); end if; text_io.skip_line; -- force a response from the user text_io.set_input ( the_external_in.the_file_variable ); the_external_in_out.the_row_counter := 0; end if; end if; end process; begin -- BEGIN MAIN PROGRAM -- text_io.open ( the_external_data.the_file_variable, text_io.in_file, the_file_name ); text_io.set_input ( the_external_data.the_file_variable ); -- iterate the ordered set of lexical elements shape_vhdl_code ( with_the_shape_specification => with_the_shape_specification, -- the data operator -- the_external_data_in => the_external_data, the_external_data_in_out => the_external_data_in_out ); text_io.set_input ( text_io.standard_input ); text_io.close ( the_external_data.the_file_variable ); exception when others => vhdl_lexicon.put ( "Error does file exist ? " & ( 1 => vhdl_lexicon.the_end_line_character ) ); end iterate_to_standard_output; end vhdl_lexicon_scroll_style; @@//E*O*F vhdl_lexicon_scroll_style__.a// chmod u=rw,g=,o= vhdl_lexicon_scroll_style__.a echo x - vhdl_lexicon_shape_style_.a sed 's/^@//' > "vhdl_lexicon_shape_style_.a" <<'@//E*O*F vhdl_lexicon_shape_style_.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- -- source: vhdl_lexicon_shape_style_.a -- -- Purpose -- Shape style refers to the specifications that govern the "form" of code. Precisely, these specifications with their default values are: -- the_column_width: positive := 80; -- the maximum number of characters in a row of code -- the_indent_margin: positive := 48; -- the maximum number of characters of an indention -- the_tab_set: positive := 3; -- code tabs to the nearest value in the set of tabs -- manage wrap arounds, ie extended oversized lines -- the_wrap_indent_length: natural := 1; -- the number of characters passed the indent of the line it is wrapping for non comment literal -- the_comment_wrap_string: string ( 1 .. 4 ) := "-- "; -- for comment lines the wrap line must also be a comment line -- the_comment_ragged_indent: natural := 14; -- the maximum number of character from the right end boundary that ones backup when looking for break character such as ' ' ',' '_' etc -- -- -- The main purpose is to impose a shape specification on vhdl source code. The process inputs vhdl source code and outputs vhdl source of a shape specification. Two tools ( passive iterators ) shape the code. -- Content -- Passive iterator with parameters: procedure iterate_with_parameters -- Passive iterator no parameters: procedure iterate_to_standard_output -- Two mechanisms that transfer shape specification ( values ) from a text file to a construct ( record of shape specification ). See below 'is_initializing'. with vhdl_lexicon; with text_io; package vhdl_lexicon_shape_style is -- DECLARE type to hold specification values -- subtype string_4 is string ( 1 .. 4 ); type specification is record the_column_width: positive := 80; the_indent_margin: positive := 48; the_tab_set: positive := 3; the_wrap_indent_length: natural := 1; -- -- for comment lines -- the_comment_ragged_indent: natural := 14; the_comment_wrap_string: string_4 := "-- "; end record; -- SELECTORS -- function is_initializing ( use_the_file_variable: in text_io.file_type := text_io.standard_input ) return specification; -- Effect: transfers the shape specification on text file to a record of type specification -- Assumption: The values of the shape specification on the text file appear in this consecutive line order: -- 80 -- the_column_width -- 48 -- the_indent_margin -- 3 -- the_tab_set -- 1 -- the_wrap_indent_length -- 14 -- the_comment_ragged_indent -- "-- " -- the first four characters becomes the_comment_wrap_string -- Assumption violation: all exceptions are promulgated function is_initializing ( use_the_file_name: in string ) return specification; -- Effect: opens the file "use_the_file_name", calls is_initializing ( formal parameter is of file_type ), closes the file -- Assumption: file exits and values of shape specification are properly ordered -- Assumption violation: all exceptions are promulgated -- PASSIVE ITERATOR -- procedure iterate_to_standard_output ( with_the_shape_specification: in specification ); -- Effect: program's output is the standard output with specifications defined in "with_the_shape_specification" -- INPUT device: standard input data: vhdl source code -- OUTPUT device: standard output data: vhdl source code with shape specification defined by 'with_the_shape_specification' -- PASSIVE ITERATOR WITH PARAMETERS -- generic -- external data -- type external_type_in is limited private; type external_type_in_out is limited private; with procedure process_lexical_element ( -- the external data -- the_data_in: in external_type_in; the_data_in_out: in out external_type_in_out; -- the iterate data -- the_value: in string; the_type: in vhdl_lexicon.element_type; the_subtype: in vhdl_lexicon.element_subtype; the_name: in vhdl_lexicon.element_name; continue: out boolean ); procedure iterate_with_parameters ( with_the_shape_specification: in specification; the_external_data_in: in external_type_in; the_external_data_in_out: in out external_type_in_out ); -- Effect: as the code is being shaped, the shaped lexical element are passed to procedure process_lexical_element -- Functions as an expansion filter where each input is an entry in the sequence of lexical elments and the output is one or more lexical elements passed to "process_lexical_element" -- INPUT device: standard input data: vhdl source code -- OUTPUT device: standard output data: vhdl source code with shape specification defined by 'with_the_shape_specification' end vhdl_lexicon_shape_style; @@//E*O*F vhdl_lexicon_shape_style_.a// chmod u=rw,g=,o= vhdl_lexicon_shape_style_.a echo x - vhdl_lexicon_shape_style__.a sed 's/^@//' > "vhdl_lexicon_shape_style__.a" <<'@//E*O*F vhdl_lexicon_shape_style__.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- source: vhdl_lexicon_shape_style__.a --------------------- package body vhdl_lexicon_shape_style --------------------- with text_io; with vhdl_lexicon; package body vhdl_lexicon_shape_style is type structure is record the_indent_margin: natural := 0; cursor: natural := 0; -- represents the last index of the line processed indent_continue: boolean := true; -- initializes the system continue: boolean := true; end record; -- DEFINE GENERIC PROCEDURE: processes each element --Note the procedure process_lexicon is not an iterator and interacts with the export -- Precisely, the construct ( generic procedure ) is an expansion filter, process_lexicon imports a lexical element and exports to export one or more lexical elements based on the prior input sequence. generic with procedure export ( -- the iterate data -- the_value: in string; the_type: in vhdl_lexicon.element_type; the_subtype: in vhdl_lexicon.element_subtype; the_name: in vhdl_lexicon.element_name; continue: out boolean ); procedure process_lexicon ( -- the external data -- the_specification: in vhdl_lexicon_shape_style.specification; the_value_of: in out structure; -- the iterate data -- the_value: in string; the_type: in vhdl_lexicon.element_type; the_subtype: in vhdl_lexicon.element_subtype; the_name: in vhdl_lexicon.element_name; continue: out boolean ); procedure process_lexicon ( -- the external data -- the_specification: in vhdl_lexicon_shape_style.specification; the_value_of: in out structure; -- the iterate data -- the_value: in string; the_type: in vhdl_lexicon.element_type; the_subtype: in vhdl_lexicon.element_subtype; the_name: in vhdl_lexicon.element_name; continue: out boolean ) is separate; -- SUBPROGRAMS -- --ITERATE_WITH_PARAMETERS -- procedure iterate_with_parameters ( with_the_shape_specification: in specification; the_external_data_in: in external_type_in; the_external_data_in_out: in out external_type_in_out ) is g_structure: structure; -- goal: instantiate generic procedure process_lexicon procedure pass_external_parameters ( the_value: in string; the_type: in vhdl_lexicon.element_type; the_subtype: in vhdl_lexicon.element_subtype; the_name: in vhdl_lexicon.element_name; continue: out boolean ); procedure create_shape is new process_lexicon ( export => pass_external_parameters ); procedure iterate_vhdl_code_with_shape_style is new vhdl_lexicon.iterate_vhdl_code_with_parameters ( external_type_in => specification, external_type_in_out => structure, process => create_shape ); procedure pass_external_parameters ( the_value: in string; the_type: in vhdl_lexicon.element_type; the_subtype: in vhdl_lexicon.element_subtype; the_name: in vhdl_lexicon.element_name; continue: out boolean ) is begin process_lexical_element ( -- formal parameters from the procedure iterate_with_parameters the_external_data_in, the_external_data_in_out, --iterate data -- the_value, the_type, the_subtype, the_name, continue ); end pass_external_parameters; begin iterate_vhdl_code_with_shape_style ( with_the_shape_specification, g_structure ); end iterate_with_parameters; -- iterate_to_standard_output -- procedure iterate_to_standard_output ( with_the_shape_specification: in specification ) is type type_null is record null; end record; the_value_null: type_null; procedure put ( -- the external data -- the_value_null_1: in type_null; the_value_null_2: in out type_null; -- the iterate data -- the_value: in string; the_type: in vhdl_lexicon.element_type; the_subtype: in vhdl_lexicon.element_subtype; the_name: in vhdl_lexicon.element_name; continue: out boolean ); procedure shape_code is new iterate_with_parameters ( external_type_in => type_null, external_type_in_out => type_null, process_lexical_element => put ); -- body of put -- procedure put ( -- the external data -- the_value_null_1: in type_null; the_value_null_2: in out type_null; -- the iterate data -- the_value: in string; the_type: in vhdl_lexicon.element_type; the_subtype: in vhdl_lexicon.element_subtype; the_name: in vhdl_lexicon.element_name; continue: out boolean ) is begin continue := true; vhdl_lexicon.put ( the_value ); end put; begin shape_code ( with_the_shape_specification, the_value_null, the_value_null ); end iterate_to_standard_output; -- IS_INITIALIZING -- function is_initializing ( use_the_file_variable: in text_io.file_type := text_io.standard_input ) return specification is package integer_io is new text_io.integer_io ( integer ); the_specification: specification; begin integer_io.get ( use_the_file_variable, the_specification.the_column_width ); text_io.skip_line ( use_the_file_variable ); integer_io.get ( use_the_file_variable, the_specification.the_indent_margin ); text_io.skip_line ( use_the_file_variable ); integer_io.get ( use_the_file_variable, the_specification.the_tab_set ); text_io.skip_line ( use_the_file_variable ); integer_io.get ( use_the_file_variable, the_specification.the_wrap_indent_length ); text_io.skip_line ( use_the_file_variable ); integer_io.get ( use_the_file_variable, the_specification.the_comment_ragged_indent ); text_io.skip_line ( use_the_file_variable ); text_io.get ( use_the_file_variable, the_specification.the_comment_wrap_string ); text_io.skip_line ( use_the_file_variable ); return the_specification; end is_initializing; function is_initializing ( use_the_file_name: in string ) return specification is -- Note: promulgate name error exception when the file is not found the_specification: specification; g_file_variable: text_io.file_type; begin text_io.open ( g_file_variable, text_io.in_file, use_the_file_name ); the_specification := is_initializing ( g_file_variable ); text_io.close ( g_file_variable ); return the_specification; end is_initializing; end vhdl_lexicon_shape_style; @@//E*O*F vhdl_lexicon_shape_style__.a// chmod u=rw,g=,o= vhdl_lexicon_shape_style__.a echo x - vhdl_lexicon_type_style__.a sed 's/^@//' > "vhdl_lexicon_type_style__.a" <<'@//E*O*F vhdl_lexicon_type_style__.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- source: vhdl_lexicon_type_style__.a -- code type: package vhdl_lexicon_type_style -- -- -- Purpose -- Type style defines the type set of a letter on paper, and typically consists of numerous variations of the standard type set of roman, bold, and italics. -- The main purpose is to standardize the type style of vhdl source code to a postscript program. Precisely, the objective is provide a passive iterator over a sequence of vhdl lexical elements that uniformizes the type style of objects of each lexical element category. See procedure iterate. with vhdl_lexicon; with text_io; package vhdl_lexicon_type_style is -- TYPE -- type selection is ( roman, bold, italics ); subtype selection_identifiers is string ( 1 .. 5 ); selection_begin: constant array ( selection ) of selection_identifiers := ( roman => " F3 (", bold => " F1 (", italics => " F2 (" ); selection_end: constant string := ") S"; type specification is array ( vhdl_lexicon.element_subtype ) of selection; type selection_limited_private is limited private; -- SELECTORS -- function is_initializing ( use_the_file_type: in text_io.file_type ) return specification; -- Effect: transfers the type style selections on the text file to the specification ( array ) -- Assumption: The values of the type selection on the text file appear in this consecutive line order as shown below on a sample text file: -- bold -- identifier_reserved ( line 1 ) -- roman -- identifier_not_reserved ( line 2 ) -- italics -- literal_abstract_decimal ( line 3 ) -- italics -- literal_abstract_based ( line 4 ) -- italics -- literal_bit_string ( line 5 ) -- italics -- literal_character_lexical subtype ( line 6 ) -- italics -- literal string_lexical subtype ( line 7 ) -- italics -- comment_lexical_subtype ( line 8 ) -- roman -- delimiter_single_lexical_subtype ( line 9 ) -- roman -- delimiter_double_lexical_subtype ( line 10 ) -- **Note there must be exactly 9 lines -- Assumption violation: all exceptions are promulgated function is_initializing ( use_the_file_name: in string ) return specification; -- Effect: opens the file "use_the_file_name", calls is_initializing ( formal parameter is of file_type ), closes the file -- Assumption: file exits and values are of type selection -- Assumption violation: all exceptions are promulgated -- CONSTRUCTORS -- procedure iterate_code ( with_the_specification: in specification ); -- INPUT device: text_io.standard_input data: vhdl source code ( text ) -- OUTPUT device: text_io.standard_output data: postscript text -- EFFECT: each object of each lexical subtype category is of the same type as specified in "with_the_specification" -- ASSUMPTION: it is assumed that the appropriate postscript header instructions has been outputted before the execution of iterate_code. These instructions are coordinated with the code in 'iterate_code' and 'put_postscript'. procedure put_postscript ( -- external parameters -- the_selection_map: in specification; the_current: in out selection_limited_private; -- iterate data the_value: in string; the_type: in vhdl_lexicon.element_type; the_subtype: in vhdl_lexicon.element_subtype; the_name: in vhdl_lexicon.element_name; continue: out boolean ); -- USAGE: when incorporating 'put_postscript' in a passive iterate over a sequence of lexical elements use this format: -- output of postscript header instructions -- put_postscript_start_line_type; -- see procedure in this package -- passive iterator using put_postscript procedure put_postscript_start_line_type; -- This specialized procedure outputs the start of a postscript line and the start type value of selection'first. private type selection_limited_private is record the_value: selection := selection'first; end record; end vhdl_lexicon_type_style; --------------------- package body vhdl_lexicon_type_style --------------------- with text_io; with vhdl_lexicon; package body vhdl_lexicon_type_style is -- RENAME EQUALITY OPERATORS -- function "=" ( the_left: in vhdl_lexicon.element_name; the_right: in vhdl_lexicon.element_name ) return boolean renames vhdl_lexicon."="; function "=" ( the_left: in vhdl_lexicon.element_subtype; the_right: in vhdl_lexicon.element_subtype ) return boolean renames vhdl_lexicon."="; -- POSTSCRIPT UTILITES : output_start_line, output_file_end -- -- define variables type y_units is new natural; the_y_upper_bound: constant y_units := 744; the_new_page_bound: constant y_units := 34; the_y_decrement_size: constant y_units := 11; -- these constraint values allow at most 65 lines per page g_current_y_value: y_units := the_y_upper_bound + the_y_decrement_size; package y_units_io is new text_io.integer_io ( y_units ); g_line_counter: natural := 0; procedure output_start_line is -- see postscript manual for explanation of details the_string_value: string ( 1 .. 3 ) := "000"; begin if g_current_y_value <= the_new_page_bound then vhdl_lexicon.put ( "showpage" ); vhdl_lexicon.put ( ( 1 => vhdl_lexicon.the_end_line_character ) ); vhdl_lexicon.put ( ( 1 => vhdl_lexicon.the_end_line_character ) ); vhdl_lexicon.put ( "P+" ); vhdl_lexicon.put ( ( 1 => vhdl_lexicon.the_end_line_character ) ); g_current_y_value := the_y_upper_bound + the_y_decrement_size; -- reset counter end if; g_current_y_value := g_current_y_value - the_y_decrement_size; y_units_io.put ( item => g_current_y_value, base => 10, to => the_string_value ) ; vhdl_lexicon.put ( "0 " & the_string_value & " M" ); end output_start_line; procedure output_file_end is begin vhdl_lexicon.put ( ( 1 => vhdl_lexicon.the_end_line_character ) ); vhdl_lexicon.put ( "showpage" ); vhdl_lexicon.put ( ( 1 => vhdl_lexicon.the_end_line_character ) ); vhdl_lexicon.put ( ( 1 => vhdl_lexicon.the_end_file_character ) ); -- recall closing a file puts an end_page_character end output_file_end; -- END POSTSCRIPT UTILITES : output_start_line, output_file_end -- -- SUBPROGRAMS -- function is_initializing ( use_the_file_name: in string ) return specification is -- Note: promulgate name error exception when the file is not found the_specification: specification := ( others => selection'first); g_file_variable: text_io.file_type; begin text_io.open ( g_file_variable, text_io.in_file, use_the_file_name ); the_specification := is_initializing ( g_file_variable ); text_io.close ( g_file_variable ); return the_specification; end is_initializing; function is_initializing ( use_the_file_type: in text_io.file_type ) return specification is the_specification: specification := ( others => selection'first ); package selection_io is new text_io.enumeration_io ( selection ); begin selection_io.get ( use_the_file_type, the_specification ( vhdl_lexicon.identifier_reserved ) ); text_io.skip_line ( use_the_file_type ); selection_io.get ( use_the_file_type, the_specification ( vhdl_lexicon.identifier_not_reserved ) ); text_io.skip_line ( use_the_file_type ); selection_io.get ( use_the_file_type, the_specification ( vhdl_lexicon.literal_abstract_decimal ) ); text_io.skip_line ( use_the_file_type ); selection_io.get ( use_the_file_type, the_specification ( vhdl_lexicon.literal_abstract_based ) ); text_io.skip_line ( use_the_file_type ); selection_io.get ( use_the_file_type, the_specification ( vhdl_lexicon.literal_bit_string ) ); text_io.skip_line ( use_the_file_type ); selection_io.get ( use_the_file_type, the_specification ( vhdl_lexicon.literal_character ) ); text_io.skip_line ( use_the_file_type ); selection_io.get ( use_the_file_type, the_specification ( vhdl_lexicon.literal_string ) ); text_io.skip_line ( use_the_file_type ); selection_io.get ( use_the_file_type, the_specification ( vhdl_lexicon.comment ) ); text_io.skip_line ( use_the_file_type ); selection_io.get ( use_the_file_type, the_specification ( vhdl_lexicon.delimiter_single ) ); text_io.skip_line ( use_the_file_type ); selection_io.get ( use_the_file_type, the_specification ( vhdl_lexicon.delimiter_double ) ); text_io.skip_line ( use_the_file_type ); return the_specification; end is_initializing; -- POSTSCRIPT CODE -- -- PUT_POSTSCRIPT_START_LINE_TYPE procedure put_postscript_start_line_type is begin output_start_line; vhdl_lexicon.put ( selection_begin ( selection'first)); end put_postscript_start_line_type; -- PUT_POSTSCRIPT procedure put_postscript ( -- external parameters -- the_selection_map: in specification; the_current: in out selection_limited_private; -- iterate data the_value: in string; the_type: in vhdl_lexicon.element_type; the_subtype: in vhdl_lexicon.element_subtype; the_name: in vhdl_lexicon.element_name; continue: out boolean ) is function is_formating ( the_value: in string ) return string is -- Effect: inserts a backslash'\' before each parenthesis ')' | '(' for postscript syntax reasons function is_building ( the_current_index: in natural ) return string is begin if the_current_index > the_value'last then return ""; else for each_index in the_current_index .. the_value'last loop if the_value ( each_index ) = '(' or the_value ( each_index ) = ')' then return the_value ( the_current_index .. each_index - 1 ) & ( ( 1=> '\', 2 => the_value ( each_index ) ) ) & is_building ( natural'succ ( each_index ) ); end if; end loop; return the_value ( the_current_index .. the_value'last ); end if; end is_building; begin if the_value'length > 0 and the_value ( the_value'first ) /= '(' and the_value ( the_value'first ) /= ')' then return is_building ( the_value'first ); else return ( ( 1 => '\', 2 => the_value ( the_value'first ) ) ) & is_building ( the_value'first + 1 ); end if; end is_formating; begin -- BEGIN -- Design strategy: Whenever a change of selection occurs, end the current selection on this line and start the new selection on the next line. -- Whenever the textual end line is encountered, start a new selection.line continue := true; -- continue the iteration -- Special case whenever the value is a parenthesis -- use type vhdl_lexicon.element_name if the_name = vhdl_lexicon.left_parenthesis or the_name = vhdl_lexicon.right_parenthesis then if the_current.the_value /= the_selection_map ( the_subtype ) then -- end the current selection and start the next selection on a new textual line the_current.the_value := the_selection_map ( the_subtype ); vhdl_lexicon.put ( selection_end & ( 1 => vhdl_lexicon.the_end_line_character ) & selection_begin ( the_current.the_value )); end if; vhdl_lexicon.put ( "\" & the_value ); return; -- RETURN end if; -- manage all other conditions with type vhdl_lexicon.element_subtype case the_subtype is when vhdl_lexicon.separator_end_of_line => -- end a selection.line and start a new postscript line vhdl_lexicon.put ( selection_end & the_value ); output_start_line; the_current.the_value := the_selection_map ( vhdl_lexicon.delimiter_single) ; vhdl_lexicon.put ( selection_begin ( the_current.the_value ) ); when vhdl_lexicon.separator_end_of_page => null; when vhdl_lexicon.separator_end_of_file => vhdl_lexicon.put ( selection_end & ( 1 => vhdl_lexicon.the_end_line_character ) ); output_file_end; when vhdl_lexicon.comment | vhdl_lexicon.literal_character | vhdl_lexicon.literal_string => if the_current.the_value /= the_selection_map ( the_subtype ) then the_current.the_value := the_selection_map ( the_subtype ); vhdl_lexicon.put ( selection_end & ( 1 => vhdl_lexicon.the_end_line_character ) & selection_begin ( the_current.the_value )); end if; vhdl_lexicon.put ( is_formating ( the_value ) ); when others => if the_current.the_value /= the_selection_map ( the_subtype ) then the_current.the_value := the_selection_map ( the_subtype ); vhdl_lexicon.put ( selection_end & ( 1 => vhdl_lexicon.the_end_line_character ) & selection_begin ( the_current.the_value ) ); end if; vhdl_lexicon.put ( the_value ); end case; end put_postscript; procedure iterate_code ( with_the_specification: in specification ) is g_current_selection: selection_limited_private; procedure iterate_vhdl_code_with_selection is new vhdl_lexicon.iterate_vhdl_code_with_parameters ( external_type_in => specification, external_type_in_out => selection_limited_private, process => put_postscript ); begin output_start_line; vhdl_lexicon.put ( selection_begin ( selection'first ) ); iterate_vhdl_code_with_selection ( with_the_specification, g_current_selection ); end iterate_code; end vhdl_lexicon_type_style; @@//E*O*F vhdl_lexicon_type_style__.a// chmod u=rw,g=,o= vhdl_lexicon_type_style__.a echo x - vhdl_name_.a sed 's/^@//' > "vhdl_name_.a" <<'@//E*O*F vhdl_name_.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- source: vhdl_name_.a -- with vhdl_lexicon; package vhdl_name is subtype reserve_word is vhdl_lexicon.element_name range vhdl_lexicon.abs_id .. vhdl_lexicon.xor_id; subtype single_delimiter is vhdl_lexicon.element_name range vhdl_lexicon.ampersand .. vhdl_lexicon.vertical_bar; subtype compound_delimiter is vhdl_lexicon.element_name range vhdl_lexicon.arrow ..vhdl_lexicon. box; subtype separator is vhdl_lexicon.element_name range vhdl_lexicon.horizontal_tab .. vhdl_lexicon.end_file; -- SELECTORS function is_compound_delimiter ( the_value: in string ) return boolean; function compound_delimiter_name_is return compound_delimiter; -- Exception: raise lexical_name_is_not_known when compound_delimiter_name is not defined function is_single_delimiter ( the_character: in character ) return boolean ; function single_delimiter_name_is return single_delimiter; -- Exception: raise lexical_name_is_not_known when single_delimiter_name is not defined function is_separator ( the_character: in character ) return boolean; function separator_name_is return separator; -- Exception: raise lexical_name_is_not_known when separator_name is not defined -- RESERVE WORD MANAGEMENT function is_reserve_word ( the_value: in string ) return boolean; function reserve_word_name_is return reserve_word; -- Exception: raise lexical_name_is_not_known when reserve_word_is_not_present -- EXCEPTIONS lexical_name_is_not_known: exception; end vhdl_name; @@//E*O*F vhdl_name_.a// chmod u=rw,g=,o= vhdl_name_.a echo x - vhdl_name__.a sed 's/^@//' > "vhdl_name__.a" <<'@//E*O*F vhdl_name__.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- source: vhdl_name__.a with text_io; with vhdl_lexicon; with transliterate_gn; package body vhdl_name is function "=" ( the_left: in vhdl_lexicon.element_name; the_right: in vhdl_lexicon.element_name ) return boolean renames vhdl_lexicon."="; -- ESTABLISH DELIMITER generic package type single_delimiter_array is array ( single_delimiter ) of character; ar_single_delimiter: single_delimiter_array := ( vhdl_lexicon.ampersand =>'&', vhdl_lexicon.apostrophe => ''', vhdl_lexicon.left_parenthesis =>'(', vhdl_lexicon.right_parenthesis =>')', vhdl_lexicon.star =>'*', vhdl_lexicon.plus => '+', vhdl_lexicon.comma => ',', vhdl_lexicon.hyphen => '-', vhdl_lexicon.dot =>'.', vhdl_lexicon.slash =>'/', vhdl_lexicon.colon =>':', vhdl_lexicon.semicolon =>';', vhdl_lexicon.less_than => '<', vhdl_lexicon.equal => '=', vhdl_lexicon.greater_than => '>', vhdl_lexicon.vertical_bar =>'|'); package transliterate_single_delimiter is new transliterate_gn ( item => character, enum => single_delimiter, array_range_enum => single_delimiter_array, array_values => ar_single_delimiter, equal => "=" ); -- ESTABLISH COMPOUND DELIMITER generic package subtype string_2 is string ( 1 .. 2 ); type compound_delimiter_ar_type is array ( compound_delimiter ) of string_2; ar_compound_delimiter: compound_delimiter_ar_type := ( vhdl_lexicon.arrow => "=>", vhdl_lexicon.double_star => "**", vhdl_lexicon.assignment_variable => ":=", vhdl_lexicon.inequality => "/=", vhdl_lexicon.greater_than_equal => ">=", vhdl_lexicon.less_than_equal => "<=", vhdl_lexicon.box=> "<>" ); package transliterate_compound_delimiter is new transliterate_gn ( item => string_2, enum => compound_delimiter, array_range_enum => compound_delimiter_ar_type, array_values => ar_compound_delimiter, equal => "=" ); -- ESTABLISH SEPARATOR generic package type separator_ar_type is array ( separator ) of character; ar_separator: separator_ar_type := ( vhdl_lexicon.horizontal_tab => ascii.ht, vhdl_lexicon.vertical_tab => ascii.vt, vhdl_lexicon.carriage_return => ascii.cr, vhdl_lexicon.line_feed => ascii.lf, vhdl_lexicon.form_feed => ascii.ff, vhdl_lexicon.space_character => ' ', vhdl_lexicon.end_file => ascii.eot ); package transliterate_separator is new transliterate_gn ( item => character, enum => separator, array_range_enum => separator_ar_type, array_values => ar_separator, equal => "=" ); package element_name_io is new text_io.enumeration_io ( vhdl_lexicon.element_name ); -- OBJECTS g_reserve_word_name: reserve_word; g_reserve_word_name_valid: boolean := false; -- function is_reserve_word ( the_value: in string ) return boolean is length: natural; begin element_name_io.get ( from => the_value & "_id", item => g_reserve_word_name, last => length ); for value in reserve_word loop if value = g_reserve_word_name then g_reserve_word_name := value; g_reserve_word_name_valid := true; return true; end if; end loop; exception when text_io.data_error => g_reserve_word_name_valid := false; return false; end is_reserve_word; function reserve_word_name_is return reserve_word is begin if g_reserve_word_name_valid then return g_reserve_word_name; else raise lexical_name_is_not_known; end if; end reserve_word_name_is; -- function is_compound_delimiter ( the_value: in string ) return boolean is begin if the_value'length = 2 then return transliterate_compound_delimiter.is_a_member ( the_value ); end if; return false; end is_compound_delimiter; function compound_delimiter_name_is return compound_delimiter is begin return transliterate_compound_delimiter.value_is; exception when transliterate_compound_delimiter.no_value_exception => raise lexical_name_is_not_known; end compound_delimiter_name_is; -- function is_single_delimiter ( the_character: in character ) return boolean is begin return transliterate_single_delimiter.is_a_member ( the_character ); end is_single_delimiter; function single_delimiter_name_is return single_delimiter is begin return transliterate_single_delimiter.value_is; exception when transliterate_single_delimiter.no_value_exception => raise lexical_name_is_not_known; end single_delimiter_name_is; -- function is_separator ( the_character: in character ) return boolean is begin return transliterate_separator.is_a_member ( the_character ); end; function separator_name_is return separator is begin return transliterate_separator.value_is; exception when transliterate_separator.no_value_exception => raise lexical_name_is_not_known; end separator_name_is; end vhdl_name; @@//E*O*F vhdl_name__.a// chmod u=rw,g=,o= vhdl_name__.a echo x - vhdl_scroll_set_style.a sed 's/^@//' > "vhdl_scroll_set_style.a" <<'@//E*O*F vhdl_scroll_set_style.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- -- Purpose -- The procedure vhdl_scroll_set_style preserves the shape style of vhdl source, while scrolling the vhdl code to the screen in a fixed number of rows per screen. No lexical unit except the comment line is separated. -- The scroll style of an vhdl source code consist of these specifications: the_column_width, the_indent_margin, the_tab_set, the_wrap_indent_length, the_comment_ragged_indent, and the_comment_wrap_string ( length exactly 4 characters ), the_rows_per_screen, the_prompt_message; -- The purpose of the procedure vhdl_scroll_set_style is to provide a mechanism that assigns values to the shape specifications without recompiling code. -- Assumptions and process overview -- Input: device = text_io.standard_input; -- data = vhdl_lexicon_shape_style.specifciation + rows_per_screen -- + prompt_message + vhdl (syntax) source code -- Output: device = text_io.standard_output -- data = text format with these specifications below -- -- Process: see purpose; below are the default values of the scroll specifications -- the_column_width = 80, -- the_indent_margin = 48, -- the_tab_set = 3, -- the_wrap_indent_length = 1, -- the_comment_ragged_indent = 14, -- the_comment_wrap_string = "-- ", -- the_rows_per_screen = 23, -- the_prompt_message = string = "" -- CONSTRAINT: the values must satisfy these equations -- the_wrap_indent_length <= the_tab_set and -- the_tab_set <= the_indent_margin and -- the_indent_margin < 3 + the_column_width - the_comment_wrap_string'length -- NOTE: A violation of the above constraint outputs an empty file. -- Design decision and organizations -- Used the construct, passive iterator with parameters, located in the package vhdl_lexicon_shape_style. with vhdl_lexicon; with vhdl_lexicon_shape_style; with vhdl_lexicon_scroll_style; with text_io; procedure vhdl_scroll_set_style is package positive_io is new text_io.integer_io ( positive ); function next_string_value_is return string is the_string: string ( 1 .. 1 ) := ( others => ' ' ); begin if text_io.end_of_line then text_io.skip_line; return ""; else text_io.get ( the_string ( 1 ) ); return the_string & next_string_value_is; end if; end next_string_value_is; function the_rows_per_screen_is return natural is the_rows_per_screen: natural := 23; begin positive_io.get ( the_rows_per_screen ); text_io.skip_line; return the_rows_per_screen; end the_rows_per_screen_is; begin -- the order of input is fixed and must be followed vhdl_lexicon_scroll_style.iterate_to_standard_output ( with_the_shape_specification => vhdl_lexicon_shape_style.is_initializing ( text_io.standard_input ), with_the_rows_per_screen => the_rows_per_screen_is, the_prompt_message => next_string_value_is, the_file_name => next_string_value_is ); exception when others => vhdl_lexicon.put ( "Error does the file exist ? " & ( 1 => vhdl_lexicon.the_end_line_character ) ); end vhdl_scroll_set_style; @@//E*O*F vhdl_scroll_set_style.a// chmod u=rw,g=,o= vhdl_scroll_set_style.a echo x - vhdl_separate_shape_style_.a sed 's/^@//' > "vhdl_separate_shape_style_.a" <<'@//E*O*F vhdl_separate_shape_style_.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- source: separate_process_lexicon separate ( vhdl_lexicon_shape_style ) procedure process_lexicon ( -- the external data -- the_specification: in vhdl_lexicon_shape_style.specification; the_value_of: in out structure; -- the iterate data -- the_value: in string; the_type: in vhdl_lexicon.element_type; the_subtype: in vhdl_lexicon.element_subtype; the_name: in vhdl_lexicon.element_name; continue: out boolean ) is -- TYPES, OBJECTS FOR RIGHT ADJUSTING COMMENT LINES -- type word_separators is array ( character ) of boolean; is_word_separator: word_separators := word_separators'( 'a' .. 'z' => false, 'A' .. 'Z' => false, '0' .. '9' => false, others => true ); -- RENAME THE equality OPERATOR function "=" ( the_left: in vhdl_lexicon.element_subtype; the_right: in vhdl_lexicon.element_subtype ) return boolean renames vhdl_lexicon."="; function "=" ( the_left: in vhdl_lexicon.element_name; the_right: in vhdl_lexicon.element_name ) return boolean renames vhdl_lexicon."="; terminate_iteration: exception; ---------------------------------- C O D E ---------------------------------- --- UTILITY PROCEDURES: -- IS_EXPANDING_TABS function is_expanding_tabs ( the_string: in string ) return string is function expanding ( the_index: in natural ) return string is begin if the_index > the_string'last then return ""; elsif the_string ( the_index ) /= ascii.ht then return ( 1 => the_string (the_index ) ) & expanding ( the_index + 1 ); else return ( ( 1 .. 1 + the_specification.the_tab_set - ( ( the_index ) mod the_specification.the_tab_set ) => ' ' ) ) & expanding ( the_index + 1 ); end if; end expanding; begin return expanding ( the_string'first ); end is_expanding_tabs; -- CONTINUE_ITERATION -- check for termination of the 'procedure process ' procedure continue_iteration ( the_export_state: in boolean := true ) is begin if not the_export_state then raise terminate_iteration; end if; end continue_iteration; -- CURRENT_TOKEN -- begins -- EXPORT_END_OF_LINE -- export utilities: NOTE: post cond: the_value_of.cursor = 0 procedure export_end_of_line is begin export ( ( 1 => vhdl_lexicon.the_end_line_character ), vhdl_lexicon.separator, vhdl_lexicon.separator_end_of_line, vhdl_lexicon.line_feed, the_value_of.continue ); the_value_of.cursor := 0; continue_iteration ( the_export_state => the_value_of.continue); end export_end_of_line; -- EXPORT_SPACE_CHARACTERS procedure export_space_characters ( the_number: in natural := 0 ) is the_blank_line: string ( 1 .. the_number ) := ( others => ' ' ); begin if the_number > 0 then export ( the_blank_line, vhdl_lexicon.separator, vhdl_lexicon.separator_format_effector, vhdl_lexicon.space_character, the_value_of.continue ); continue_iteration ( the_export_state => the_value_of.continue); end if; end export_space_characters; -- ADJUST_LINE_BOUNDARY -- Assumption: range of the_cursor - the_specification.the_comment_ragged_indent + 1 .. the_cursor + 1 is defined via 'the_value' function adjust_line_boundary ( the_cursor: in natural ) return natural is begin if not is_word_separator ( the_value ( the_cursor + 1 ) ) then for index in 0 .. the_specification.the_comment_ragged_indent - 1 loop if is_word_separator ( the_value ( the_cursor - index ) ) then return the_cursor - index; end if; end loop; end if; return the_cursor; end adjust_line_boundary; -- MANAGE_EXTENDED_IDENTIFIER procedure manage_extended_identifier ( the_value: in string ) is the_length: natural := the_specification.the_column_width; the_left: natural := the_value'first; begin if the_value_of.cursor > 0 then export_end_of_line; end if; while the_left <= the_value'last loop if the_left + the_specification.the_column_width - 1 >= the_value'last then the_length := the_value'last - the_left + 1; end if; export ( the_value ( the_left .. the_left + the_length - 1 ), the_type, the_subtype, the_name, the_value_of.continue ); continue_iteration ( the_export_state => the_value_of.continue); export_end_of_line; the_left := the_length + the_left; end loop; end manage_extended_identifier; -- MANAGE_EXTENDED_COMMENT_LINE -- Assumption: processing begins on a new line procedure manage_extended_comment_line ( the_item: in string ) is the_interval_right: natural := the_item'first + the_specification.the_column_width -1 - the_value_of.the_indent_margin; the_interval_left: natural := the_item'first; begin export_space_characters ( the_value_of.the_indent_margin ); if the_interval_right < the_item'last then the_interval_right := adjust_line_boundary ( the_interval_right ); else the_interval_right := the_item'last; end if; export ( the_item ( the_interval_left .. the_interval_right ), the_type, the_subtype, the_name, the_value_of.continue ); process_loop: loop continue_iteration ( the_export_state => the_value_of.continue); the_interval_left := the_interval_right + 1; -- pass_blank_loop: loop exit process_loop when the_interval_left > the_item'last; -- pass space characters, check to see if the comment line is completed exit pass_blank_loop when the_item ( the_interval_left ) /= ' '; the_interval_left := natural'succ ( the_interval_left ); end loop pass_blank_loop; export_end_of_line; the_interval_right := the_interval_left + the_specification.the_column_width - the_value_of.the_indent_margin - 1 - the_specification.the_comment_wrap_string'length; if the_interval_right < the_item'last then the_interval_right := adjust_line_boundary ( the_interval_right ); else the_interval_right := the_item'last; end if; export_space_characters ( the_value_of.the_indent_margin ); export ( the_specification.the_comment_wrap_string & the_item ( the_interval_left .. the_interval_right ), the_type, the_subtype, the_name, the_value_of.continue ); end loop process_loop; -- the language syntax guarantees the next lexical elment is an end of line terminator; end manage_extended_comment_line; -- PROCESS procedure process ( the_value: in string ) is begin -- -- ESTABLISH THE INDENT MARGIN if the_value_of.indent_continue then if the_name = vhdl_lexicon.space_character then the_value_of.cursor := natural'succ ( the_value_of.cursor ); return; -- call to process next element elsif the_name = vhdl_lexicon.horizontal_tab then -- note the tab has been expanded to a string of space characters the_value_of.cursor := the_value_of.cursor + the_value'length; return; -- call to process next element else if the_value_of.cursor > the_specification.the_indent_margin then the_value_of.cursor := the_specification.the_indent_margin; end if; the_value_of.the_indent_margin := the_value_of.cursor; the_value_of.indent_continue := false; end if; end if; -- CHECK FOR END OF LINE OR END OF FILE if the_subtype = vhdl_lexicon.separator_end_of_line or the_subtype = vhdl_lexicon.separator_end_of_file then the_value_of.indent_continue := true; the_value_of.the_indent_margin := 0; the_value_of.cursor := 0; export ( the_value, the_type, the_subtype, the_name, the_value_of.continue ); return; -- call to process next element end if; -- PROCESS THE VALUE: 3 cases -- CASE 1: value fits on the line if the_value_of.cursor + the_value'length <= the_specification.the_column_width then if the_value_of.cursor = the_value_of.the_indent_margin then -- put the indent margin export_space_characters ( the_value_of.the_indent_margin ); end if; export ( the_value, the_type, the_subtype, the_name, the_value_of.continue ); continue_iteration ( the_export_state => the_value_of.continue); the_value_of.cursor := the_value_of.cursor + the_value'length; return; -- call to process next element end if; -- CASE 2: value fits does not fit on the current but will fit on the next line -- if type is not a graphic type ( effector or space character ) then process the next lexical element if the_name in vhdl_lexicon.horizontal_tab .. vhdl_lexicon.space_character then return; elsif the_value_of.the_indent_margin < the_value_of.cursor then -- data exits on the current line, output it export_end_of_line; end if; if the_value_of.the_indent_margin + the_specification.the_wrap_indent_length + the_value'length <= the_specification.the_column_width then export_space_characters ( the_value_of.the_indent_margin + the_specification.the_wrap_indent_length ); export ( the_value, the_type, the_subtype, the_name, the_value_of.continue ); continue_iteration ( the_export_state => the_value_of.continue); the_value_of.cursor := the_value_of.the_indent_margin + the_specification.the_wrap_indent_length + the_value'length; return; -- call to process next element elsif the_value'length <= the_specification.the_column_width and then the_subtype /= vhdl_lexicon.comment then export_space_characters ( the_specification.the_column_width - the_value'length ); export ( the_value, the_type, the_subtype, the_name, the_value_of.continue ); continue_iteration ( the_export_state => the_value_of.continue); export_end_of_line; -- line is completed the_value_of.cursor := the_value_of.the_indent_margin; -- preserve the indent margin return; -- call to process next element end if; -- CASE 3: value exceeds the column bound if the_subtype = vhdl_lexicon.comment then manage_extended_comment_line ( the_value ); else manage_extended_identifier ( the_value ); the_value_of.cursor := the_value_of.the_indent_margin; -- preserve the indent margin end if; end process; begin -- CURRENT TOKEN CODE continue := true; if the_name = vhdl_lexicon.horizontal_tab then process ( ( 1 .. the_specification.the_tab_set - ( the_value_of.cursor mod the_specification.the_tab_set ) => ' ' ) ); elsif the_subtype = vhdl_lexicon.comment then process ( is_expanding_tabs ( the_value ) ); else process ( the_value ); end if; exception when terminate_iteration => continue := false; end process_lexicon; @@//E*O*F vhdl_separate_shape_style_.a// chmod u=rw,g=,o= vhdl_separate_shape_style_.a echo x - vhdl_shape_set_style.a sed 's/^@//' > "vhdl_shape_set_style.a" <<'@//E*O*F vhdl_shape_set_style.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- -- source: vhdl_shape_set_style.a -- -- Purpose -- The purpose of the procedure vhdl_shape_set_style is to allow one to change the shape specification of vhdl source code without recompiling code. -- Assumptions and process overview -- Input: device = text_io.standard_input; -- data = shape specification + vhdl (syntax) source code -- Output: device = text_io.standard_output -- data = text format with input shape specification -- Assumptions: the vhdl_lexicon_shape_style.is_initializing defines the required format of the 'shape specification' -- Suggested use -- Change the shape_style without recompiling source code with text_io; with vhdl_lexicon; with vhdl_lexicon_shape_style; procedure vhdl_shape_set_style is begin -- MAIN CODE -- vhdl_lexicon_shape_style.iterate_to_standard_output ( with_the_shape_specification => vhdl_lexicon_shape_style.is_initializing ( text_io.standard_input ) ); exception when others => vhdl_lexicon.put ( "Error does file exist ? " & ( 1 => vhdl_lexicon.the_end_line_character ) ); end vhdl_shape_set_style; @@//E*O*F vhdl_shape_set_style.a// chmod u=rw,g=,o= vhdl_shape_set_style.a echo x - vhdl_shape_type_standard.a sed 's/^@//' > "vhdl_shape_type_standard.a" <<'@//E*O*F vhdl_shape_type_standard.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- -- source: vhdl_shape_type_standard.a -- code type: procedure vhdl_shape_type_standard -- Purpose -- The procedure simultaneously ( one pass ) shapes and postscripts vhdl source code. -- This is an efficient method of preparing text for a postscript format with vhdl_lexicon; with vhdl_lexicon_shape_style; with vhdl_lexicon_type_style; procedure vhdl_shape_type_standard is procedure shape_type_standard_vhdl_code is new vhdl_lexicon_shape_style.iterate_with_parameters ( external_type_in => vhdl_lexicon_type_style.specification, external_type_in_out => vhdl_lexicon_type_style.selection_limited_private, process_lexical_element => vhdl_lexicon_type_style.put_postscript ); the_current_type_specification: vhdl_lexicon_type_style.selection_limited_private; begin vhdl_lexicon_type_style.put_postscript_start_line_type; shape_type_standard_vhdl_code ( with_the_shape_specification => -- specifies the_shape_style ( the_column_width => 94, the_indent_margin => 48, the_tab_set => 3, the_wrap_indent_length => 1, the_comment_ragged_indent => 14, the_comment_wrap_string => "-- " ), the_external_data_in => -- specifies the_type_style ( vhdl_lexicon.identifier_reserved => vhdl_lexicon_type_style.bold, vhdl_lexicon.identifier_not_reserved => vhdl_lexicon_type_style.roman, vhdl_lexicon.literal_abstract_decimal => vhdl_lexicon_type_style.italics, vhdl_lexicon.literal_abstract_based => vhdl_lexicon_type_style.italics, vhdl_lexicon.literal_bit_string => vhdl_lexicon_type_style.italics, vhdl_lexicon.literal_character => vhdl_lexicon_type_style.italics, vhdl_lexicon.literal_string => vhdl_lexicon_type_style.roman, vhdl_lexicon.comment => vhdl_lexicon_type_style.italics, vhdl_lexicon.delimiter_single => vhdl_lexicon_type_style.roman, vhdl_lexicon.delimiter_double => vhdl_lexicon_type_style.roman, vhdl_lexicon.separator_end_of_file => vhdl_lexicon_type_style.roman, vhdl_lexicon.separator_end_of_page => vhdl_lexicon_type_style.roman, vhdl_lexicon.separator_end_of_line => vhdl_lexicon_type_style.roman, vhdl_lexicon.separator_format_effector => vhdl_lexicon_type_style.roman ), the_external_data_in_out => the_current_type_specification ); end vhdl_shape_type_standard; @@//E*O*F vhdl_shape_type_standard.a// chmod u=rw,g=,o= vhdl_shape_type_standard.a echo x - vhdl_type_set_style.a sed 's/^@//' > "vhdl_type_set_style.a" <<'@//E*O*F vhdl_type_set_style.a//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- -- source: vhdl_type_set_style.a -- code type: procedure vhdl_type_set_style -- Purpose -- The procedure prints each lexical element of an vhdl source code to a specified postscript type style. The type styles are in a enumerated list, see vhdl_lexicon_type_style.selection -- Assumptions and process overview -- Input: device = text_io.standard_input; -- data = specification_file + vhdl (syntax) source code -- Output: device = text_io.standard_output -- data = postscript program format -- -- Process: maps input data to a postscript program -- Note the function call 'is_initializing' defines the specification that is, it makes the assignments of the lexical unit to the selection -- The specification file requires an exact format that is defined in the package "vhdl_lexicon_type_style". -- Design decision and organizations -- Used the procedure vhdl_lexicon_type_style.iterate_code with text_io; with vhdl_lexicon; with vhdl_lexicon_type_style; procedure vhdl_type_set_style is begin vhdl_lexicon_type_style.iterate_code ( with_the_specification => vhdl_lexicon_type_style.is_initializing ( text_io.standard_input ) ); exception when others => vhdl_lexicon.put ( "Error does the specification file exist ? " & ( 1 => vhdl_lexicon.the_end_line_character ) ); end vhdl_type_set_style; @@//E*O*F vhdl_type_set_style.a// chmod u=rw,g=,o= vhdl_type_set_style.a exit 0 @//E*O*F code.shar// chmod u=rw,g=,o= code.shar echo x - shell_scripts.shar sed 's/^@//' > "shell_scripts.shar" <<'@//E*O*F shell_scripts.shar//' # This is a shell archive. Remove anything before this line, # then unpack it by saving it in a file and typing "sh file". # # Wrapped by eve!rshock on Mon Jan 29 03:08:58 EST 1990 # Contents: help_vhdl_tools user_vhdl_guide vhdl_tools vletter # vletter_set_style vlower vlw vscroll vscroll22 vscroll_set_style vshape # vshape94 vshape_set_style vsun vtype vtype_italics vtype_set_style # vupper echo x - help_vhdl_tools sed 's/^@//' > "help_vhdl_tools" <<'@//E*O*F help_vhdl_tools//' #!/bin/sh # help_vhdl_tools more $bin_vhdl_tools/help.guide @@//E*O*F help_vhdl_tools// chmod u=rw,g=,o= help_vhdl_tools echo x - user_vhdl_guide sed 's/^@//' > "user_vhdl_guide" <<'@//E*O*F user_vhdl_guide//' #!/bin/sh # user_vhdl_guide more $bin_vhdl_tools/user.guide @@//E*O*F user_vhdl_guide// chmod u=rw,g=,o= user_vhdl_guide echo x - vhdl_tools sed 's/^@//' > "vhdl_tools" <<'@//E*O*F vhdl_tools//' echo " " echo "The vhdl style tool set consists of these tools: " echo " " echo " HELP: vhdl_tools, help_vhdl_tools, user_vhdl_guide" echo " " echo " LETTER STYLE: vletter, vlower, vupper, vletter_set_style" echo " " echo " TYPE STYLE: vlw, vtype, vtype_italics, vtype_set_style" echo " " echo " SHAPE STYLE: vshape, vshape94, vshape_set_style" echo " " echo " SCROLL STYLE: vscroll, vscroll22, vsun, vscroll_set_style" echo " " @@//E*O*F vhdl_tools// chmod u=rw,g=,o= vhdl_tools echo x - vletter sed 's/^@//' > "vletter" <<'@//E*O*F vletter//' #!/bin/sh # vletter # define letter specification echo lower_case -- identifier_reserved > /tmp/$$.tmp echo mix_case -- identifier_not_reserved >> /tmp/$$.tmp echo upper_case -- literal_abstract_decimal lexical subtype >> /tmp/$$.tmp echo upper_case -- literal_abstract_based lexical subtype >> /tmp/$$.tmp echo upper_case -- literal_bit_string line >> /tmp/$$.tmp echo unchanged_case -- comment lexical subtype >> /tmp/$$.tmp for file do # copy to preserve protection of input files cp $file /tmp/$$tmp cat /tmp/$$.tmp /tmp/$$tmp | $bin_vhdl_tools/vhdl_letter_set_style.e > $file done rm /tmp/$$.tmp rm /tmp/$$tmp @@//E*O*F vletter// chmod u=rw,g=,o= vletter echo x - vletter_set_style sed 's/^@//' > "vletter_set_style" <<'@//E*O*F vletter_set_style//' #!/bin/sh # vletter_set_style # cat $a defines the letter specification a=$1 shift 1 for file do # preserve the protection mode file cp $file /tmp/$$.tmp cat $a /tmp/$$.tmp | $bin_vhdl_tools/vhdl_letter_set_style.e > $file done rm /tmp/$$.tmp @@//E*O*F vletter_set_style// chmod u=rw,g=,o= vletter_set_style echo x - vlower sed 's/^@//' > "vlower" <<'@//E*O*F vlower//' #!/bin/sh # vlower # define letter specification echo lower_case -- identifier_reserved -to- lower_case > /tmp/$$.tmp echo lower_case -- identifier_not_reserved -to- lower_case >> /tmp/$$.tmp echo lower_case -- literal_abstract_decimal -to- lower_case >> /tmp/$$.tmp echo lower_case -- literal_abstract_based -to- lower_case >> /tmp/$$.tmp echo lower_case -- literal_bit_string -to- lower_case >> /tmp/$$.tmp echo unchanged_case -- literal_comment -to- unchanged_case, >> /tmp/$$.tmp for file do # copy to preserve protection of input files cp $file /tmp/$$tmp cat /tmp/$$.tmp /tmp/$$tmp | $bin_vhdl_tools/vhdl_letter_set_style.e > $file done rm /tmp/$$.tmp rm /tmp/$$tmp @@//E*O*F vlower// chmod u=rw,g=,o= vlower echo x - vlw sed 's/^@//' > "vlw" <<'@//E*O*F vlw//' #!/bin/sh # vlw for file do $bin_vhdl_tools/vhdl_shape_type_standard.e < $file > /tmp/$$.tmp cat $bin_vhdl_tools/postscript_header.file /tmp/$$.tmp | $PRINTERlw1 done rm /tmp/$$.tmp @@//E*O*F vlw// chmod u=rw,g=,o= vlw echo x - vscroll sed 's/^@//' > "vscroll" <<'@//E*O*F vscroll//' #!/bin/sh # vscroll for file do # define shape specification echo 80 -- column width > /tmp/$$.tmp echo 48 -- indent margin maximum >> /tmp/$$.tmp echo 3 -- tab set >> /tmp/$$.tmp echo 1 -- wrap indent length >> /tmp/$$.tmp echo 14 -- comment right adjust length >> /tmp/$$.tmp echo "-- -- comment wrap string: constraint use only the first 4 characters" >> /tmp/$$.tmp # define rows per screen echo 23 -- rows per screen >> /tmp/$$.tmp # define the prompt string to continue echo "" >> /tmp/$$.tmp # define file name echo "$file" >> /tmp/$$.tmp cat /tmp/$$.tmp - | $bin_vhdl_tools/vhdl_scroll_set_style.e echo " " done rm /tmp/$$.tmp @@//E*O*F vscroll// chmod u=rw,g=,o= vscroll echo x - vscroll22 sed 's/^@//' > "vscroll22" <<'@//E*O*F vscroll22//' #!/bin/sh # vscroll22 # define shape specification for file do echo 80 -- column width > /tmp/$$.tmp echo 48 -- indent margin maximum >> /tmp/$$.tmp echo 3 -- tab set >> /tmp/$$.tmp echo 1 -- wrap indent length >> /tmp/$$.tmp echo 14 -- comment right adjust length >> /tmp/$$.tmp echo "-- -- comment wrap string: constraint use only the first 4 characters" >> /tmp/$$.tmp echo 22 -- rows per screen >> /tmp/$$.tmp # define the prompt string to continue echo " < return >">> /tmp/$$.tmp echo "$file" >> /tmp/$$.tmp cat /tmp/$$.tmp - | $bin_vhdl_tools/vhdl_scroll_set_style.e echo " " done rm /tmp/$$.tmp @@//E*O*F vscroll22// chmod u=rw,g=,o= vscroll22 echo x - vscroll_set_style sed 's/^@//' > "vscroll_set_style" <<'@//E*O*F vscroll_set_style//' #!/bin/sh # vscroll_set_style # first argument $a defines the scroll specification a=$1 shift 1 for file do cat $a > /tmp/$$.tmp echo "$file" >> /tmp/$$.tmp cat /tmp/$$.tmp - | $bin_vhdl_tools/vhdl_scroll_set_style.e echo " " done rm /tmp/$$.tmp @@//E*O*F vscroll_set_style// chmod u=rw,g=,o= vscroll_set_style echo x - vshape sed 's/^@//' > "vshape" <<'@//E*O*F vshape//' #!/bin/sh # vshape # define shape specification for file do echo 80 -- column width > /tmp/$$.tmp echo 48 -- indent margin maximum >> /tmp/$$.tmp echo 3 -- tab set >> /tmp/$$.tmp echo 1 -- wrap indent length >> /tmp/$$.tmp echo 14 -- comment right adjust length >> /tmp/$$.tmp echo "-- -- comment wrap string: constraint use only the first 4 characters" >> /tmp/$$.tmp # copy to preserve protection of input files cp $file /tmp/$$tmp cat /tmp/$$.tmp /tmp/$$tmp | $bin_vhdl_tools/vhdl_shape_set_style.e > $file done rm /tmp/$$.tmp rm /tmp/$$tmp @@//E*O*F vshape// chmod u=rw,g=,o= vshape echo x - vshape94 sed 's/^@//' > "vshape94" <<'@//E*O*F vshape94//' #!/bin/sh # vshape94 # define shape specification for file do echo 94 -- column width > /tmp/$$.tmp echo 48 -- indent margin maximum >> /tmp/$$.tmp echo 3 -- tab set >> /tmp/$$.tmp echo 1 -- wrap indent length >> /tmp/$$.tmp echo 14 -- comment right adjust length >> /tmp/$$.tmp echo "-- -- comment wrap string: constraint use only the first 4 characters" >> /tmp/$$.tmp echo "$file" >> /tmp/$$.tmp # copy to preserve protection of input files cp $file /tmp/$$tmp cat /tmp/$$.tmp /tmp/$$tmp | $bin_vhdl_tools/vhdl_shape_set_style.e > $file done rm /tmp/$$.tmp rm /tmp/$$tmp @@//E*O*F vshape94// chmod u=rw,g=,o= vshape94 echo x - vshape_set_style sed 's/^@//' > "vshape_set_style" <<'@//E*O*F vshape_set_style//' #!/bin/sh # vshape_set_style # cat $a defines the letter specification a=$1 shift 1 for file do # preserve the protection mode file cp $file /tmp/$$.tmp cat $a /tmp/$$.tmp | $bin_vhdl_tools/vhdl_shape_set_style.e > $file done rm /tmp/$$.tmp @@//E*O*F vshape_set_style// chmod u=rw,g=,o= vshape_set_style echo x - vsun sed 's/^@//' > "vsun" <<'@//E*O*F vsun//' #!/bin/sh # vsun for file do # define shape specification echo 94 -- column width > /tmp/$$.tmp echo 48 -- indent margin maximum >> /tmp/$$.tmp echo 3 -- tab set >> /tmp/$$.tmp echo 1 -- wrap indent length >> /tmp/$$.tmp echo 14 -- comment right adjust length >> /tmp/$$.tmp echo "-- -- comment wrap string: constraint use only the first 4 characters" >> /tmp/$$.tmp # define rows per screen echo 33 -- rows per screen >> /tmp/$$.tmp # define the prompt string to continue echo ">>" >> /tmp/$$.tmp # define file name echo "$file" >> /tmp/$$.tmp cat /tmp/$$.tmp - | $bin_vhdl_tools/vhdl_scroll_set_style.e echo " " done rm /tmp/$$.tmp @@//E*O*F vsun// chmod u=rw,g=,o= vsun echo x - vtype sed 's/^@//' > "vtype" <<'@//E*O*F vtype//' #!/bin/sh # vtype # define type specification echo bold -- vhdl_lexicon.identifier_reserved > /tmp/$$tmp echo roman -- vhdl_lexicon.identifier_not_reserved >> /tmp/$$tmp echo italics -- vhdl_lexicon.abstract_decimal >> /tmp/$$tmp echo italics -- vhdl_lexicon.abstract_based >> /tmp/$$tmp echo italics -- vhdl_lexicon.literal_bit_string >> /tmp/$$tmp echo italics -- vhdl_lexicon.literal_character >> /tmp/$$tmp echo roman -- vhdl_lexicon.literal_string >> /tmp/$$tmp echo italics -- vhdl_lexicon.comment >> /tmp/$$tmp echo roman -- vhdl_lexicon.delimiter_single >> /tmp/$$tmp echo roman -- vhdl_lexicon.delimiter_double >> /tmp/$$tmp for file do cat /tmp/$$tmp $file | $bin_vhdl_tools/vhdl_type_set_style.e > /tmp/$$.tmp cat $bin_vhdl_tools/postscript_header.file /tmp/$$.tmp | $PRINTERlw1 done rm /tmp/$$tmp rm /tmp/$$.tmp @@//E*O*F vtype// chmod u=rw,g=,o= vtype echo x - vtype_italics sed 's/^@//' > "vtype_italics" <<'@//E*O*F vtype_italics//' #!/bin/sh # vtype_italics # define type specification echo italics -- vhdl_lexicon.identifier_reserved > /tmp/$$tmp echo roman -- vhdl_lexicon.identifier_not_reserved >> /tmp/$$tmp echo italics -- vhdl_lexicon.abstract_decimal >> /tmp/$$tmp echo italics -- vhdl_lexicon.abstract_based >> /tmp/$$tmp echo italics -- vhdl_lexicon.literal_bit_string >> /tmp/$$tmp echo italics -- vhdl_lexicon.literal_character >> /tmp/$$tmp echo bold -- vhdl_lexicon.literal_string >> /tmp/$$tmp echo italics -- vhdl_lexicon.comment >> /tmp/$$tmp echo roman -- vhdl_lexicon.delimiter_single >> /tmp/$$tmp echo roman -- vhdl_lexicon.delimiter_double >> /tmp/$$tmp for file do cat /tmp/$$tmp $file | $bin_vhdl_tools/vhdl_type_set_style.e > /tmp/$$.tmp cat $bin_vhdl_tools/postscript_header.file /tmp/$$.tmp | $PRINTERlw1 done rm /tmp/$$tmp rm /tmp/$$.tmp @@//E*O*F vtype_italics// chmod u=rw,g=,o= vtype_italics echo x - vtype_set_style sed 's/^@//' > "vtype_set_style" <<'@//E*O*F vtype_set_style//' #!/bin/sh # vtype_set_style a=$1 shift 1 for i do cat $a $i | $bin_vhdl_tools/vhdl_type_set_style.e > /tmp/$$.tmp cat $bin_vhdl_tools/postscript_header.file /tmp/$$.tmp | $PRINTERlw1 rm /tmp/$$.tmp done @@//E*O*F vtype_set_style// chmod u=rw,g=,o= vtype_set_style echo x - vupper sed 's/^@//' > "vupper" <<'@//E*O*F vupper//' #!/bin/sh # vupper # define letter specification echo lower_case -- identifier_reserved > /tmp/$$.tmp echo upper_case -- identifier_not_reserved >> /tmp/$$.tmp echo upper_case -- literal_abstract_decimal lexical subtype >> /tmp/$$.tmp echo upper_case -- literal_abstract_based lexical subtype >> /tmp/$$.tmp echo upper_case -- literal_bit_string line 5 >> /tmp/$$.tmp echo unchanged_case -- comment lexical subtype >> /tmp/$$.tmp for file do # copy to preserve protection of input files cp $file /tmp/$$tmp cat /tmp/$$.tmp /tmp/$$tmp | $bin_vhdl_tools/vhdl_letter_set_style.e > $file done rm /tmp/$$tmp rm /tmp/$$.tmp @@//E*O*F vupper// chmod u=rw,g=,o= vupper exit 0 @//E*O*F shell_scripts.shar// chmod u=rw,g=,o= shell_scripts.shar echo x - text_files.shar sed 's/^@//' > "text_files.shar" <<'@//E*O*F text_files.shar//' # This is a shell archive. Remove anything before this line, # then unpack it by saving it in a file and typing "sh file". # # Wrapped by eve!rshock on Mon Jan 29 06:49:51 EST 1990 # Contents: help.guide installation.guide postscript_header.file user.guide echo x - help.guide sed 's/^@//' > "help.guide" <<'@//E*O*F help.guide//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- USER HELP GUIDE TO THE VHDL STYLE TOOL SET Sections: 1 INTRODUCTION 2 EXAMPLES 3 SUMMARY 4 CONSTRAINTS 1 INTRODUCTION 1.1 Intent of this tool set This document describes a set of software tools that operate on vhdl source code. This tool set provides the mechanism to customize many textual code characteristics of vhdl code to an individual's style of programming. These tools allow a programmer to impose his/her own style on the appearance of vhdl source code. The effect of a programmer working in his/her personal style is to increase productivity while not imposing a particular style on other programmers that will later use his code. Why another textual tool set? Most commercial tools operate on a textual document, not vhdl source code. Why not use a prettyprinter? Sommerville pinpoints a major deficiency of using a prettyprinter in a work environment. The problem with most prettyprinting systems is that they incorporate a set of conventions which have been invented by the tool designer and which are rarely explicitly specified. This means that, if an organization has existing standards, it is not possible to tailor prettyprinters to these standards. [I. Sommerville, Software Engineering 3rd Ed. p374] Prettyprinters impose absolute, detailed structural form on code. They eliminate entirely all style variations of the programmer even though the style may manifest some worthy goal such as enhancing understandability. The following standardization of the two distinct styles of procedure calls below illustrates an egregious flaw of prettyprinters. vhdl_lexicon.iterate ( the_specification, text_io.standard_output ); vhdl_lexicon.iterate ( using_this_shape_style => the_specification, on_the_text_file => text_io.standard_output ); A prettyprinter formalizes both calls to a linear structure that collapses the form of the second call to one line: vhdl_lexicon.iterate ( using_ .. ). Although the format of the second call reflects the programmer's emphasis on clarity and understandability, the prettyprinter totally ignores the format, and simultaneously destroys and loses the intended style of the programmer. The problem is that a prettyprinter dictates uniformly every minute phase of the code format. One practical solution is to have a set of fine-grained tools such that each tool operates only on one style of the source code while preserving each remaining style of the format. 1.2 Style Classes and vhdl code A vhdl source code is defined to be a text file that conforms to the specifications of the Vhdl-LRM ( IEEE Standard VHDL Language Reference Manual IEEE Std 1076-1987 ). Its logical data structure is a linearly ordered set ( sequence ) of lexical elements. Each lexical element further divides into sub_elements. Henceforth, the term lexical unit denotes the set of or a subset of the lexical sub_elements. LEXICAL ELEMENT ==> LEXICAL UNIT identifiers ==> identifier_reserved, identifier_not_reserved abstract literal ==> literal_abstract_decimal, literal_abstract_based literal_character ==> literal_character literal_string ==> literal_string literal_bit_string ==> literal_bit_string comment ==> comment separators ==> separator_end_of_file, separator_end_of_page, separator_end_of_line, separator_format_effector 1.3 Objective: The different classes of style are the letter style, the type style, the shape style, and the scroll style. The objective of each tool ( program ) is to impose only one style on the source code. Each object of each lexical unit will be transliterated to the value of the imposing style. For instance, when the specification calls for assigning the lexical unit comment to the value of upper case of the letter style, each object ( comment line ) of the lexical unit comment will be of upper case. Precisely, each letter character of each comment line will be of upper case. -------------------------------------------------------------------------------- 2 EXAMPLES This section displays an application of the tools on code. 2.1 LETTER TOOLS: -- Summary: letter tools and specifications -- LEXICAL UNIT (tool name => ) vletter vlower vupper reserved_word lower_case lower_case lower_case non_reserved_word mix_case lower_case upper_case literal_abstract_decimal upper_case lower_case upper_case literal_abstract_based upper_case lower_case upper_case literal_bit_string upper_case lower_case upper_case comment unchanged unchanged unchanged literal_character unchanged unchanged unchanged literal_string unchanged unchanged unchanged effectors unchanged unchanged unchanged SAMPLE CODE: source name = letter.example -- SYSTEM.VHD File FROM HERE TO NEXT FILE MARKER # PACKAGE SySTEM is TYPE Bus_CYclL is (Intack, Illegal, io_READ, Io_Write, Mem_Code_Read, Halt_Or_Shutdown, Mem_Data_Read, Mem_Data_Write); type Position is (Byte3, Byte2, Byte1, Byte0, -- do NOT change Word2, WORD1W, Word0, -- position dependent tword1, Tword0, Dword0); x"FFF" -- equivalent TO : b"1111_1111_1111" "strings" """" 'a' 16#0f_F# 16#E#e1_1 ///// call tool vletter ///// > vletter letter.example The format of letter.example after the call vletter letter.example is: -- SYSTEM.VHD File FROM HERE TO NEXT FILE MARKER # package System is type Bus_Cycll is (Intack, Illegal, Io_Read, Io_Write, Mem_Code_Read, Halt_Or_Shutdown, Mem_Data_Read, Mem_Data_Write); type Position is (Byte3, Byte2, Byte1, Byte0, -- do NOT change Word2, Word1w, Word0, -- position dependent Tword1, Tword0, Dword0); X"FFF" -- equivalent TO : B"1111_1111_1111" "strings" """" 'a' 16#0F_F# 16#E#E1_1 2.2 SHAPE TOOLS: -- Summary: shape tools and specifications -- Specification (tool name =>) vshape vshape94 the_column_width 80 94 the_indent_margin 48 48 the_tab_set 3 3 the_wrap_indent_length 1 1 the_comment_ragged_indent 14 14 the_comment_wrap_string "-- " "-- " ** Goal: create your own shape specification by defining it on this text file: shape.spec -- note the order of the values are important -- for instant the integer in line 3 will always be the tab set -- there must be exactly 6 lines 55 -- column width 12 -- indent margin maximum 4 -- tab set 1 -- wrap indent length 14 -- comment right adjust length --&& -- comment wrap string: constraint exactly the first 4 characters SAMPLE CODE: source code name = file_1.vhdl whose content is: -- SYSTEM.VHD FILE FROM HERE TO NEXT FILE MARKER # note this portion of the comment will illustrate the wraparound features of a comment line package system is type bus_cycle is (intack, illegal, io_read, io_write, mem_code_read, halt_or_shutdown, mem_data_read, mem_data_write); type position is (byte3, byte2, byte1, byte0, -- do NOT change word2, word1, word0, -- position dependent tword1, tword0, dword0); if this_identifier_is_too_long_to_fit_on_one_line_then_it_will_wraparound_with_this_format then a := "line exceeds an indention of 12 " entity clock_ckt is generic (per: time); port (run: in bit := '0'; clk, clk2: out bit := '0'); end clock_ckt; -- /// call vshape_set_style shape.spec file_1.vhdl > vshape_set_style shape.spec file_1.vhdl -- the format of file_1.vhdl is: -- SYSTEM.VHD FILE FROM HERE TO NEXT FILE --&&MARKER # note this portion of the comment --&&will illustrate the wraparound features of --&&a comment line package system is type bus_cycle is (intack, illegal, io_read, io_write, mem_code_read, halt_or_shutdown, mem_data_read, mem_data_write); type position is (byte3, byte2, byte1, byte0, -- do NOT change word2, word1, word0, -- position dependent tword1, tword0, dword0); if this_identifier_is_too_long_to_fit_on_one_line_then_it_w ill_wraparound_with_this_format then a := "line exceeds an indention of 12 " entity clock_ckt is generic (per: time); port (run: in bit := '0'; clk, clk2: out bit := '0'); end clock_ckt; -------------------------------------------------------------------------------- 3 SUMMARY -- Summary: letter tools and specifications -- LEXICAL UNIT (tool name => ) vletter vlower vupper reserved_word lower_case lower_case lower_case non_reserved_word mix_case lower_case upper_case literal_abstract_decimal upper_case lower_case upper_case literal_abstract_based upper_case lower_case upper_case literal_bit_string upper_case lower_case upper_case comment unchanged unchanged unchanged literal_character unchanged unchanged unchanged literal_string unchanged unchanged unchanged effectors unchanged unchanged unchanged -- Summary: shape tools and specifications -- Specification (tool name =>) vshape vshape94 the_column_width 80 94 the_indent_margin 48 48 the_tab_set 3 3 the_wrap_indent_length 1 1 the_comment_ragged_indent 14 14 the_comment_wrap_string "-- " "-- " -- Summary: scroll tools and specifications -- Specification (tool name =>) vscroll vsun vscroll22 the_column_width 80 94 80 the_indent_margin 48 48 48 the_tab_set 3 3 3 the_wrap_indent_length 1 1 1 the_comment_ragged_indent 14 14 14 the_comment_wrap_string "-- " "-- " "-- " rows per screen 23 33 22 the prompt string "" ">>" " < return >" -- Summary: type tools and specifications -- LEXICAL UNIT vtype vtype_italics vlw * reserved_word bold italics bold non_reserved_word roman roman roman literal_abstract_decimal italics italics italics literal_abstract_based italics italics italics literal_bit_string italics italics italics literal_character italics italics italics literal_string roman bold roman comment italics italics italics delimiter.single roman roman roman delimiter.double roman roman roman * vlw: shape specification is: 94 the_column_width 48 the_indent_margin 3 the_tab_set 1 the_wrap_indent_length 14 the_comment_ragged_indent "-- " the_comment_wrap_string -- SUMMARY OF "SET" TOOLS -- The set tools are: vletter_set_style, vshape_set_style, vscroll_set_style, vtype_set_style These set tools allows the programmer to design his own format style by defining the desired style specification on a text file. The example below illustrates how to define one's desired specification. USER FORMAT FOR LETTER SPECIFICATION ON A TEXT FILE: ( 6 lines ) lower_case -- identifier_reserved -to- lower_case, mix_case -- identifier_not_reserved -to- mix_case, upper_case -- literal_abstract_decimal -to- upper_case, upper_case -- literal_abstract_based -to- upper_case, upper_case -- literal_bit_string -to- upper_case, upper_case -- literal_comment -to- upper_case, Example: for vhdl source file f1.vhdl, f2.vhdl, f3 require reserved words to be upper case, non-reserved words to be mix case, comments to be upper case, bit strings to lower case and all other lexical units to be unchanged. Edit a text file, say letter.spec, to have exactly 6 lines and to have the value of the first string on each line to have one of these values: lower_case upper_case mix_case unchanged_case upper_case -- reserved words: only the first string 'upper_case' will be read mix_case -- non-reserved words unchanged_case -- abstract_decimal unchanged_case -- abstract_based numeric lower_case -- bit string upper_case -- comment --/// call /// -- > vletter_set_style letter.spec f1.vhdl f2.vhdl f3 USER FORMAT FOR SHAPE SPECIFICATION ON A TEXT FILE: ( 6 lines ) ** To design a shape specification use the tool 'set_shape_style' and edit a text file having the order of values defined below. This procedure follows that of the previous example and can be used in other style designs. 80 -- column width 48 -- indent margin maximum 3 -- tab set 1 -- wrap indent length 14 -- comment right adjust length --&& -- comment wrap string: constraint exactly the first 4 characters USER FORMAT FOR SCROLL SPECIFICATION ON A TEXT FILE: ( 8 lines ) 80 -- column width 48 -- indent margin maximum 3 -- tab set 1 -- wrap indent length 14 -- comment right adjust length -- -- comment wrap string: constraint exactly the first 4 characters 22 -- rows per screen and the prompt string to continue is on the next line < strike ret > ** Note the entire line 8 is read by the program. USER FORMAT FOR TYPE SPECIFICATION ON A TEXT FILE: ( 10 lines ) bold -- identifier_reserved roman -- identifier_not_reserved italics -- abstract_decimal italics -- abstract_based italics -- bit_string italics -- literal_character roman -- literal_string italics -- literal_comment roman -- delimiter_single roman -- delimiter_double -------------------------------------------------------------------------------- 4 CONSTRAINTS 4.1 Line length: there is no restriction on the length of a line. 4.2 Compilation: if a file vhdl compiles then its output from each tool compiles. 4.3 Robustness: occurs when the first character is incorrect in syntax or when a matching quotation character is missing example file1: bc %7 end string " no matching parenthesis > vlower file1 file1: bc --* %7 end string " no matching parenthesis -- E R R O R" 4.4 Read only tool: ( scroll tools ) vscroll vscroll22 vsun vscroll_set_style ( type tools ) vlw vtype vtype_italics vtype_set_style ( help tools ) vhdl_tools help_vhdl_tools vhdl_user_guide * The above tools do not alter the input source code Read-Write tools: ( letter tools ) vletter vlower vupper vletter_set_style ( shape tools ) vshape vshape94 vshape_set_style * The above tools alter the input source code example vletter file1 file2 The original letter style of file1 and file2 are replaced by the letter specification defined in vletter. Consequently, to save the original letter style of a file, the file must be copied to another file. @@//E*O*F help.guide// chmod u=rw,g=,o= help.guide echo x - installation.guide sed 's/^@//' > "installation.guide" <<'@//E*O*F installation.guide//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- UNIX INSTALLATION GUIDE for VHDL Style Tool Set The VHDL Style Tool Set is a set of shell scripts ( tools ) that operate on vhdl source code while preserving the property of compilation. The code below exemplifies a typical shell script. The script called vlower inputs vhdl source code files and changes each lexical unit except the comment to lower case. The call is: vlower source_file1 source_file2 ... The first section of vlower below echoes the letter specification to a temporary file /tmp/$$.tmp. Next, a for loop catenates the letter specification on /tmp/$$.tmp with an input source code. Finally, the output is directed to the name of the original input source code. Note the original format of the input file is lost. -- sample script -- #!/bin/sh # vlower # define letter specification echo lower_case -- identifier_reserved -to- lower_case > /tmp/$$.tmp echo lower_case -- identifier_not_reserved -to- lower_case >> /tmp/$$.tmp echo lower_case -- literal_abstract_decimal -to- lower_case >> /tmp/$$.tmp echo lower_case -- literal_abstract_based -to- lower_case >> /tmp/$$.tmp echo lower_case -- literal_bit_string -to- lower_case >> /tmp/$$.tmp echo unchanged_case -- literal_comment -to- unchanged_case, >> /tmp/$$.tmp for file do # copy to preserve protection of input files cp $file /tmp/$$tmp cat /tmp/$$.tmp /tmp/$$tmp | $bin_vhdl_tools/vhdl_letter_set_style.e > $file done rm /tmp/$$.tmp rm /tmp/$$tmp Section 1, called Directories, lists the names of files that belong to the directories. Section 2, called System defines symbols and paths Section 3, called Ada Compilation, lists the order of (ada ) compilation of the ada source code. Section 4, called Shell Scripts, defines each script 1 Directories 1.1 Create a system directory, labeled: bin_vhdl_tools 1.2 Place these tool procedures ( ada executable images ) in bin_vhdl_tools: vhdl_letter_set_style.e vhdl_scroll_set_style.e vhdl_shape_set_style.e vhdl_shape_type_standard.e vhdl_type_set_style.e 1.3 Place these text file in bin_vhdl_tools: postscript_header.file help.guide user.guide 1.4 These tool command files ( ie, unix shell scripts ) access the directory, bin_vhdl_tools, and must be placed in the user's path for shell script execution vletter vletter_set_style vlower vupper vscroll vscroll22 vscroll_set_style vsun vshape vshape94 vshape_set_style vlw vtype vtype_italics vtype_set_style help_vhdl_tools user_vhdl_guide vhdl_tools 2 System defined symbols 2.1 bin_vhdl_tools = path name to the system's directory that contains the ada programs executable images and certain text files ( see 1.2, 1.3 ) 2.2 PRINTERlw1 = system defined name of the laser printer for printing postscript code 3 Ada Compilation Notation: xxxx_.a package specification xxxx__.a package body or package specification + package body xxxx.a procedure UNIT: lexicon -- compile units IN ORDER io_unit_.a io_unit__.a transliterate_gn__.a -- compile these IN ORDER vhdl_lexicon_.a vhdl_name_.a vhdl_name_.a vhdl_build_.a vhdl_build_.a vhdl_lexicon__.a COMPILATION UNITS: letter_style, type_style, shape_style, scroll_style UNIT: letter_style -- Compile in order vhdl_lexicon_letter_style__.a -- compile in any order ( procedure ) vhdl_letter_set_style.a ( image is: vhdl_letter_set_style.e ) UNIT: shape_style -- Compile in order vhdl_lexicon_shape_style_.a vhdl_lexicon_shape_style__.a vhdl_separate_shape_style__.a -- Compile in any order ( procedures ) vhdl_shape_set_style.a ( image is: vhdl_shape_set_style.e ) UNIT: type_style -- Compile in order vhdl_lexicon_type_style__.a -- Compile in any order ( procedures ) vhdl_type_set_style.a ( image is: vhdl_type_set_style.e ) UNIT: scroll_style -- ASSUMPTION: these package are compliled: vhdl_lexicon_shape_style_.a vhdl_lexicon_shape_style__.a vhdl_separate_shape_style__.a -- Compile in any order ( procedure ) vhdl_scroll_set_style.a ( image is: vhdl_scroll_set_style.e ) SPECIAL UNIT: combined shape and type -- ASSUMPTION: these package are compliled: vhdl_lexicon_shape_style_.a vhdl_lexicon_shape_style__.a vhdl_separate_shape_style__.a vhdl_lexicon_type_style__.a -- Compile ( procedure ) vhdl_shape_type_standard.a ( image is: vhdl_shape_type_standard.e) 4 Shell Scripts The shell scripts are in an unix shar package called shell_scripts.shar. @@//E*O*F installation.guide// chmod u=rw,g=,o= installation.guide echo x - postscript_header.file sed 's/^@//' > "postscript_header.file" <<'@//E*O*F postscript_header.file//' %!PS-Adobe-1.0 %%For: SHOCK /M {moveto} def /S {show} def /F3 {/Courier findfont 10.00 scalefont setfont} def /F1 {/Courier-Bold findfont 10.00 scalefont setfont} def /BI {/Courier-BoldOblique findfont 10.00 scalefont setfont} def /F2 {/Courier-Oblique findfont 10.00 scalefont setfont} def /U {dup currentpoint 3 2 roll stringwidth 0 currentfont /FontInfo get /UnderlineThickness get currentfont /FontMatrix get transform setlinewidth pop currentpoint 0 currentfont /FontInfo get /UnderlinePosition get currentfont /FontMatrix get transform exch pop add newpath moveto rlineto stroke moveto show} def /P+ {initmatrix [1 0 0 1 21 0] concat} def /P- {showpage} def F3 %Page: ? 1 P+ @@//E*O*F postscript_header.file// chmod u=rw,g=,o= postscript_header.file echo x - user.guide sed 's/^@//' > "user.guide" <<'@//E*O*F user.guide//' -- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- -- Objective: to summarize the specifications of the vhdl tool set USER GUIDE TO THE VHDL STYLE TOOL SET Sections: 1 SUMMARY 2 CONSTRAINTS -- for more detail see help.guide 1 SUMMARY -- Summary: letter tools and specifications -- LEXICAL UNIT (tool name => ) vletter vlower vupper reserved_word lower_case lower_case lower_case non_reserved_word mix_case lower_case upper_case literal_abstract_decimal upper_case lower_case upper_case literal_abstract_based upper_case lower_case upper_case literal_bit_string upper_case lower_case upper_case comment unchanged unchanged unchanged literal_character unchanged unchanged unchanged literal_string unchanged unchanged unchanged effectors unchanged unchanged unchanged -- Summary: shape tools and specifications -- Specification (tool name =>) vshape vshape94 the_column_width 80 94 the_indent_margin 48 48 the_tab_set 3 3 the_wrap_indent_length 1 1 the_comment_ragged_indent 14 14 the_comment_wrap_string "-- " "-- " -- Summary: scroll tools and specifications -- Specification (tool name =>) vscroll vsun vscroll22 the_column_width 80 94 80 the_indent_margin 48 48 48 the_tab_set 3 3 3 the_wrap_indent_length 1 1 1 the_comment_ragged_indent 14 14 14 the_comment_wrap_string "-- " "-- " "-- " rows per screen 23 33 22 the prompt string "" ">>" " < return >" -- Summary: type tools and specifications -- LEXICAL UNIT vtype vtype_italics vlw * reserved_word bold italics bold non_reserved_word roman roman roman literal_abstract_decimal italics italics italics literal_abstract_based italics italics italics literal_bit_string italics italics italics literal_character italics italics italics literal_string roman bold roman comment italics italics italics delimiter.single roman roman roman delimiter.double roman roman roman * vlw: shape specification is: 94 the_column_width 48 the_indent_margin 3 the_tab_set 1 the_wrap_indent_length 14 the_comment_ragged_indent "-- " the_comment_wrap_string -- SUMMARY OF "SET" TOOLS -- The set tools are: vletter_set_style, vshape_set_style, vscroll_set_style, vtype_set_style These set tools allows the programmer to design his own format style by defining the desired style specification on a text file. The example below illustrates how to define one's desired specification. USER FORMAT FOR LETTER SPECIFICATION ON A TEXT FILE: ( 6 lines ) lower_case -- identifier_reserved -to- lower_case, mix_case -- identifier_not_reserved -to- mix_case, upper_case -- literal_abstract_decimal -to- upper_case, upper_case -- literal_abstract_based -to- upper_case, upper_case -- literal_bit_string -to- upper_case, upper_case -- literal_comment -to- upper_case, Example: for vhdl source file f1.vhdl, f2.vhdl, f3 require reserved words to be upper case, non-reserved words to be mix case, comments to be upper case, bit strings to lower case and all other lexical units to be unchanged. Edit a text file, say letter.spec, to have exactly 6 lines and to have the value of the first string on each line to have one of these values: lower_case upper_case mix_case unchanged_case upper_case -- reserved words: only the first string 'upper_case' will be read mix_case -- non-reserved words unchanged_case -- abstract_decimal unchanged_case -- abstract_based numeric lower_case -- bit string upper_case -- comment --/// call /// -- > vletter_set_style letter.spec f1.vhdl f2.vhdl f3 USER FORMAT FOR SHAPE SPECIFICATION ON A TEXT FILE: ( 6 lines ) ** To design a shape specification use the tool 'set_shape_style' and edit a text file having the order of values defined below. This procedure follows that of the previous example and can be used in other style designs. 80 -- column width 48 -- indent margin maximum 3 -- tab set 1 -- wrap indent length 14 -- comment right adjust length --&& -- comment wrap string: constraint exactly the first 4 characters USER FORMAT FOR SCROLL SPECIFICATION ON A TEXT FILE: ( 8 lines ) 80 -- column width 48 -- indent margin maximum 3 -- tab set 1 -- wrap indent length 14 -- comment right adjust length -- -- comment wrap string: constraint exactly the first 4 characters 22 -- rows per screen and the prompt string to continue is on the next line < strike ret > ** Note the entire line 8 is read by the program. USER FORMAT FOR TYPE SPECIFICATION ON A TEXT FILE: ( 10 lines ) bold -- identifier_reserved roman -- identifier_not_reserved italics -- abstract_decimal italics -- abstract_based italics -- bit_string italics -- literal_character roman -- literal_string italics -- literal_comment roman -- delimiter_single roman -- delimiter_double -------------------------------------------------------------------------------- 2 CONSTRAINTS 2.1 Line length: there is no restriction on the length of a line. 2.2 Compilation: if a file vhdl compiles then its output from each tool compiles. 2.3 Robustness: occurs when the first character is incorrect in syntax or when a matching quotation character is missing example file1: bc %7 end string " no matching parenthesis > vlower file1 file1: bc --* %7 end string " no matching parenthesis -- E R R O R" 2.4 Read only tool: ( scroll tools ) vscroll vscroll22 vsun vscroll_set_style ( type tools ) vlw vtype vtype_italics vtype_set_style ( help tools ) vhdl_tools help_vhdl_tools vhdl_user_guide * The above tools do not alter the input source code Read-Write tools: ( letter tools ) vletter vlower vupper vletter_set_style ( shape tools ) vshape vshape94 vshape_set_style * The above tools alter the input source code example vletter file1 file2 The original letter style of file1 and file2 are replaced by the letter specification defined in vletter. Consequently, to save the original letter style of a file, the file must be copied to another file. @@//E*O*F user.guide// chmod u=rw,g=,o= user.guide exit 0 @//E*O*F text_files.shar// chmod u=rw,g=,o= text_files.shar exit 0