home *** CD-ROM | disk | FTP | other *** search
/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / test / bnchtool.ada < prev    next >
Encoding:
Text File  |  1988-05-03  |  10.5 KB  |  354 lines
  1. with text_io; use text_io;
  2. with system;
  3. with direct_io;
  4. package help_tools is
  5.  
  6.   procedure time_filename (file_name: out string);
  7.  
  8.   procedure read_environ (outfile_ptr: in file_type);
  9.  
  10.   procedure read_envfile (outfile_ptr: in file_type);
  11.  
  12. end help_tools;
  13.  
  14. -------------------------------------------------------------------------------
  15. with calendar; use calendar;
  16. with text_io; use text_io;
  17. with system;
  18. with direct_io;
  19.  
  20. package body help_tools is
  21. --------------------------------------------------------------------------------
  22. --
  23. --  procedure time_filename
  24. --
  25. --  purpose: to create a string which can be used as a file name which
  26. --          has the date encoded in the title
  27. -- 
  28. --------------------------------------------------------------------------------
  29. procedure time_filename (file_name: out string) is
  30.  
  31. subtype month_name is string(1..2);
  32.  
  33. MON_START_POS :  CONSTANT := 2;        -- start and end indices for month
  34. MON_END_POS:  CONSTANT := 3;
  35. DAY_START_POS:  CONSTANT := 4;        -- start and end indices for day
  36. DAY_END_POS:  CONSTANT := 5;
  37. HOUR_START_POS: CONSTANT := 6;        -- start and end indices for hour
  38. HOUR_END_POS: CONSTANT := 7;
  39. MIN_START_POS:  CONSTANT := 8;        -- start and end indices for minutes
  40. MIN_END_POS:    CONSTANT := 9;
  41. SMAX: constant := 2;            -- maximum length for a numeric string
  42.  
  43. date : time;                -- date
  44. cur_year: year_number;            -- current year
  45. cur_mon:  month_number;            -- current month
  46. cur_day:  day_number;            -- current day
  47.  
  48. ipass,                    -- total_seconds/max_int 
  49. itemp,                    -- temporary integer variable
  50. hours,                    -- number of hours
  51. minutes: integer;            -- number of minutes
  52.  
  53. total_sec: day_duration;        -- total number of seconds
  54.  
  55. int_seconds: integer;            -- integer variable for seconds
  56.  
  57. hour_string,                -- ascii string for hours
  58. min_string,                -- ascii string for minutes
  59. day_string: string (1..2);        -- ascii string for days
  60.     
  61. dtotal_sec,                -- floating point var for seconds
  62. dtemp_result,                -- results 
  63. dtemp_num,                -- temp variable for floating pt numbers
  64. dtemp_remainder:  float;        -- remainder of total seconds
  65.  
  66. month_code : array (month_number) of month_name := 
  67.         ("ja","fe","mr","ap","my","jn",
  68.          "jl","ag","sp","oc","nv","dc");
  69.  
  70.  
  71. function int_to_string (I: integer) return string is
  72.  
  73. -- converts integers to strings
  74.  
  75.    S: string (1..smax);
  76.    SPOS : integer := s'last; 
  77.    HOLD : integer := I;
  78.    DIGIT : integer;
  79. --
  80. begin
  81.    S := (others=>'0');  
  82.    while HOLD /= 0 loop
  83.      DIGIT := HOLD rem 10;
  84.      S(SPOS) := character'val(abs(DIGIT) + character'pos('0'));
  85.      SPOS := SPOS - 1;
  86.      HOLD := HOLD/10;
  87.    end loop;
  88.    return S;
  89. end INT_TO_STRING;
  90.     
  91. begin
  92. --
  93. --  initialize the filename to Wmmddhhmm.DAT
  94. --  get the informations for the current date and time
  95. --
  96.     file_name := "Wmmddmmmm.DAT";
  97.     date := clock;
  98.     cur_year := year (date);
  99.     cur_mon  := month (date);
  100.     cur_day  := day(date);
  101.     total_sec := seconds(date);
  102. --
  103. --  get the largest integer available to the system
  104. --  float the values for both max_int and the total number of seconds
  105. --
  106.     itemp := integer'last;
  107.     dtotal_sec := float (total_sec);
  108.     dtemp_num := float (itemp);
  109.     dtemp_result := dtotal_sec - dtemp_num;
  110. --
  111. --  if the total number of seconds is greater than max_int
  112. --     ( a case which is true for doing 16 bit arithmetic)
  113. --     determine how many times max_int is a divisor for total number
  114. --          of seconds
  115. --     for the number of passes (max_int divides) do
  116. --         increment the hours accordingly
  117. --         increment the minutes accordingly
  118. --     end for
  119. --     calculate the values of minutes
  120. --    
  121.  
  122.     IPASS := 0;  -- GTE FORGOT TO INITIALIZE THIS OBJECT!!!!
  123.  
  124.     if (dtemp_result > 0.0) then
  125.  
  126.        while (dtemp_result > 0.0) loop
  127.           ipass := ipass + 1;
  128.       dtemp_result := dtemp_result - dtemp_num;
  129.        end loop;
  130.        hours := 0; minutes := 0;
  131.        dtemp_remainder := dtemp_num + dtemp_result;
  132.        for iter in 1..ipass loop
  133.        hours := hours + 9;
  134.        minutes :=  minutes + 6;
  135.        end loop;
  136.        itemp := integer(dtemp_remainder);
  137.        hours := hours + itemp/3600;
  138.        itemp := itemp rem 3600:
  139.        minutes := minutes + itemp/60;
  140. --
  141. --  else
  142. --     calculate hours directly from total seconds
  143. --     calculate minutes directly from total seconds
  144. --  endif
  145. --
  146.     else
  147.  
  148.        int_seconds :=  integer(total_sec);
  149.        hours := int_seconds/3600; 
  150.        minutes := (int_seconds - (hours*3600))/60;
  151.  
  152.     end if;
  153. --
  154. --  translate the numbers to acsii representations and
  155. --      build the filename
  156. --
  157.     day_string := int_to_string (CUR_DAY);
  158.     hour_string:=  int_to_string(hours);
  159.     min_string  := int_to_string (minutes);
  160.     
  161.     file_name (mon_START_POS..mon_END_POS) := month_code(cur_mon);
  162.     file_name (DAY_START_POS..DAY_END_POS) := day_STRING;
  163.     file_name (HOUR_START_POS..HOUR_END_POS) := hour_string;
  164.     file_name (MIN_START_POS..MIN_END_POS) := min_string;
  165.  
  166. end time_filename;
  167. --------------------------------------------------------------------------------
  168. --
  169. --  procedure read_environ
  170. --
  171. --  purpose: writes system specific data in to the data file
  172. --
  173. --------------------------------------------------------------------------------
  174. procedure read_environ (outfile_ptr: in file_type) is
  175.  
  176. --package int_io is new integer_io(integer);
  177. package INT_IO is new INTEGER_IO(LONG_INTEGER);
  178. use int_io;
  179.  
  180. package flt_io is new float_io(float);
  181. use flt_io;
  182.  
  183. --package dur_io is new fixed_io(duration);
  184. --above statement replaced because TeleSoft 3.2 defines type "duration"
  185. --  as 32-bit integer.
  186. package DUR_IO is new INTEGER_IO(DURATION);
  187. use dur_io;
  188.  
  189. package dirinf_io is new direct_io(integer);
  190.  
  191. temp_dvar:  day_duration;    -- temporary variable for day duration;
  192.  
  193. temp_fvar:  float;        -- temporary variable for floating constants
  194.  
  195. --temp_ivar,                            -- temporary variable to ge values from
  196. TEMP_IVAR : LONG_INTEGER;  --TELESOFT 3.2 PACKAGE "SYSTEM" OBJECTS ARE LONG_INTEGER
  197.  
  198.                 --   package system
  199. last_char: integer;        -- pointer to last character in line
  200.  
  201. blank_line,
  202. line : string (1..80) := (others => ' ');
  203.  
  204. begin
  205. --
  206. --  get data from package system
  207. --
  208.  
  209.     Read_Envfile (outfile_ptr);
  210.  
  211.     new_line(outfile_ptr); 
  212.     put_line (outfile_ptr," DATA FROM PACKAGE SYSTEM: ");
  213.     
  214.     temp_ivar := system.storage_unit;
  215.     put (outfile_ptr,"SYSTEM.STORAGE_UNIT = ");
  216.     int_io.put (outfile_ptr,temp_ivar);
  217.  
  218.     new_line(outfile_ptr);
  219.     temp_ivar := system.memory_size; 
  220.     put (outfile_ptr,"SYSTEM.MEMORY_SIZE  = ");
  221.     int_io.put (outfile_ptr,temp_ivar);
  222.  
  223.     new_line(outfile_ptr);
  224.     temp_ivar := system.min_int;
  225.     put (outfile_ptr,"SYSTEM.MIN_INT      = ");
  226.     int_io.put (outfile_ptr,temp_ivar);
  227.  
  228.     new_line(outfile_ptr);
  229.     temp_ivar := system.max_int;
  230.     put (outfile_ptr,"SYSTEM.MAX_INT      = ");
  231.     int_io.put (outfile_ptr,temp_ivar);
  232.  
  233.     new_line(outfile_ptr);
  234.     temp_ivar := system.max_digits;
  235.     put (outfile_ptr,"SYSTEM.MAX_DIGITS   = ");
  236.     int_io.put (outfile_ptr,temp_ivar);
  237.  
  238.     new_line(outfile_ptr);
  239.     temp_ivar := system.max_mantissa;
  240.     put (outfile_ptr,"SYSTEM.MAX_MANTISSA = ");
  241.     int_io.put (outfile_ptr,temp_ivar);
  242.  
  243.  
  244.     new_line(outfile_ptr);
  245.     temp_fvar := system.fine_delta;
  246.     put (outfile_ptr,"SYSTEM.FINE_DELTA   = ");
  247.     put (outfile_ptr,temp_fvar);
  248.  
  249.     new_line(outfile_ptr);
  250.     temp_fvar := system.tick;
  251.     put (outfile_ptr,"SYSTEM.TICK         = ");
  252.     put (outfile_ptr,temp_fvar);
  253.  
  254.      new_line(outfile_ptr); new_line(outfile_ptr);
  255.      put (outfile_ptr," DATA FROM PACKAGES FROM I-O SYSTEMS: ");
  256.  
  257.      new_line(outfile_ptr);
  258.       --temp_ivar := integer(text_io.count'last);
  259.       TEMP_IVAR := LONG_INTEGER(TEXT_IO.COUNT'LAST);
  260.      put (outfile_ptr,"text_io.count'last   = ");
  261.      put (outfile_ptr,temp_ivar); 
  262.  
  263.      new_line(outfile_ptr);
  264.       --temp_ivar := integer(dirinf_io.count'last);
  265.       TEMP_IVAR := LONG_INTEGER(DIRINF_IO.COUNT'LAST);
  266.      put (outfile_ptr,"direct_io.count'last = "); 
  267.      put (outfile_ptr,temp_ivar);
  268.  
  269.  
  270.      new_line (outfile_ptr); new_line(outfile_ptr);
  271.      put_line (outfile_ptr,"DATA FROM PACKAGE STANDARD: ");
  272.  
  273.     --temp_ivar := integer'first;
  274.     TEMP_IVAR := LONG_INTEGER'FIRST;
  275.      put (outfile_ptr,"Integer range is "); 
  276.      put(outfile_ptr,temp_ivar);
  277.     --temp_ivar := integer'last;
  278.     TEMP_IVAR := LONG_INTEGER'LAST;
  279.      put (outfile_ptr," .. "); put(outfile_ptr,temp_ivar);
  280.  
  281.  
  282.      new_line (outfile_ptr);
  283.      temp_fvar := duration'delta;
  284.      put (outfile_ptr,"DURATION is delta ");
  285.      put (outfile_ptr,temp_fvar);
  286.  
  287.  
  288.      new_line (outfile_ptr);
  289.      temp_fvar := duration'small;
  290.      put (outfile_ptr,"DURATION'small = ");
  291.      put (outfile_ptr,temp_fvar);
  292.  
  293.      new_line (outfile_ptr); new_line(outfile_ptr);
  294.      put (outfile_ptr,"Calendar package values: ");
  295.      new_line (outfile_ptr);
  296.      temp_dvar := calendar.day_duration'first;
  297.      put (outfile_ptr,"DAY DURATION range is : ");
  298.      put (outfile_ptr,temp_dvar);put (outfile_ptr," to ");
  299.      temp_dvar := calendar.day_duration'last;
  300.      put (outfile_ptr,temp_dvar);
  301.  
  302.      new_line (outfile_ptr); new_line (outfile_ptr);
  303.      put (outfile_ptr,"End of looking at system parameters");
  304.      new_line (outfile_ptr); new_line (outfile_ptr);
  305.  
  306. end read_environ;
  307. -------------------------------------------------------------------------------
  308. --
  309. --   procedure read_envfile
  310. --
  311. --   purpose:  to copy the data from a file called ENVIRON.INF into the
  312. --         file specified by the outfile_ptr
  313. --
  314. --   exception: if the file ENVIRON.INF does not exit, an exception 
  315. --         handler will write a message in file specified by outfile_ptr
  316. --         that ENVIRON.INF has existence problems
  317. --
  318. -------------------------------------------------------------------------------
  319. procedure read_envfile (outfile_ptr: in file_type) is
  320. --
  321. indata: file_type;        -- internal filename for actual data file
  322.  
  323. file_name : string (1..11) := ("environ.inf");
  324.  
  325. blank_line,
  326. line : string (1..120) := (others => ' ');
  327.  
  328. last_char: integer;        -- position of last character in line read
  329.  
  330. --
  331. --  get data out of environment file ENVIRON.INF
  332. --
  333.  
  334. begin
  335.  
  336.     open (indata,in_file,file_name);
  337.     while not end_of_file (indata) loop
  338.         line := blank_line;
  339.         get_line(indata,line,last_char);
  340.         put_line(outfile_ptr,line(1..last_char));
  341.     end loop;
  342.     close (indata);
  343.  
  344.   exception
  345.     when others =>
  346.     put_line (outfile_ptr,
  347.               "Something is wrong with the existence of file ENVIRON.INF");
  348.     new_line (outfile_ptr);
  349.  
  350. end read_envfile;
  351.  
  352. end help_tools;
  353.  
  354.