\font\ninerm=cmr9
\let\mc=\ninerm % medium caps for names like PASCAL
\def\MWEB{{\tt MWEB}}
\def\PASCAL{{\mc PASCAL}}
\def\[{\ifhmode\ \fi$[\![$}
\def\]{$]\!]$\ }
\def\<{$\langle\,$}
\def\>{$\,\rangle$}
\def\sec{{\tensy x}}

@* Table Test program.
This is a sample client module for the Table Handler symbol table library 
module. It performs no useful function, except to exercise the procedures of 
the table module.

@p 
module table_test ;
@<Import List@>@;
const @<Constants in the outer block@>@/
var @<Declare some variables@>
@ In order to keep this module reasonably free of notations that
are uniquely \PASCAL esque, a few macro definitions for low-level output
instructions are introduced here. All of the output-oriented commands
in the remainder of the module will be stated in terms of 
simple primitives.


@d pr_char==@= Write @> (*put a given character into the |output| file*)
@d pr_string==@= WriteString @> (*put a given string into the |output| file*)
@d rd_string==@= ReadString @> (* library procedure to input a string *)
@d pr_card==@= WriteCard @> (*put a given cardinal into the |output|
    file, in decimal notation, using only as many digit positions as necessary*)
@d new_ln==@= WriteLn @> (*advance to a new line in the |output| file*)
@d print_string(#)==pr_string(#) (*put a given string into the |output| file*)
@d print_cardinal(#)==pr_card(#,1) (*put a given cardinal into the |output|
    file, in decimal notation, using only as many digit positions as necessary*)
@d read_string(#)==rd_string(#) (*read a given string from the terminal *)
@d new_line==new_ln (*advance to a new line in the |output| file*)
@d print_ln(#)==pr_string(#); new_line; (*put a given string to the terminal, 
    followed by a new line *)
@<Import List@>=
from @= InOut @> import pr_string, rd_string, pr_char, pr_card, new_ln;

@ We need to import some things from |table_handler|, since that is the whole 
purpose of this program.
@<Import List@>=
from table_handler import @!get_value_of_symbol, 
        @!set_value_of_symbol, 
        @!search_symbol_table, @!table_proc, @!undefined_symbols_in_table, 
        @!create_symbol_table,@!set_error_handler,@!error_proc,
        @!symbol_table_error_code,@!symbol_is_defined,
        @!symbol_table,@!delete_symbol_table, @!symbol_string_ptr;

@ We define more than one table since we want to demonstrate handling of
multiple tables simultaneously.
@<Declare some variables@>=
@!the_table : symbol_table;
@!second_table : symbol_table;
@* Static test.
Here we perform a test of the symbol table module using static values.
@<Do static test@>=
@<Create the tables@>;
@<Store some stuff into the tables@>;
@<Display the contents of the tables@>;
@<Change the value of one of the entries and redisplay@>;
@<Check for undefined symbols@>;
@<Delete the tables@>;
@ Here we create the static symbol tables. We make the 
first one case-sensitive and the second one not.
@d case_sens==true
@d not_case_sens==false
@<Create the tables@>=
create_symbol_table(the_table,case_sens,my_error_proc);
create_symbol_table(second_table,not_case_sens,my_error_proc);
@ Here we store a bunch of canned symbols into the tables. Since the first 
table is case-sensitive, we test that by inserting the same symbol in upper 
and lower case. We do the same for the second table, which should cause a 
duplicate symbol error.
|get_value_of_symbol| is a function procedure which returns the cardinal
value store in the table entry, but we ignore the value since we only want to 
create the entry. We indicate symbol definition on all of the entries except 
one in each table, so that `undefined symbol' errors will occur.   
@d this_is_def==true
@d not_def==false
@<Store some stuff into the tables@>=
n := get_value_of_symbol(the_table,'junk',this_is_def,strad );
n := get_value_of_symbol(the_table,'TheForceIsStrongWithThisOne',this_is_def,
strad );
n := get_value_of_symbol(the_table,'ElectricBugaloo',this_is_def,strad );
n := get_value_of_symbol(the_table,'gizzard',this_is_def,strad );
n := get_value_of_symbol(the_table,'theearthisflat',this_is_def,strad );
n := get_value_of_symbol(the_table,'TheEarthIsFlat',this_is_def,strad );
n := get_value_of_symbol(the_table,'whack',this_is_def,strad );
n := get_value_of_symbol(the_table,'Shazam',not_def,strad );
n := get_value_of_symbol(second_table,'WhatMeWorry',not_def,strad );
n := get_value_of_symbol(second_table,'ribbit',this_is_def,strad );
n := get_value_of_symbol(second_table,'Hiawatha',this_is_def,strad );
n := get_value_of_symbol(second_table,'tippicanoe',this_is_def,strad );
n := get_value_of_symbol(second_table,'Tippicanoe',this_is_def,strad );
n := get_value_of_symbol(second_table,'MiDogHasFleez',this_is_def,strad );
n := get_value_of_symbol(second_table,'heartburn',this_is_def,strad );
n := get_value_of_symbol(second_table,'PieAreSquare',this_is_def,strad );
n := get_value_of_symbol(second_table,'CornbreadAreRound',this_is_def,strad );
set_value_of_symbol(second_table,'hitherefolks',this_is_def,strad,447 );
@ This code displays the contents of the two symbol tables by calling the 
procedure |search_symbol_table|. As its name implies, this procedure 
searches the entire table and will called the user-supplied procedure (in this 
case |my_proc|) for each entry in the table. |my_proc| will simply print the 
symbol and its value to the terminal. The symbols will be processed 
alphabetically.
@<Display the contents of the tables@>=
print_string('symbols in first table');
new_line;
search_symbol_table(the_table,my_proc);
print_string('symbols in second table');
new_line;
search_symbol_table(second_table,my_proc);
@
@<Change the value of one of the entries and redisplay@>=
set_value_of_symbol(second_table,'tippicanoe',not_def,strad,222 );
print_string('symbols in second table after modifications');
new_line;
search_symbol_table(second_table,my_proc);
@ Here we will call a library routine to check the integrity of the table. If 
a symbol has been referenced but never defined, the |undef_proc| procedure is 
called for that symbol. |undefined_symbols_in_table|, which is a function 
procedure which returns a boolean value, will be |true| if any undefined 
symbols were found.
@<Check for undefined symbols@>=
if undefined_symbols_in_table(the_table,undef_proc) then 
  print_string('undefined symbols in first table');
  new_line;
end;
if undefined_symbols_in_table(second_table,undef_proc) then 
  print_string('undefined symbols in second table');
  new_line;
end;
@ Here we call a library procedure to delete the tables and deallocate the 
memory space they were using.
@<Delete the tables@>=
delete_symbol_table(the_table);
delete_symbol_table(second_table);
@ We define some procedure variables to be used to store the procedures we
are passing to the library module as parameters.
@<Declare some variables@>=
@!my_proc : table_proc;
@!my_error_proc : error_proc;
@!undef_proc : error_proc;
@ 
@<Initialize the procedure variables@>=
my_error_proc := print_error;
undef_proc := print_undefined_symbol_entry;
my_proc := show_symbol_entry;
@ This is the procedure to display a table entry. It has to be defined as a 
procedure rather than inline like most of the code, since it is passed as a 
parameter to the |search_symbol_table| procedure, which will call it once for 
each entry in the table.
@p
procedure show_symbol_entry(@!ent_num : cardinal;@!str_ptr :symbol_string_ptr; 
                @!its_defined : boolean);
begin
print_string(str_ptr^);
print_string('  ');
print_cardinal(ent_num); 
print_string('  ');
if its_defined then
  print_string('defined');
else
  print_string('not defined');
end;
new_line;
end show_symbol_entry;

@ This error handler is called for each undefined symbol found by the 
|undefined_symbols_in_table| function procedure. 
@p
procedure print_undefined_symbol_entry(code : symbol_table_error_code; 
     str : array of char);
begin
print_string(str);
print_string(' is undefined');
new_line;
end print_undefined_symbol_entry;

@ This is the general error handler. It is passed to the table 
module when a table 
is created, and is called if errors occur anytime while the table is in use.
@p
procedure print_error(code : symbol_table_error_code; str : array of char);
begin
case code of
    undefined_symbol : print_string('Error on symbol ');
         print_string(str);
         print_string(' ----undefined_symbol ') |
    duplicate_symbol : print_string('Error on symbol ');
         print_string(str);
         print_string(' ----duplicate_symbol ') |
    memory_exhausted : print_string(' ----memory_exhausted ')  @/
    end; @/
new_line;
end print_error;
@* File Test.
We decide to run another test of the symbol table module. This time we will 
read the symbols from a text file rather than assigning them statically.
@<Do file test@>=
@<Open the input file@>;
create_symbol_table(file_symbol_table,case_sens,my_error_proc);
@<Read the input@>;
@<Close the file, print the table and delete it@>;

@ Here we define the symbols for use with file handling.
@d lookup==@= Lookup @>    (* library procedure to open a file *)
@d close==@= Close @> (* library procedure to close a file *)
@d failure(#)==(#.@=res@> <> @=done@>) (* last file operation sucessful ? *)
@d abort_if_open_error(#)==
if failure(#) then print_string('unable to open '); print_string(file_name); end;
@.Unable to open...@>
@d open_input_file(#)==  lookup(#,file_name,false); abort_if_open_error(#)
@d close_file(#)==close(#);
@d end_file==@=eof@>
@d null_char==@= nul @>
@d end_line(#)==(ch = eol)
@d end_of_file(#)==(#.end_file)
@d read_char==@= ReadChar @>
@d input_char(#)==read_char(#,ch);
@d read_ln(#)==while not end_line(#) do input_char(#); end;
@d text_file==@= File @>
@^system dependencies@>
@<Import List@>=
from @= FileSystem @> import lookup,@=Response@>,read_char,
           text_file, close;@/
@.FileSystem@>
from ascii import @!eol,@!null_char;

@ We simply read lines until end of file. 
@<Read the input@>=
line_number := 0;
while input_ln(input_file) do
  inc(line_number);
  @<Extract the symbols from the line and store them@>;
end;
@ We start scanning the current line for symbols. As each is found, we store 
it into the table.
@d end_of_line==(curr_pos = line_len)
@<Extract the symbols from the line and store them@>=
curr_pos := 0;
while not end_of_line do
  @<Move to next alpha or end of line@>;
  if not end_of_line then
     index := 0;
     @<Copy until next non-alpha or until end of line@>;
     work_string[index] := null_char;
     if not symbol_is_defined(file_symbol_table,work_string) then
         set_value_of_symbol(file_symbol_table,work_string,this_is_def,strad,line_number)
     end;
  end;
end;
@ Here we search for the start of a symbol. We continue until an alphabetic 
character or the end of the line is found.
@d alpha==( (cap(buffer[curr_pos]) >= 'A')  and (cap(buffer[curr_pos]) <= 'Z') )
@<Move to next alpha or end of line@>=
while (not end_of_line) and (not alpha) do
  inc(curr_pos);
end;
@ Here we copy characaters from |buffer| to |work_string| until either a 
non-alphabetic character is found or the end of the line is reached. Both
pointers are advanced as each character is copied.
@<Copy until next non-alpha or until end of line@>=
repeat
  work_string[index] := buffer[curr_pos];
  inc(index);
  inc(curr_pos);
until end_of_line or (not alpha);
@ Let's define a few constants.

@<Constants...@>=
@!buf_size=1000; (*maximum length of input line*)
@!file_name_len=200; (*length of a file name*)
@ Input goes into an array called |buffer|.
@<Declare...@>=
@!buffer: array[0..buf_size] of char;
@!work_string: array[0..buf_size] of char;
@!input_file : text_file; 
@!line_number : cardinal;
@!index : cardinal;
@!curr_pos : cardinal;
@!line_len : cardinal;
@!file_symbol_table : symbol_table;
@!file_name : array[0..file_name_len] of char;
@ The |input_ln| procedure brings the next line of input from the specified
file into the |buffer| array and returns the value |true|, unless the file has
already been entirely read, in which case it returns |false|.  
Trailing blanks are ignored
and the global variable |line_len| is set to the length of the
@^system dependencies@>
line. The value of |line_len| must be strictly less than |buf_size|.

@p procedure input_ln(var f:text_file):boolean;
  (*inputs a line or returns |false|*)
var @!final_line_len:[0..buf_size]; (*|line_len| without trailing blanks*)
@!ch : char; (* current input character *)
@!line_pres : boolean; (* temporary result of procedure *)
begin line_len:=0; final_line_len:=0; 
if end_of_file(f) then 
  line_pres:=false
else  
  input_char(f);
  while not end_line(f) do
    if ch = null_char then return false end;
    buffer[line_len]:=ch; 
    inc(line_len);
    if buffer[line_len-1]<>' ' then final_line_len:=line_len end;
    if line_len=buf_size then
      read_ln(f);
      dec(line_len); 
      return true ;
    end;
    input_char(f);
  end;
  read_ln(f); line_len:=final_line_len; line_pres := true; 
  buffer[line_len] := null_char;
end;
return line_pres ;
end input_ln;

@ In this section we open the input file, after getting the file name from the 
command line or the terminal.
@<Open the input file@>=
file_name[0]:= ' ';
print_ln('input file:'); 
read_string(file_name);
new_line;
print_ln(file_name);
new_line;
open_input_file(input_file); 
@ At this point the test is complete---we can close the input file, print the 
table, and delete it.
@<Close the file, print the table and delete it@>=
close(input_file);
print_string('symbols found in the source file');
new_line;
search_symbol_table(file_symbol_table,my_proc);
delete_symbol_table(file_symbol_table);
@ Here is the main program.
@p 
begin 
@<Initialize the procedure variables@>;
@<Do static test@>@;
@<Do file test@>@;
end table_test.
@ We declare a few more odd variables to finish off the program. |strad| is a 
pointer to the actual string for a symbol in the table, but we don't really 
care about that.
@<Declare some variables@>=
@!n : cardinal;
@!strad : symbol_string_ptr ;
@* Index.