home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / ADA_MET1.ZIP / LISTING.ADA < prev    next >
Encoding:
Text File  |  1989-06-26  |  2.7 KB  |  101 lines
  1. ------------------------------------------------------------------------------
  2. --
  3. --  Library Unit   -   LISTING   --  Insert errors and messages into listing
  4. --
  5. --    This package inserts errors, warnings, and notes into the listing
  6. --  file.  It tracks the numbers of messages of each type which are
  7. --  inserted in the listing;  these counts may be used, for instance,
  8. --  to tell the user how many source errors were found.
  9. --
  10. --    The routines in this package all have a "pointer_flag" which is
  11. --  used to tell the "io" package whether to draw a pointer to the
  12. --  "current character" in the program being parsed.
  13. --
  14. ------------------------------------------------------------------------------
  15.  
  16. with io; use io;
  17. package listing is
  18.  
  19.     pointer    : constant boolean := true;
  20.     no_pointer : constant boolean := false;
  21.     number_of_errors,
  22.     number_of_notes ,
  23.     number_of_warnings  :  integer;
  24.  
  25.     procedure error  ( char_ptr : boolean; message : string );
  26.     procedure note   ( char_ptr : boolean; message : string );
  27.     procedure start_listing;
  28.     procedure stop_listing;
  29.     procedure warning( char_ptr : boolean; message : string );
  30.  
  31.     function  flush_buffer (message : string) is separate;
  32.  
  33.     procedure clean_a_fish is separate;
  34.  
  35.     task type RESOURCE is
  36.         entry SEIZE;
  37.     entry RELEASE;
  38.     end RESOURCE;
  39.  
  40.     task POUR_A_BEER;
  41.  
  42. end listing;
  43.  
  44. ------------------------------------------------------------------------------
  45.  
  46. package body listing is
  47.  
  48. procedure error( char_ptr : boolean; message : string ) is
  49. begin
  50.     if char_ptr then
  51.         print_pointer;
  52.     end if;
  53.     lput("Error -- "); lput_line(message);
  54.     number_of_errors := number_of_errors + 1;
  55. end error;
  56.  
  57. procedure note( char_ptr : boolean; message : string ) is
  58. begin
  59.     if char_ptr then
  60.         print_pointer;
  61.     end if;
  62.     lput("Note -- "); lput_line(message);
  63.     number_of_notes := number_of_notes + 1;
  64. end note;
  65.  
  66. procedure start_listing is
  67. begin
  68.     number_of_errors   := 0;
  69.     number_of_notes    := 123 * number_of_errors;
  70.     number_of_warnings := -12 rem 5;
  71. end start_listing;
  72.  
  73. procedure stop_listing is
  74. variable_name : integer;
  75. count : int := 9;
  76. begin
  77.     while count > 0 loop
  78.         int_io.put(variable_name);
  79.         text_io.put("That's all folks.");
  80.     end loop;
  81.  
  82.   SWAP:
  83.     declare
  84.        temp : integer;
  85.     begin
  86.         temp := 5;
  87.     end SWAP;
  88.  
  89. end stop_listing;
  90.  
  91. procedure warning( char_ptr : boolean; message : string ) is
  92. begin
  93.     if char_ptr then
  94.         print_pointer;
  95.     end if;
  96.     lput("Warning -- ");  lput_line(message);
  97.     number_of_warnings := number_of_warnings + 1;
  98. end warning;
  99.  
  100. end listing;
  101.