DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦c790be779⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, package R1000_Code_Generator, pragma Module_Name 4 1601, pragma Subsystem R1000_Code_Gen, seg_006394

Derivation

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

E3 Source Code



with System;
with Machine;
with Action;
with Diana;
with Error_Messages;
with Directory;
with Switch_Implementation;
with Units_In_Program;

package R1000_Code_Generator is

    package Switch renames Switch_Implementation;

    pragma Consume_Offset;

    package Switches is

        procedure Set_Global_Tracing (On : Boolean := True);


        -- each form of Set may raise switch.undefined_switch_name

        procedure Set (Switches  : in out Switch.File;
                       Switch    :        String;
                       Value     :        Boolean;
                       Action_Id :        Action.Id := Action.Null_Id);


        procedure Set (Switches  : in out Switch.File;
                       Switch    :        String;
                       Value     :        Integer;
                       Action_Id :        Action.Id := Action.Null_Id);


        procedure Set (Switches  : in out Switch.File;
                       Switch    :        String;
                       Value     :        String;
                       Action_Id :        Action.Id := Action.Null_Id);


        procedure Cmd_Set (Switch : String; Value : Boolean);


        procedure Cmd_Set (Switch : String; Value : Integer);


        procedure Cmd_Set (Switch : String; Value : String);
    end Switches;


    -- the following generic should be instantiated with the same
    -- put and new_line procedures used to instantiate diana.symbolic_io;
    -- the result is passed to symbolic_io as print_other_attrs.

    generic
        with procedure Put (S : String);
        with procedure New_Line;
    package Attr_Display is
        procedure Print_Cg_Attrs (Node : Diana.Tree; Indent : Integer);
    end Attr_Display;


    package Exported_Attrs is

        -- FILE ATTRIBUTES

        function Has_Code_Segment (T : Diana.Tree) return Boolean;
        function Get_Code_Segment (T : Diana.Tree) return Directory.Object;

        function Has_List_File (T : Diana.Tree) return Boolean;
        function Get_List_File (T : Diana.Tree) return Directory.Object;

        function Has_Asm_File (T : Diana.Tree) return Boolean;
        function Get_Asm_File (T : Diana.Tree) return Directory.Object;

        function Has_Debug_List_File (T : Diana.Tree) return Boolean;
        function Get_Debug_List_File (T : Diana.Tree) return Directory.Object;

        function Has_Elab_Code_Segment (T : Diana.Tree) return Boolean;
        function Get_Elab_Code_Segment (T : Diana.Tree) return Directory.Object;

        function Has_Elab_List_File (T : Diana.Tree) return Boolean;
        function Get_Elab_List_File (T : Diana.Tree) return Directory.Object;

        function Has_Elab_Asm_File (T : Diana.Tree) return Boolean;
        function Get_Elab_Asm_File (T : Diana.Tree) return Directory.Object;


        -- CG_LEVEL
        -- The control stack lexical level for an object
        -- Attached to all id nodes which correspond to runtime objects

        function Get_Level (Node : Diana.Tree) return Integer;


        -- CG_OFFSET
        -- The control stack offset of a variable
        -- or the field index of a record field
        -- Attached to all id nodes which correspond to runtime objects or
        -- are record fields

        function Get_Offset (Node : Diana.Tree) return Integer;
        function Has_Offset (Node : Diana.Tree) return Boolean;


        -- CG_INT_VALUE
        -- simplified value of expression for debugger
        -- can be attached to any expression

        function Has_Int_Value (Node : Diana.Tree) return Boolean;
        function Get_Int_Value (Node : Diana.Tree) return Integer;


        -- CG_VARIABLE_SIZE_FIELD
        -- True if the field type has a dependent discriminant constraint
        -- Attached to field_ids

        function Is_Variable_Size (Defn : Diana.Tree) return Boolean;


        -- CG_VARIANT_FIELD
        -- True if the field is a variant field
        -- Attached to field_ids

        function Is_Variant_Field (Defn : Diana.Tree) return Boolean;


        -- CG_STMT_NUMBER
        -- Attached to all dn_accept nodes and dn_block nodes which represent
        -- block statements.
        -- Gives the source statement number of the accept or block.

        function Has_Stmt_Number (Node : Diana.Tree) return Boolean;
        function Get_Stmt_Number (Node : Diana.Tree) return Integer;


        -- RCG_MAJOR_VERSION
        -- RCG_MINOR_VERSION
        -- attached to comp_unit
        -- indicates version of Rcg that was last used on this unit

        function Has_Rcg_Major_Version (Node : Diana.Tree) return Boolean;
        function Get_Rcg_Major_Version (Node : Diana.Tree) return Integer;

        function Has_Rcg_Minor_Version (Node : Diana.Tree) return Boolean;
        function Get_Rcg_Minor_Version (Node : Diana.Tree) return Integer;

        -- CG_COUPLER_SUBPROGRAM
        -- indicates whether subprogram is special coupler subprogram

        function Is_Coupler_Subprogram (Node : Diana.Tree) return Boolean;

        -- CG_UNITS_IN_PROGRAM

        function Get_Units_In_Program (Main_Unit_Id : Diana.Tree)
                                      return Units_In_Program.Library_Unit_List;
        function Has_Units_In_Program
                    (Main_Unit_Id : Diana.Tree) return Boolean;

        -- CG_ELAB_SEG_NUMBER

        function Has_Elab_Seg_Number (Main_Unit_Id : Diana.Tree) return Boolean;
        function Get_Elab_Seg_Number (Main_Unit_Id : Diana.Tree) return Integer;

        -- CG_SEG_NUMBER

        function Has_Seg_Number (Unit_Id : Diana.Tree) return Boolean;
        function Get_Seg_Number (Unit_Id : Diana.Tree) return Integer;

        function Is_Inline_Frame (Frame : Diana.Tree) return Boolean;
        -- Kind (Frame) is:  dn_block (a block statement)
        --                   dn_proc_id, dn_function_id, dn_def_op
        --                   (as_designator of first id of subprogram)

        function Is_Integrated_Package (Package_Id : Diana.Tree) return Boolean;
        -- Kind (Package_id) is dn_package_id (the cg_first id).

    end Exported_Attrs;

    pragma Subsystem (R1000_Code_Gen);
    pragma Module_Name (4, 1601);
end R1000_Code_Generator;

E3 Meta Data

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=25 rec1=00 rec2=01 rec3=028
        [0x01] rec0=20 rec1=00 rec2=02 rec3=060
        [0x02] rec0=16 rec1=00 rec2=03 rec3=066
        [0x03] rec0=1c rec1=00 rec2=04 rec3=078
        [0x04] rec0=1c rec1=00 rec2=05 rec3=04c
        [0x05] rec0=19 rec1=00 rec2=06 rec3=044
        [0x06] rec0=0c rec1=00 rec2=07 rec3=000
    tail 0x21701a77c81bf808557a3 0x42a00088462065003