DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ T V ┃
Length: 31312 (0x7a50) Types: TextFile Names: »V«
└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2 └─ ⟦77aa8350c⟧ »DATA« └─⟦f794ecd1d⟧ └─⟦24d1ddd49⟧ └─⟦this⟧
-- The use of this system is subject to the software license terms and -- conditions agreed upon between Rational and the Customer. -- -- Copyright 1988, 1989, 1990 by Rational. -- -- RESTRICTED RIGHTS LEGEND -- -- Use, duplication, or disclosure by the Government is subject to -- restrictions as set forth in subdivision (b)(3)(ii) of the Rights in -- Technical Data and Computer Software clause at 52.227-7013. -- -- -- Rational -- 3320 Scott Boulevard -- Santa Clara, California 95054 -- -- PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL; -- USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION -- IS STRICTLY PROHIBITED. THIS MATERIAL IS PROTECTED AS -- AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF -- 1976. CREATED 1988, 1989, 1990. ALL RIGHTS RESERVED. -- -- with Runtime_Ids; with Storage_Management; with System; with Target; package Shared_Code_Generic_Support is -- The standard rename for this package is Scg_Support -- This package provides some runtime support routines needed to -- implement Shared Code Generics. subtype Integer is Target.Integer; subtype Natural is Target.Natural; subtype Positive is Target.Positive; -- Integers in this package are as defined in Target. An Integer and -- an Address MUST have the same size. -- We require a contract with the compiler. The compiler MUST -- generate a type descriptor for an instantiation that is as -- described as below. The type declarations below are used -- in the body of this package and are exported here for docu- -- mentation purposes only. -- We REQUIRE the compiler to generate storage for an object -- declared in a shared code generic as described below: -- Scalars, Accesses : -- 32 bit entity with value -- -- Unconstrained_Arrays : -- Unconstrained_Descriptor Pointer -- --> Data Pointer --> Data -- Dope Pointer --> Dope -- -- Unconstrained_Records : -- Unconstrained_Descriptor Pointer -- --> Data_Pointer --> Data -- Is_Constrained -- -- others : -- Data Pointer -> Data type Unconstrained_Descriptor is record Data : System.Address; -- Pointer to the data Constraint : System.Address; -- Could be either a pointer to the dope in the case of -- an unconstrained array type, or a boolean value in -- the case of an unconstrained record type. In the -- case of the former, the first byte only is used. end record; Data_Offset : constant := 0; Constraint_Offset : constant := Data_Offset + Target.Bytes_Per_Address; for Unconstrained_Descriptor use record at mod 4; Data at Data_Offset range 0 .. Target.Last_Bit_Of_Address; Constraint at Constraint_Offset range 0 .. Target.Last_Bit_Of_Address; end record; Nil_Unconstrained_Descriptor : constant Unconstrained_Descriptor := Unconstrained_Descriptor'(Data => System.Address_Zero, Constraint => System.Address_Zero); -- An Unconstrained_Descriptor is the runtime representation of an un- -- constrained type when a shared code generic is instantiated with -- either Unconstrained_Arrays or Unconstrained_Records. type Formal_Type_Kind is (Scalars, Accesses, Tasks, Long_Scalars, Simple_Records, Constrained_Records, Constrained_Arrays, Unconstrained_Arrays, Unconstrained_Records); -- The Formal_Type_Kind describes the kind of actual type that -- is used in a particular instantiation for a generic formal -- type. type Constraint_Descriptor is record Constraint_1 : Integer; Constraint_2 : Integer; Constraint_3 : Integer; Constraint_4 : Integer; end record; Constraint_1_Offset : constant := 0; Constraint_2_Offset : constant := Constraint_1_Offset + Target.Bytes_Per_Integer; Constraint_3_Offset : constant := Constraint_2_Offset + Target.Bytes_Per_Integer; Constraint_4_Offset : constant := Constraint_3_Offset + Target.Bytes_Per_Integer; Bytes_Per_Constraint_Descriptor : constant := Constraint_4_Offset + Target.Bytes_Per_Integer; Last_Bit_Of_Constraint_Descriptor : constant := Bytes_Per_Constraint_Descriptor * Target.Bits_Per_Byte - 1; for Constraint_Descriptor use record at mod 4; Constraint_1 at Constraint_1_Offset range 0 .. Target.Last_Bit_Of_Integer; Constraint_2 at Constraint_2_Offset range 0 .. Target.Last_Bit_Of_Integer; Constraint_3 at Constraint_3_Offset range 0 .. Target.Last_Bit_Of_Integer; Constraint_4 at Constraint_4_Offset range 0 .. Target.Last_Bit_Of_Integer; end record; Nil_Constraints : constant Constraint_Descriptor := (0, 0, 0, 0); -- Before we describe the contents of a Constraint_Descriptor, it is -- useful to describe the contents of a Type_Descriptor. -- -- A Type_Descriptor is laid out as follows: -- Size : Integer -- Base_Size : Integer -- -- Constraints : Constraint_Descriptor -- -- Value_Size_Subp : Subprogram_Variable -- Init_Subp : Subprogram_Variable -- Allocate_Subp : Subprogram_Variable -- Dscrmt_Record_Assign_Subp : Subprogram_Variable -- -- Init_Literal : Address -- -- Type_Kind : (Scalar, Access, ...) -- Is_Short_Pointer : Boolean -- -- NOTE: the size fields are ALWAYS in storage (i.e. addressable units). -- -- Constraint_Descriptor's are needed as part of a Type_Descriptor, and -- as part of Formal_Object_Descriptor's. A Constraint_Descriptor is -- laid out as follows: -- Constraint_1 : Integer -- Constraint_2 : Integer -- Constraint_3 : Integer -- Constraint_4 : Integer -- -- These fields have the following interpretation based on the type kind. -- -- Type_Kind => Scalars: -- for both Type_Descriptor's and Formal_Object_Descriptors: -- Constraint_1 => Lower Bound -- Constraint_2 => Upper Bound -- -- -- Type_Kind => Accesses -- Since access types may be constrained, we have the following -- three situations to consider: -- -- type Array_Type is array (Integer range <>) of Integer; -- type Record_Type (D : Boolean) is -- record -- X : Integer; -- end record; -- -- type Access_Array is access Array_Type; -- subtype Constrained_Access_Array is Access_Array (1 .. 5); -- type Access_Record is access Record_Type; -- subtype Constrained_Access_Record is Access_Record (False); -- -- We distinguish between "Normal" access types, and "Constrained" -- access types which get their constraints by applying a const- -- raint to an access type. Thus, in the above, we have: -- -- Normal access : Access_Array, Access_Record -- Constrained access to array : Constrained_Access_Array -- Constrained access to record : Constrained_Access_Record -- -- In the case of the two "Constrained" access types, we need to -- do constraint checks. -- -- When the Type_Kind is Accesses, we can distinguish between -- the above cases as follows: -- -- Dope_Vector_Address (i.e. Constraint_1) is 0 and -- Dscrmt_Record_Satisfies_Subp (i.e. Constraint_2) is nil => -- Normal access -- -- Dope_Vector_Address /= 0 => -- Constrained access to array -- -- Dscrmt_Record_Satisfies_Subp is non-nil => -- Constrained access to record -- -- Now for the constraint information: -- -- Normal access : no constraint information -- Constrained access to array : Constraints as in Constrained_ -- Arrays. -- Constrained access to record : Constraints as in Constrained_ -- Records. -- -- -- Type_Kind => Tasks: -- Constraint_1 .. Constraint_4 => unused -- -- -- Type_Kind => Long_Scalars: -- for both Type_Descriptor's and Formal_Object_Descriptors: -- Constraint_1 .. Constraint_2 => Lower Bound -- Constraint_3 .. Constraint_4 => Upper_Bound -- -- -- Type_Kind => Simple_Records: -- Constraint_1 .. Constraint_4 => unused -- -- -- Type_Kind => Constrained_Records: -- for Type_Descriptor's: -- Constraint_1 => unused -- Constraint_2 .. Constraint_4 => Satisfies_Subp -- for Formal_Object_Descriptor's: -- Constraint_1 .. Constraint_4 => unused. -- -- -- Type_Kind => Constrained_Arrays: -- for Type_Descriptor's: -- Constraint_1 => Dope_Vector_Address -- Constraint_2 => Dope_Vector_Size -- Constraint_3 .. Constraint_4 => unused -- for Formal_Object_Descriptor's: -- Constraint_1 => Dope_Vector_Address -- Constraint_2 .. Constraint_4 => unused -- -- -- Type_Kind => Unconstrained_Arrays: -- for Type_Descriptor's: -- Constraint_2 => Dope_Vector_Size -- Constraint_1, Constraint_3 .. Constraint_4 => unused -- for Formal_Object_Descriptor's: -- Constraint_1 => Dope_Vector_Address -- Constraint_2 .. Constraint_4 => unused. -- -- -- Type_Kind => Unconstrained_Records: -- for Type_Descriptor's and Formal_Object_Descriptor's: -- Constraint_1 .. Constraint_4 => unused -- -- -- Note how the above algorithm REQUIRES Dope_Vector_Address and Dscrmt_ -- Record_Satisfies_Subp to NOT BE OVERLAID. In summary, for structures -- we have: -- Arrays : Constraint_1 => Dope_Vector_Address -- Constraint_2 => Dope_Vector_Size -- Records: Constraint_2 .. Constraint_4 => Dscrmt_Record_Satisfies_Subp -- -- Note that it is illegal to refer to constraints fields that do not -- exist. -- subtype Subprogram_Variable is Target.Subprogram_Variable; Nil_Code : System.Address renames Target.Nil_Code; Nil_Static_Link : System.Address renames Target.Nil_Static_Link; Nil_Subprogram_Variable : Subprogram_Variable renames Target.Nil_Subprogram_Variable; -- For subprogram variables in descriptors type Type_Descriptor is record Size : Natural; Base_Size : Natural; -- Object Sizes Constraints : Constraint_Descriptor; -- Constraints Value_Size_Subp : Subprogram_Variable; Init_Subp : Subprogram_Variable; Allocate_Subp : Subprogram_Variable; Dscrmt_Record_Assign_Subp : Subprogram_Variable; -- Subprogram variables Subp_Iv : System.Address; -- Instance variable passed to all thunks Init_Literal : System.Address; -- Initialization literal (if any) Type_Kind : Formal_Type_Kind; Is_Short_Pointer : Boolean; -- Enumeration values end record; Size_Offset : constant := 0; Base_Size_Offset : constant := Size_Offset + Target.Bytes_Per_Integer; Constraints_Offset : constant := Base_Size_Offset + Target.Bytes_Per_Integer; Value_Size_Subp_Offset : constant := Constraints_Offset + Bytes_Per_Constraint_Descriptor; Init_Subp_Offset : constant := Value_Size_Subp_Offset + Target.Bytes_Per_Subprogram_Variable; Allocate_Subp_Offset : constant := Init_Subp_Offset + Target.Bytes_Per_Subprogram_Variable; Dscrmt_Record_Assign_Subp_Offset : constant := Allocate_Subp_Offset + Target.Bytes_Per_Subprogram_Variable; Subp_Iv_Offset : constant := Dscrmt_Record_Assign_Subp_Offset + Target.Bytes_Per_Subprogram_Variable; Init_Literal_Offset : constant := Subp_Iv_Offset + Target.Bytes_Per_Address; Type_Kind_Offset : constant := Init_Literal_Offset + Target.Bytes_Per_Address; Is_Short_Pointer_Offset : constant := Type_Kind_Offset + Target.Bytes_Per_Enumeration; for Type_Descriptor use record at mod 4; Size at Size_Offset range 0 .. Target.Last_Bit_Of_Integer; Base_Size at Base_Size_Offset range 0 .. Target.Last_Bit_Of_Integer; Constraints at Constraints_Offset range 0 .. Last_Bit_Of_Constraint_Descriptor; Value_Size_Subp at Value_Size_Subp_Offset range 0 .. Target.Last_Bit_Of_Subprogram_Variable; Init_Subp at Init_Subp_Offset range 0 .. Target.Last_Bit_Of_Subprogram_Variable; Allocate_Subp at Allocate_Subp_Offset range 0 .. Target.Last_Bit_Of_Subprogram_Variable; Dscrmt_Record_Assign_Subp at Dscrmt_Record_Assign_Subp_Offset range 0 .. Target.Last_Bit_Of_Subprogram_Variable; Subp_Iv at Subp_Iv_Offset range 0 .. Target.Last_Bit_Of_Address; Init_Literal at Init_Literal_Offset range 0 .. Target.Last_Bit_Of_Address; Type_Kind at Type_Kind_Offset range 0 .. Target.Last_Bit_Of_Enumeration; Is_Short_Pointer at Is_Short_Pointer_Offset range 0 .. Target.Last_Bit_Of_Enumeration; end record; -- NOTE: This package ASSUMES that the middle pass constructs -- a type descriptor of the above layout. -- This ends the description of the instance variable type Expression is new System.Address; Nil_Expression : constant Expression := Expression (System.Address_Zero); -- An Expression is an uninterpreted 32 bits. The type Expression_Kind -- (below) defines how to interpret an expression. type Expression_Kind is (Nil_Kind, Local_Object, Formal_Object, Formal_Object_Ref, Component, Allocator, Formal_Homogeneous_Allocator, Formal_Heterogeneous_Allocator); -- Nil_Kind indicates that the given expression is meaningless. -- Local_Object consists of top level declarations inside the generic, -- parameters of subprograms declared inside the generic, and the results -- of functions declared inside the generic. -- Formal_Object is like Local_Object, except that the object and/or -- subprogram in question is a generic formal rather than declared inside -- the generic. Note that generic in parameters (formal constants) are -- considered Local_Object; this is because the formal constant must -- satisfy the subtype constraints of its type mark. Formal_Object -- Expression_Kind is needed because the ada language has loopholes in -- contract model for generics; Formal_Object is used in those cases -- (where the subtype constraints cannot be trusted). -- Formal_Object_Reference is the same as Formal_Object, except that -- non-structures are represented as references rather than as values. -- Component applies to array elements and record fields. -- Allocator applies to the result of a pointer dereference -- Formal_Homogeneous_Allocator applies to a pointer dereference where the -- access type is a generic formal parameter and refers to a homogenous -- collection. -- Formal_Heterogenous_Allocator applies to a pointer dereference where the -- access type is a generic formal parameter that refers to a heterogenous -- collection. -- -- We distinguish between Formal_Homogenous_Allocator and Formal_Heterogen- -- eous_Allocator because the formal access type may point into a non-ho- -- mogeneous collection even if the designated private type is constrai- -- ned. The format of an expression of Formal_Allocator is determined by -- the formal access type; it the address of a contiguous (dope vector, -- data) pair if and only if the designated type of the formal collection -- is unconstrained. -- -- The following table shows the possible layouts of a value of a formal -- private type: -- Data Kind Table -- -- -- Local_Object Formal_Object Component Allocator -- &Frml_Obj_Ref -- --------------+---------------+--------------+---------+------------+ -- not a | 1 word | 1 word | @data | @data | -- structure | | (@data for | | | -- | | Frml_Obj_Rf)| | | -- --------------+---------------+--------------+---------+------------+ -- simple record,| @data | @data | @data | @data | -- long_scalar | | | | | -- --------------+---------------+--------------+---------+------------+ -- constrained | @data | same as not | @data | @data | -- structure | | constrained | | | -- --------------+---------------+--------------+---------+------------+ -- unconstrained | @(@data,@dv) | @(@data,@dv) | illegal | @(dv,data) | -- array | | | | | -- --------------+---------------+--------------+---------+------------+ -- unconstrained | @(@data, | @(@data, | @data | @data | -- record | cnstrnd?) | cnstrnd?) | | | -- --------------+---------------+--------------+---------+------------+ -- -- Formal_Homogeneous_Alloc Formal_Heterogeneous_Alloc -- --------------+--------------------------|--------------------------| -- not a | @data | illegal | -- structure | | | -- --------------+--------------------------|--------------------------+ -- simple record,| @data | illegal | -- long_scalar | | | -- --------------+--------------------------|--------------------------+ -- constrained | @data | same as not constrained | -- structure | | | -- --------------+--------------------------|--------------------------+ -- unconstrained | illegal | @(dv,data) | -- array | | | -- --------------+--------------------------|--------------------------+ -- unconstrained | illegal | @data | -- record | | | -- --------------+--------------------------|--------------------------| -- -- where @ means address of -- dv means dope vector -- cnstrnd? means is_constrained -- maxsize means the maximum size (applicable only to discriminated -- records with default discriminants) -- -- Note that in the above notation, (@data,@dv) and (@data,cnstrnd?) refer -- to an Unconstrained_Descriptor. subtype Conversion_Kind is Expression_Kind range Local_Object .. Formal_Object; -- We only allow conversion between the above Expression_Kinds. type Check_Kind is (Nil_Check, Length_Check, Subtype_Check); subtype Copy_Check_Kind is Check_Kind range Nil_Check .. Length_Check; -- Check_Kind indicates the kind of check to make. -- Nil_Check : No check -- Length_Check : Check length only, thus allowing sliding -- Subtype_Check : Check full subtype constraints, thus disallowing -- sliding. -- Now we are ready to define the runtime calls. Fundamentally, each -- runtime call has the following parameters: -- 1. The runtime type descriptor -- 2. 1 or 2 Expression's. When an expression is to be modified, -- we require the ADDRESS of the expression to be passed in. -- 3. Expression_Kind's associated with each expression stating -- how the expression is to be interpreted. -- 4. An indication of the check (if any) that is to be performed. procedure Copy (Type_Desc : Type_Descriptor; Source : Expression; Source_Kind : Expression_Kind; Dest_Address : System.Address; Dest_Kind : Expression_Kind; Dest_Constraints : Constraint_Descriptor; Chk : Copy_Check_Kind); -- Assign value Source to the destination at Dest_Address. function Convert (Type_Desc : Type_Descriptor; Exp : Expression; Exp_Kind : Expression_Kind; Target_Kind : Conversion_Kind; Uncons_Desc_Address : System.Address; Chk : Check_Kind) return Expression; -- Convert Exp to the kind required by Target_Kind. This is called for -- instance in type conversion, and parameter passing. Because of its -- use in parameter passing, in the particular case of Long_Scalars, -- it regards Uncons_Desc_Address as a data area where the value of Exp -- should be copied into to have value-result semantics. The copy that -- this causes in other cases for Long_Float's that do not involve para- -- meter passing is deemed a negligble overhead. function Satisfies (Type_Desc : Type_Descriptor; Exp : Expression; Exp_Kind : Expression_Kind; Chk : Check_Kind) return Boolean; -- Returns True if Exp satisfies Chk. function Equal (Type_Desc : Type_Descriptor; Left : Expression; Left_Kind : Expression_Kind; Right : Expression; Right_Kind : Expression_Kind) return Boolean; -- Returns True iff the two are equal. Note that this implies DATA -- equality. Subtypes may be unequal in the case of array types. function Allocate (Type_Desc : Type_Descriptor; Collection_Or_Heap : System.Address; Is_Collection : Boolean; Is_Homogenous : Boolean; Initial_Value : Expression; Initial_Value_Kind : Expression_Kind; Master_Layer : System.Address; Activation_Group : System.Address) return System.Address; -- Allocate in a collection or a heap, and initialize it with Initial_Va- -- lue if Initial_Value_Kind is not Nil_Kind. Other parameters are: -- Is_Collection : True iff Collection_Or_Heap is a collection. -- Is_Homogeneous : True iff the access type is Homogenous, in which -- case the dope vector is not written out with the -- data. -- Master_Layer, -- Activation_Group : Nonzero when the actual type contains a task type. function Return_Value (Type_Desc : Type_Descriptor; Exp : Expression; Exp_Kind : Expression_Kind; Size_Address : System.Address; Result_Address : System.Address; Result_Kind : Conversion_Kind) return System.Address; -- This function provides the support needed to implement returning values -- of private types. There are two models we support which fundamentally -- support two different ways in which the coder deals with returning an -- unconstrained value. These models are referred to below as the "Copy -- Down" model and the "No Copy Down" model, indicating whether the coder -- will copy down the data or not in the case of an unconstrained type. -- Conceptually, this runtime routine needs to do what the coder will not -- do, such as the copy in the "No Copy Down" case. The parameters to -- this routine are: -- Type_Desc : The Type_Descriptor -- Exp, Exp_Kind : The value of the expression to be returned -- Size_Address : If copy down is needed, this is the address -- that should be set to the size to copy down. -- If copy down is not needed, this address has -- the value size of Value. -- Result_Address : The address of the object descriptor that will -- hold the result. If for an unconstrained type, -- this object descriptor points to an unconstrained -- descriptor. Furthermore, if this is an uncons- -- trained array, the unconstrained descriptor's dope -- address field is already pointing at a dope vector -- that has to be filled in. -- Result_Kind : The format in which the result is to be returned. -- Now for details of exactly what this function does. Assume that Size -- refers to the variable at Size_Address and Result refers to the varia- -- ble at Result_Address. -- -- -- Copy Down: -- Returned value is interpreted as the address of the data to be -- copied down when copy down is needed. Size is interpreted as -- the size to copy down. -- -- Unconstrained_Array, -- Unconstrained_Record : 1. Set Size to Value_Size of Exp. -- 2. Copy Dope_Vector of Exp into dope vector -- address obtained from Result if it is an -- Unconstrained_Array. Note that WE MUST -- NOT SHARE the dope vector of Exp. -- 3. Return the data address of Exp to copy down. -- -- others : 1. Set Size to 0. -- 2. Copy Exp into Result. -- 3. Returned value is 0. -- -- -- No Copy Down: -- Returned value is interpreted as the VALUE of the resultant -- Expression. Size is the Value_Size -- -- Copy Exp into Result. -- -- -- The "Copy Exp into Result" refers to a copy that simply copies the -- data at Exp into Result. Even if Dscrmt_Record_Assign_Subp exists, -- WE SHOULD NOT CALL IT, and simply do the copy. procedure Unchecked_Convert (Source : Expression; Source_Desc : Type_Descriptor; Source_Kind : Expression_Kind; Source_Size : Integer; Target_Address : System.Address; Target_Desc : Type_Descriptor; Target_Kind : Expression_Kind; Target_Size : Integer); -- This routine implements unchecked conversion to and from private -- types. Either Source or Target may be an object of a private type, -- or they may be non-private. If they are non-private, the appropriate -- size value must be the length of the object in bytes. Likewise, if -- an object is private, the size must be zero and the kind must be -- the appropriate kind for the private type. procedure Unchecked_Deallocate (Collection : System.Address; Cell : Storage_Management.Address_Ref; Desc : Type_Descriptor; Kind : Expression_Kind); -- This routine implements unchecked deallocation for formal private -- types. private pragma Export_Procedure (Copy, "__SCG_COPY"); pragma Suppress (Elaboration_Check, Copy); pragma Export_Function (Convert, "__SCG_CONVERT"); pragma Suppress (Elaboration_Check, Convert); pragma Export_Function (Satisfies, "__SCG_SATISFIES"); pragma Suppress (Elaboration_Check, Satisfies); pragma Export_Function (Equal, "__SCG_EQUAL"); pragma Suppress (Elaboration_Check, Equal); pragma Export_Function (Allocate, "__SCG_ALLOCATE"); pragma Suppress (Elaboration_Check, Allocate); pragma Export_Function (Return_Value, "__SCG_RETURN"); pragma Suppress (Elaboration_Check, Return_Value); pragma Export_Procedure (Unchecked_Convert, "__SCG_UNCHECKED"); pragma Suppress (Elaboration_Check, Unchecked_Convert); -- pragma Export_Procedure (Unchecked_Deallocate, "__SCG_DEALLOCATE"); pragma Export_Procedure (Unchecked_Deallocate, "__SPARE_1"); pragma Suppress (Elaboration_Check, Unchecked_Deallocate); end Shared_Code_Generic_Support; pragma Export_Elaboration_Procedure ("__SCG_SPEC"); pragma Runtime_Unit (Unit_Number => Runtime_Ids.Runtime_Compunit, Elab_Routine_Number => Runtime_Ids.Internal);