|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - 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⟧
-- 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