Programmer's ROM - The Computer Language Library

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

/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / piwg / a000091.ada < prev next >

Wrap

Text File | 1988-05-03 | 14.3 KB | 426 lines

------------------------------------------------------------------------------- -- -- -- "DHRYSTONE" Benchmark Program -- -- ----------------------------- -- -- -- -- Version ADA/1 -- -- -- -- Date: 04/15/84 -- -- -- -- Author: Reinhold P. Weicker -- -- -- -- -- -- As published in Communications of ACM, October 1984 Vol 27 No 10 -- -- -- ------------------------------------------------------------------------------- -- -- -- The following program contains statements of a high-level programming -- -- language (Ada) in a distribution considered representative: -- -- -- -- assignments 53% -- -- control statements 32% -- -- procedures, function call 15% -- -- 100 statements are dynamically executed. The program is balanced with -- -- respect to the three aspects: -- -- -- -- - statement type -- -- - operand type (for simple data types) -- -- - operand access -- -- operand global, local, parameter, or constant. -- -- -- -- The combination of these three aspects is balanced only approximately. -- -- -- -- The program does not compute anything meaningful, but it is syntactically -- -- and semantically correct. All variables have a value assigned to them -- -- before they are used as a source operand -- ------------------------------------------------------------------------------- package global_def is ------------------ -- global definintions type Enumeration is (ident_1,ident_2,ident_3,ident_4,ident_5); subtype one_to_thirty is integer range 1..30; subtype one_to_fifty is integer range 1..50; subtype capital_letter is character range 'A'..'Z'; type String_30 is array(one_to_thirty) of character; pragma pack(string_30); type array_1_dim_integer is array (one_to_fifty) of integer; type array_2_dim_integer is array (one_to_fifty, one_to_fifty) of integer; type record_type(discr:enumeration:=ident_1); type record_pointer is access record_type; type record_type(discr:enumeration:=ident_1) is record pointer_comp: record_pointer; case discr is when ident_1 => -- only this variant is used, -- but in some cases discriminant -- checks are necessary enum_comp: enumeration; int_comp: one_to_fifty; string_comp: string_30; when ident_2 => enum_comp_2: enumeration; string_comp_2: string_30; when others => char_comp_1, char_comp_2: character; end case; end record; end global_def; with global_def; use global_def; package pack_1 is ------------- procedure proc_0; procedure proc_1(pointer_par_in: in record_pointer); procedure proc_2(int_par_in_out: in out one_to_fifty); procedure proc_3(pointer_par_out: out record_pointer); int_glob: integer; end pack_1; with global_def; use global_def; package pack_2 is -------------- procedure proc_6 (enum_par_in: in enumeration; enum_par_out: out enumeration); procedure proc_7 (int_par_in_1, int_par_in_2: in one_to_fifty; int_par_out: out one_to_fifty); procedure proc_8 (array_par_in_out_1: in out array_1_dim_integer; array_par_in_out_2: in out array_2_dim_integer; int_par_in_1, int_par_in_2: in integer); function func_1 (char_par_in_1, char_par_in_2: in capital_letter) return enumeration; function func_2 (string_par_in_1, string_par_in_2: in string_30) return boolean; end pack_2; with global_def, pack_1; use global_def; procedure A000091 is -- Dhrystone -------------- begin pack_1.proc_0; -- proc_0 is actually the main program, but it is -- part of a package, and a program within a -- package can not be designated as the main -- program for execution. Therefore proc_0 is -- activated by a call from "main". end A000091 ; with global_def,pack_2; use global_def; with cpu_time_clock; with text_io; with duration_io; package body pack_1 is ----------- bool_glob: boolean; char_glob_1, char_glob_2: character; array_glob_1: array_1_dim_integer; array_glob_2: array_2_dim_integer; pointer_glob, pointer_glob_next: record_pointer; start_time : duration ; stop_time : duration ; iteration_count : constant := 10_000 ; procedure proc_4; procedure proc_5; procedure proc_0 is int_loc_1, int_loc_2, int_loc_3: one_to_fifty; char_loc: character; enum_loc: enumeration; string_loc_1, string_loc_2: string_30; begin -- initializations pack_1.pointer_glob_next := new record_type; pack_1.pointer_glob := new record_type '( pointer_comp => pack_1.pointer_glob_next, discr => ident_1, enum_comp => ident_3, int_comp => 40, string_comp => "DHRYSTONE PROGRAM, SOME STRING" ); string_loc_1 := "DHRYSTONE PROGRAM, 1'ST STRING"; --------------- -- start timer here --------------- start_time := cpu_time_clock ; for i in 1 .. iteration_count loop proc_5; proc_4; -- char_glob_1 = 'A', char_glob_2 = 'B', bool_glob = false int_loc_1 := 2; int_loc_2 := 3; string_loc_2 := "DHRYSTONE PROGRAM, 2'ND STRING"; enum_loc := ident_2 ; bool_glob := not pack_2.func_2( string_loc_1,string_loc_2); -- bool_glob = true while int_loc_1 < int_loc_2 loop --loop body executed once int_loc_3 := 5 * int_loc_1 - int_loc_2; -- int_loc_3 = 7 pack_2.proc_7(int_loc_1,int_loc_2,int_loc_3); -- int_loc_3 = 7 int_loc_1 := int_loc_1 + 1; end loop; -- int_loc_1 = 3 pack_2.proc_8(array_glob_1,array_glob_2,int_loc_1,int_loc_3); -- int_glob = 5 proc_1(pointer_glob); for char_index in 'A'..Char_glob_2 loop --loop body executed twice if enum_loc = pack_2.func_1(char_index,'C') then -- not executed pack_2.proc_6(ident_1,enum_loc); end if; end loop; -- enum_loc = ident_1 -- int_loc = 3, int_loc_2 = 3, int_loc_3 = 7 int_loc_3 := int_loc_2 * int_loc_1; int_loc_2 := int_loc_3 / int_loc_1; int_loc_2 := 7 * ( int_loc_3 - int_loc_2 ) - int_loc_1; proc_2(int_loc_1); end loop ; stop_time := cpu_time_clock ; duration_io.put((stop_time-start_time)*1000/iteration_count); text_io.put_line(" is time in milliseconds for one Dhrystone"); ------------------ -- stop timer here ------------------ end proc_0; procedure proc_1(pointer_par_in: in record_pointer) is -- executed once next_record: record_type renames pointer_par_in.pointer_comp.all; -- pointer_glob_next.all begin next_record :=pointer_glob.all; pointer_par_in.int_comp := 5; next_record.int_comp := pointer_par_in.int_comp; next_record.pointer_comp:= pointer_par_in.pointer_comp; proc_3(next_record.pointer_comp); -- next_record.pointer_glob.pointer_comp = pointer_comp.next if next_record.discr = ident_1 then -- executed next_record.int_comp := 6; pack_2.proc_6(pointer_par_in.enum_comp,next_record.enum_comp); next_record.pointer_comp := pointer_glob.pointer_comp; pack_2.proc_7(next_record.int_comp,10,next_record.int_comp); else pointer_par_in.all := next_record; end if; end proc_1; procedure proc_2 ( int_par_in_out: in out one_to_fifty) is -- executed once -- in_par_in_out = 3 becomes 7 int_loc : one_to_fifty; enum_loc : enumeration; begin int_loc := int_par_in_out + 10; loop if char_glob_1 = 'A' then int_loc := int_loc - 1; int_par_in_out := int_loc - int_glob; enum_loc := ident_1; -- true end if; exit when enum_loc = ident_1; -- true end loop; end proc_2; procedure proc_3(pointer_par_out: out record_pointer) is -- executed once -- pointer_par_out becomes pointer_glob begin if pointer_glob /= null then -- executed pointer_par_out := pointer_glob.pointer_comp; else int_glob := 100; end if; pack_2.proc_7(10,int_glob,pointer_glob.int_comp); end proc_3; procedure proc_4 is bool_loc : boolean; begin bool_loc := char_glob_1 = 'A'; bool_loc := bool_loc or bool_glob; char_glob_2 := 'B'; end proc_4; procedure proc_5 is begin char_glob_1 := 'A'; bool_glob := false; end proc_5; end pack_1; with global_def,pack_1; use global_def; package body pack_2 is function func_3(enum_par_in: in enumeration) return boolean; -- forward declaration procedure proc_6(enum_par_in: in enumeration; enum_par_out: out enumeration) is begin enum_par_out := enum_par_in; if not func_3(enum_par_in) then enum_par_out := ident_4; end if; case enum_par_in is when ident_1 =>enum_par_out := ident_1; when ident_2 =>if pack_1.int_glob>100 then enum_par_out := ident_1; else enum_par_out := ident_4; end if; when ident_3 =>enum_par_out := ident_2; -- executed when ident_4 =>null; when ident_5 =>enum_par_out := ident_3; end case; end proc_6; procedure proc_7(int_par_in_1, int_par_in_2: in one_to_fifty; int_par_out: out one_to_fifty) is int_loc : one_to_fifty; begin int_loc := int_par_in_1 + 2; int_par_out := int_par_in_2 + int_loc; end proc_7; procedure proc_8 (array_par_in_out_1: in out array_1_dim_integer; array_par_in_out_2: in out array_2_dim_integer; int_par_in_1, int_par_in_2: in integer) is int_loc: one_to_fifty; begin int_loc := int_par_in_1 + 5; array_par_in_out_1(int_loc) := int_par_in_2; array_par_in_out_1(int_loc + 1) := array_par_in_out_1(int_loc); array_par_in_out_1(int_loc + 30) := int_loc; for int_index in int_loc..int_loc + 1 loop -- loop body executed twice array_par_in_out_2(int_loc,int_index) := int_loc ; end loop; array_par_in_out_2(int_loc,int_loc-1) := array_par_in_out_2(int_loc,int_loc-1) + 1; array_par_in_out_2(int_loc + 20,int_loc) := array_par_in_out_1(int_loc); pack_1.int_glob := 5; end proc_8; function func_1 (char_par_in_1, char_par_in_2: in capital_letter) return enumeration is char_loc_1, char_loc_2 : capital_letter; begin char_loc_1 := char_par_in_1; char_loc_2 := char_loc_1; if char_loc_2 /= char_par_in_2 then return ident_1; else return ident_2; end if; end func_1; function func_2(string_par_in_1, string_par_in_2: in string_30) return boolean is int_loc: one_to_thirty; char_loc: capital_letter; begin int_loc := 2; while int_loc <= 2 loop if func_1(string_par_in_1(int_loc), string_par_in_2(int_loc+1)) = ident_1 then char_loc := 'A'; int_loc := int_loc + 1; end if; end loop; if char_loc >='W' and char_loc < 'Z' then int_loc := 7; end if; if char_loc = 'X' then return true; else if string_par_in_1 > string_par_in_2 then int_loc := int_loc + 7; return true; else return false; end if; end if; end func_2; function func_3(enum_par_in: in enumeration) return boolean is enum_loc: enumeration; begin enum_loc := enum_par_in; if enum_loc = ident_3 then return true; end if; end func_3; end pack_2;