Programmer 7500

home *** CD-ROM | disk | FTP | other *** search

/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FUZZY.ZIP / IO.B < prev next >

Wrap

Text File | 1986-11-30 | 10.3 KB | 267 lines

------------------------------------------------------------------------------- -- -- -- Library Unit: io -- Source and Listing I/O -- -- -- -- Author: Bradley L. Richards -- -- -- -- Version Date Notes . . . -- -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- -- 1.0 6 Feb 86 Initial Version -- -- 1.1 25 Feb 86 Minor revisions to error messages -- -- 1.2 4 Mar 86 Added 2 character lookahead (required to -- -- differentiate between the Ada ellipse and -- -- a floating point number). -- -- 1.3 22 May 86 Split error handlers into separate package -- -- to limit higher level visibility -- -- 1.4 18 Jun 86 Allow variable lookahead (1 or 2 characters) -- -- 2.0 20 Jun 86 Version number change only (for consistancy) -- -- 2.1 13 Jul 86 Fixed bugs pertaining to interactive i/o -- -- Split into separate spec and body files -- -- 2.2 28 Jul 86 Reset line number, et al in Start_IO. Altered -- -- end-of=line logic to eliminate the need for the -- -- user to type an extra character on interactive -- -- input. Initial operational version. -- -- 3.0 10 Oct 86 Final thesis product -- -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- -- -- -- Library units used: text_io -- -- -- -- Description: This package handles all source file access and listing -- -- output for an interpreter or compiler. It assumes a maximum output -- -- file width of 132 characters; since it reserves the first seven -- -- character positions for line numbering, it accepts a maximum of -- -- 125 characters on an input line (defined as a constant in the -- -- package specification). -- -- The package suppresses empty lines entirely. When it reaches -- -- the end of a line which did contain data, it returns an ascii.cr as -- -- the end-of-line delimiter. -- -- To initialize the package, call start_io with the names of the -- -- source and listing files. Characters are retrieved by get_char, -- -- which returns the current character and two lookahead characters. -- -- The first character retrieved from any file is an ascii.nul (in -- -- other words, the true first character appears initially as the -- -- first lookahead character. When the end of the source file is -- -- reached get_char returns an ascii.eot. further read requests -- -- produce more ascii.eot characters. -- -- Comments may be inserted with the routines "lput," "lput_line," -- -- and "lnew_line." These are equivalent to the normal text_io -- -- routines, but take the listing format into account. If desired, a -- -- pointer to the current character can be printed by "pointer." -- -- If the listing file name is empty then listing output and -- -- pointers are suppressed and comments are written to the standard -- -- output with line and character number references. -- -- After everything is finished, stop_io will tidy up the -- -- files, and handle any post_processing required by the package. -- -- -- ------------------------------------------------------------------------------- -- -- -- Package Body -- -- -- ------------------------------------------------------------------------------- package body io is package int_io is new integer_io(integer); use int_io; line_counter, line_length, prev_line_length, char_ptr : integer; read_current, write_current : boolean; source_file, listing_file : file_type; line_buffer : string(1..max_line_length); previous_comment : boolean := false; look_ahead : integer; procedure get_char is begin current_char := look_ahead_char; if look_ahead = 1 then look_ahead_char := internal_get_char; else -- look_ahead = 2 look_ahead_char := look_ahead_2_char; look_ahead_2_char := internal_get_char; end if; end get_char; function internal_get_char return character is eof_marker : constant character := ascii.eot; eof : boolean; begin if char_ptr = line_length then char_ptr := char_ptr + 1; return ascii.cr; elsif char_ptr >= line_length then -- past the end of line? loop -- until we get a nonempty line if read_current then eof := end_of_file; -- check before read else eof := end_of_file(source_file); end if; if not eof then prev_line_length := line_length; if read_current then get_line(line_buffer,line_length); else get_line(source_file,line_buffer,line_length); end if; line_counter := line_counter + 1; if previous_comment then if write_current then new_line; else new_line(listing_file); end if; previous_comment := false; end if; if not write_current then -- we are creating a listing file put(listing_file, line_counter,5); put(listing_file,": "); put_line(listing_file, line_buffer(1..line_length)); end if; end if; exit when (line_length > 0) or eof; end loop; if eof then return eof_marker; -- return EOT else char_ptr := 1; return line_buffer(char_ptr); -- return first char of the line end if; else char_ptr := char_ptr + 1; return line_buffer(char_ptr); end if; end internal_get_char; procedure lnew_line is begin if write_current then new_line; else new_line(listing_file); end if; previous_comment := false; end lnew_line; procedure lput(comment : in string) is begin if not previous_comment then if not write_current then put(listing_file, " "); -- space out past line numbers end if; previous_comment := true; end if; if write_current then put(comment); else put(listing_file, comment); end if; end lput; procedure lput_line(comment : in string) is begin if not previous_comment then if not write_current then put(listing_file, " "); -- space out past line numbers end if; end if; if write_current then put_line(comment); else put_line(listing_file, comment); end if; previous_comment := false; end lput_line; procedure print_pointer is ptr_line : string(1..max_line_length) := (others => ' '); begin if previous_comment then new_line(listing_file); previous_comment := false; end if; if write_current then -- print line and character number if char_ptr < look_ahead then put("line "); put(line_counter - 1, 3); put(", character "); put(prev_line_length - look_ahead + char_ptr + 1, 4); put(" -- "); elsif char_ptr = look_ahead then put("end of line "); put(line_counter - 1, 4); put(" -- "); else put("line "); put(line_counter, 4); put(", character "); put(char_ptr - look_ahead, 3); put(" -- "); end if; previous_comment := true; else -- print a pointer if char_ptr = (look_ahead - 1) then lput_line("Error on last character of previous line"); elsif char_ptr = look_ahead then lput_line("Error on previous end-of-line character"); else if char_ptr > look_ahead then for ctr in 1..(char_ptr - look_ahead - 1) loop ptr_line(ctr) := '.'; end loop; end if; ptr_line(char_ptr - look_ahead) := '^'; lput_line(ptr_line(1..char_ptr - look_ahead)); end if; end if; end print_pointer; procedure start_io(source_name, listing_name : string; look_ahead : vision) is begin line_counter := 0; line_length := 0; prev_line_length := 0; char_ptr :=0; io.look_ahead := look_ahead; -- set package lookahead if listing_name = "" then -- use current output write_current := true; else write_current := false; create(listing_file, out_file, listing_name); -- create listing file end if; if source_name = "" then -- use current input read_current := true; else read_current := false; open(source_file, in_file, source_name); -- open source file end if; for count in 1..look_ahead loop get_char; -- get first char ready end loop; end start_io; procedure stop_io is begin if not read_current then close(source_file); end if; if not write_current then close(listing_file); end if; end stop_io; end io;