DataMuseum.dk

top - metrics - download

    Length: 8529 (0x2151)
    Types: TextFile
    Notes: R1k Text-file segment

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦5bd200625⟧ 
            └─⟦this⟧ 

TextFile

-- Copyright 1990, 1992  Verdix Corporation

------------------------------------------------------------------------------
-- Standard interface types used for M68K
------------------------------------------------------------------------------
with system;
with unsigned_types;
package v_i_types is

	pragma suppress(all_checks);
	pragma suppress(exception_tables);
	pragma not_elaborated;
    pragma local_access;

	--------------------------------------------------------------------------
	-- TIME type
	--------------------------------------------------------------------------
	-- Internal representation for current or absolute time. The current time
	-- is normalized so that sec is less than a day (86400.0 seconds)
	type time_t is record
		day: system.day_t;
		sec: duration;
	end record;
	type a_time_t is access time_t;

	--------------------------------------------------------------------------
	-- Allocation length type
	--------------------------------------------------------------------------
	subtype alloc_t is integer;

	--------------------------------------------------------------------------
	-- Type large enough to hold an address, integer, unsigned_integer, or
	-- duration scalar
	--------------------------------------------------------------------------
	type universal_scalar is private;
	NO_UNIVERSAL_SCALAR: constant universal_scalar;

	function to_universal_scalar(i: integer) return universal_scalar;
	function to_universal_scalar(u: unsigned_types.unsigned_integer)
		return universal_scalar;
	function to_universal_scalar(a: system.address) return universal_scalar;
	function to_universal_scalar(d: duration) return universal_scalar;
	  pragma inline_only(to_universal_scalar);
	function from_universal_scalar(us: universal_scalar) return integer;
	function from_universal_scalar(us: universal_scalar)
		return unsigned_types.unsigned_integer;
	function from_universal_scalar(us: universal_scalar) return system.address;
	function from_universal_scalar(us: universal_scalar) return duration;
	  pragma inline_only(from_universal_scalar);

	--------------------------------------------------------------------------
	-- Converts an integer to an address. If address'size > integer'size,
	-- then, the integer is sign extended. If address'size < integer'size,
	-- then, the integer is truncated.
	--------------------------------------------------------------------------
	function integer_to_address(i: integer) return system.address;
	  pragma inline_only(integer_to_address);

	--------------------------------------------------------------------------
	-- Converts an address to an integer. If integer'size > address'size,
	-- then, the address is sign extended. If integer'size < address'size,
	-- then, the address is truncated.
	--------------------------------------------------------------------------
	function address_to_integer(a: system.address) return integer;
	  pragma inline_only(address_to_integer);


	--------------------------------------------------------------------------
	-- Misc types provided for backward compatibility with
	-- earlier releases of VADS.
	--------------------------------------------------------------------------
	subtype a_task_t is system.task_id;
	null_task: constant a_task_t := system.NO_TASK_ID;
	subtype a_program_t is system.program_id;
    subtype user_field_t is integer;
    subtype user_field2_t is system.address;

	--------------------------------------------------------------------------
	-- Values corresponding to a zero/non-zero for the machine test-and-set
	--------------------------------------------------------------------------
    -- Values corresponding to a zero/non-zero for the machine test-and-set
    type test_and_set_t is new integer range 0 .. 255;
	for test_and_set_t'size use 8;
    test_and_set_false: constant test_and_set_t := 0;
    test_and_set_true: constant test_and_set_t := 16#80#;  -- bit 7 of byte

    --------------------------------------------------------------------------
    -- The following types define the structure of the fpcr register
    -- on the MC68881.  A configuration parameter of this type allows
    -- the user to control the operating characteristics of the co-
    -- processor by providing the value to which the fpcr should be
    -- initialized.
    --------------------------------------------------------------------------

    type exception_bit is range 0 .. 1;

    type rounding_modes is (to_nearest,
                            toward_zero,
                            toward_minus_infinity,
                            toward_plus_infinity);
    for rounding_modes use (to_nearest            => 2#00#,
                            toward_zero           => 2#01#,
                            toward_minus_infinity => 2#10#,
                            toward_plus_infinity  => 2#11#);

    type rounding_precision is (extended,
                                single,
                                double);
    for rounding_precision use (extended => 2#00#,
                                single   => 2#01#,
                                double   => 2#10#);
                          
    type mode_control_byte is record
      prec : rounding_precision;
      rnd  : rounding_modes;
    end record;

    for mode_control_byte use record
      prec at 0 range 0 .. 1;
      rnd  at 0 range 2 .. 3;
    end record;
    for mode_control_byte'size use 8;

    type exception_byte is record
      bsun  : exception_bit;
      snan  : exception_bit;
      operr : exception_bit;
      ovfl  : exception_bit;
      unfl  : exception_bit;
      dz    : exception_bit;
      inex2 : exception_bit;
      inex1 : exception_bit;
    end record;

    for exception_byte use record
      bsun  at 0 range 0 .. 0;
      snan  at 0 range 1 .. 1;
      operr at 0 range 2 .. 2;
      ovfl  at 0 range 3 .. 3;
      unfl  at 0 range 4 .. 4;
      dz    at 0 range 5 .. 5;
      inex2 at 0 range 6 .. 6;
      inex1 at 0 range 7 .. 7;
    end record;
    for exception_byte'size use 8;

    type floating_point_control_t is record
      exceptions : exception_byte;
      modes      : mode_control_byte;
    end record;

    for floating_point_control_t use record
      exceptions at 2 range 00 .. 07;
      modes      at 3 range 00 .. 07;
    end record;
    for floating_point_control_t'size use 32;

private
	type universal_scalar is new system.address;
	NO_UNIVERSAL_SCALAR: constant universal_scalar :=
		universal_scalar(system.memory_address(0));
end v_i_types;

with unchecked_conversion;
package body v_i_types is
	pragma suppress(all_checks);
	pragma suppress(exception_tables);

	function to_us is new unchecked_conversion(integer, universal_scalar);
	function to_i is new unchecked_conversion(universal_scalar, integer);
	function to_us is new unchecked_conversion(
		unsigned_types.unsigned_integer, universal_scalar);
	function to_ui is new unchecked_conversion(
		universal_scalar, unsigned_types.unsigned_integer);
	function to_us is
		new unchecked_conversion(system.address, universal_scalar);
	function to_a is
		new unchecked_conversion(universal_scalar, system.address);
	function to_us is new unchecked_conversion(duration, universal_scalar);
	function to_d is new unchecked_conversion(universal_scalar, duration);

	function to_universal_scalar(i: integer) return universal_scalar is
	begin
		return to_us(i);
	end;
	function to_universal_scalar(u: unsigned_types.unsigned_integer)
	return universal_scalar is
	begin
		return to_us(u);
	end;

	function to_universal_scalar(a: system.address) return universal_scalar is
	begin
		return to_us(a);
	end;

	function to_universal_scalar(d: duration) return universal_scalar is
	begin
		return to_us(d);
	end;

	function from_universal_scalar(us: universal_scalar) return integer is
	begin
		return to_i(us);
	end;
	function from_universal_scalar(us: universal_scalar)
	return unsigned_types.unsigned_integer is
	begin
		return to_ui(us);
	end;

	function from_universal_scalar(us: universal_scalar) return system.address
	is
	begin
		return to_a(us);
	end;

	function from_universal_scalar(us: universal_scalar) return duration is
	begin
		return to_d(us);
	end;

	function to_a is new unchecked_conversion(integer, system.address);
	function to_i is new unchecked_conversion(system.address, integer);
	function integer_to_address(i: integer) return system.address is
	begin
		return to_a(i);
	end;
	function address_to_integer(a: system.address) return integer is
	begin
		return to_i(a);
	end;
end v_i_types