home *** CD-ROM | disk | FTP | other *** search
/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / piwg / a000043.ada < prev    next >
Encoding:
Text File  |  1988-05-03  |  2.9 KB  |  105 lines
  1. with TEXT_IO;  use TEXT_IO;
  2. with DIRECT_IO;
  3. with DURATION_IO ; use DURATION_IO ;
  4.  
  5. package body PIWG_IO is
  6.  
  7.   subtype name_string is STRING(1..12);
  8.   subtype line_string is STRING(1..80);
  9.  
  10.   type io_record is
  11.     record
  12.       testname          : name_string;
  13.       classname         : name_string;
  14.       cpu_delta         : DURATION;
  15.       wall_delta        : DURATION;
  16.       num_of_iterations : INTEGER;
  17.       test_desc_1       : line_string;
  18.       test_desc_2       : line_string;
  19.       test_desc_3       : line_string;
  20.     end record;
  21.  
  22.   package PIWG_DIRECT_IO is new DIRECT_IO( IO_RECORD );
  23.   use PIWG_DIRECT_IO;
  24.  
  25.   disk_file : PIWG_DIRECT_IO.file_type;
  26.   record_index : PIWG_DIRECT_IO.count;
  27.  
  28. ------------------------------------
  29.   procedure OPEN_OUTPUT is
  30.   begin
  31.     begin
  32.       OPEN(disk_file, INOUT_FILE, "PIWGRES" );
  33.     exception
  34.       when PIWG_DIRECT_IO.NAME_ERROR =>
  35.         CREATE( disk_file, INOUT_FILE, "PIWGRES" );
  36.       when others =>
  37.         TEXT_IO.put ( "Error in opening disk file - PIWGRES ");
  38.         TEXT_IO.new_line;
  39.         TEXT_IO.put ( "Please check file namings for your particular host" );
  40.         TEXT_IO.new_line;
  41.     end;
  42.   end OPEN_OUTPUT;
  43.  
  44. ------------------------------------
  45.   procedure CLOSE_OUTPUT is
  46.   begin
  47.     CLOSE( disk_file );
  48.   end CLOSE_OUTPUT;
  49.  
  50. -----------------------------------
  51.   procedure PIWG_OUTPUT ( testname          : in string;
  52.                           classname         : in string;
  53.                           cpu_delta         : in DURATION;
  54.                           wall_delta        : in DURATION;
  55.                           num_of_iterations : in INTEGER;
  56.                           test_desc_1       : in string;
  57.                           test_desc_2       : in string;
  58.                           test_desc_3       : in string) is
  59.  
  60.     data_rec : io_record;
  61.  
  62.     function make_12( name : string ) return name_string is
  63.     begin
  64.      if name'length < 12 then
  65.        return name & ( name'length+1 .. 12 => ' ' ) ;
  66.      else
  67.        return name(1..12);
  68.      end if ;
  69.     end make_12;
  70.  
  71.     function make_80( name : string ) return line_string is
  72.     begin
  73.      if name'length < 80 then
  74.        return name & ( name'length+1 .. 80 => ' ' ) ;
  75.      else
  76.        return name(1..80);
  77.      end if ;
  78.     end make_80;
  79.  
  80.   begin
  81.  
  82.     if not IS_OPEN( disk_file )
  83.     then
  84.       OPEN_OUTPUT;
  85.     end if;
  86.  
  87.     record_index := SIZE( disk_file ) + PIWG_DIRECT_IO.COUNT(1);
  88.  
  89.     DATA_REC.testname := make_12 ( testname ) ;
  90.     DATA_REC.classname := make_12 ( classname ) ;
  91.     DATA_REC.cpu_delta := cpu_delta;
  92.     DATA_REC.wall_delta := wall_delta;
  93.     DATA_REC.num_of_iterations := num_of_iterations;
  94.     DATA_REC.test_desc_1 := make_80 ( test_desc_1 ) ;
  95.     DATA_REC.test_desc_2 := make_80 ( test_desc_2 ) ;
  96.     DATA_REC.test_desc_3 := make_80 ( test_desc_3 ) ;
  97.  
  98.     WRITE( disk_file, DATA_REC, record_index );
  99.  
  100.     CLOSE_OUTPUT;
  101.  
  102.   end PIWG_OUTPUT;
  103.  
  104. end PIWG_IO;
  105.