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

⟦c3989a224⟧ Ada Source

    Length: 34816 (0x8800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, package Xlbmp_Put, seg_004f0e

Derivation

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

E3 Source Code



with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Basic;  
use Xlbt_Basic;

with Xlbmt_Network_Types;  
use Xlbmt_Network_Types;

package Xlbmp_Put is
------------------------------------------------------------------------------
-- X Library X Server Put Routines
--
-- Xlbmp_Put - Send info to the X Server
------------------------------------------------------------------------------
-- Copyright 1989 - 1991 by Rational, Santa Clara, California.
--
--                  All Rights Reserved.
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright notice(s) appear in all copies and that
-- both that copyright notice(s) and this permission notice appear in
-- supporting documentation, and that the name of Rational not be used in
-- advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- Rational disclaims all warranties with regard to this software, including
-- all implied warranties of merchantability and fitness, in no event shall
-- Rational be liable for any special, indirect or consequential damages or
-- any damages whatsoever resulting from loss of use, data or profits, whether
-- in an action of contract, negligence or other tortious action, arising out
-- of or in connection with the use or performance of this software.
------------------------------------------------------------------------------

    subtype Only_Zero     is Integer range 0 .. 0;  
    subtype Only_Non_Zero is X_Raw_Data_Index range 8 .. 16;

--\x0c
    generic  
        type Request is private;  
        with procedure To_Raw (Raw : out X_Raw_Data_Array;  
                               Req :     Request);  
        Request_Size   : in X_Raw_Data_Index := Request'Size / 8;  
        Multiple_Of_32 : in Only_Zero        := Request'Size rem 32;  
    procedure Put_Request (Display : X_Display;  
                           Req     : Request);
------------------------------------------------------------------------------
-- For X_Request's only.  Do not use this for ordinary private types.
--
-- If you get a Constraint_Error when elaborating this generic then you have
-- tried to instantiate it with a type whose 'Size is not N*32.
--
-- Put data into the buffer going to a particular display.  All X requests
-- are always a multiple of 32 bits (4 bytes) in length.  If the data
-- does not fit into the buffer then the buffer is flushed first.
-- Display.Last_Req is not set; that is up to the caller.
--  Request         - this is the type of data that needs to be sent
--  To_Raw          - converts the data to X_Raw_Data
--  Request_Size    - all X protocol requests are 4*N bytes long, this value
--                    corresponds to the number of X_Raw_Data items required
--                    to represent the Request
--  Multiple_Of_32  - causes Constraint_Error if Request is of an inappropriate
--                    'Size
--  Display         - display to receive the request
--  Req             - the X_Request to send
------------------------------------------------------------------------------

    generic  
        type Request is private;  
        with procedure To_Raw (Raw : out X_Raw_Data_Array;  
                               Req :     Request);  
        Request_Size   : in X_Raw_Data_Index := Request'Size / 8;  
        Multiple_Of_32 : in Only_Zero        := Request'Size rem 32;  
    procedure Put_Request_Extra (Display : X_Display;  
                                 Req     : Request;  
                                 Extra   : S_Natural);
------------------------------------------------------------------------------
-- For X_Request's only.  Do not use this for ordinary private types.
--
-- If you get a Constraint_Error when elaborating this generic then you have
-- tried to instantiate it with a type whose 'Size is not N*32.
--
-- Put data into the buffer going to a particular display.  All X requests
-- are always a multiple of 32 bits (4 bytes) in length.  If the data
-- does not fit into the buffer then the buffer is flushed first.
-- Display.Last_Req is not set; that is up to the caller.
--  Request         - this is the type of data that needs to be sent
--  To_Raw          - converts the data to X_Raw_Data
--  Request_Size    - all X protocol requests are 4*N bytes long, this value
--                    corresponds to the number of X_Raw_Data items required
--                    to represent the Request
--  Multiple_Of_32  - causes Constraint_Error if Request is of an inappropriate
--                    'Size
--  Display         - display to receive the request
--  Req             - the X_Request to send
--  Extra           - We are making a request to the server and we need the
--                    buffer space for this Request object plus we will need
--                    Extra bytes in the same buffer for data that follows
--                    and is part of the request.  If Request_Size+Extra is
--                    larger than the remaining space in the buffer then the
--                    buffer is flushed.
------------------------------------------------------------------------------

    generic  
        type Original is private;  
        with procedure To_Raw (Raw : out X_Raw_Data_Array;  
                               D   :     Original);  
        Original_Size  : in X_Raw_Data_Index := Original'Size / 8;  
        Multiple_Of_32 : in Only_Zero        := Original'Size rem 32;  
    procedure Put_Data_Private (Display : X_Display;  
                                D       : Original);
------------------------------------------------------------------------------
-- For Discrete and ordinary Private types.
--
-- If you get a Constraint_Error when elaborating this generic then you have
-- tried to instantiate it with a type whose 'Size is not N*32.
--
-- Put data into the buffer going to a particular display.  All X requests
-- are always a multiple of 32 bits (4 bytes) in length.  If the data
-- does not fit into the buffer then the buffer is flushed first.
-- Display.Last_Req is not set; that is up to the caller.
--  Original        - this is the type of data that needs to be sent
--  To_Raw          - converts the data to X_Raw_Data
--  Original_Size   - all X protocol requests are 4*N bytes long, this value
--                    corresponds to the number of X_Raw_Data items required
--                    to represent an Original item; always a multiple of 4
--                    bytes.
--  Multiple_Of_32  - causes Constraint_Error if Original is of an inappropriate
--                    'Size
--  Display         - display to receive the request
--  D               - the data to send
------------------------------------------------------------------------------

    generic  
        type Original is private;  
        with procedure To_Raw (Raw : out X_Raw_Data_Array; D : Original);  
        Original_Size : in X_Raw_Data_Index := Original'Size / 8;  
    procedure Put_Data_Private_Unaligned (Display : X_Display; D : Original);
------------------------------------------------------------------------------
-- For Discrete and ordinary Private types.
--
-- Put data into the buffer going to a particular display.  This is only used
-- for those portions of some requests where we must create the requests
-- piecemeal out of pieces that are not multiples of 4-bytes in length.
-- This routine does not preserve that 4-byte alignment requirement.  Callers
-- of this routine are required to make their request a multiple of 4-bytes
-- when they are finished.  If the data does not fit into the buffer then the
-- buffer is flushed first.  Display.Last_Req is not set; that is up to the
-- caller.
--  Original        - this is the type of data that needs to be sent
--  To_Raw          - converts the data to X_Raw_Data
--  Original_Size   - this value corresponds to the number of X_Raw_Data items
--                    required to represent an Original item
--  Display         - display to receive the request
--  D               - the data to send
------------------------------------------------------------------------------

    generic  
        type Original       is private;  
        type Index          is range <>;  
        type Original_Array is array (Index range <>) of Original;  
        with procedure To_Raw (Raw : out X_Raw_Data_Array;  
                               D   :     Original_Array);  
        Original_Size  : in X_Raw_Data_Index := Original'Size / 8;  
        Multiple_Of_32 : in Only_Zero        := Original'Size rem 32;  
    procedure Put_Large_Data_1d (Display : X_Display;  
                                 D       : Original_Array);
------------------------------------------------------------------------------
-- For one-dimensional array types where the element type is "large".  A
-- "large" type is any type whose 'Size is a multiple of 32 bits.
--
-- If you get a Constraint_Error when elaborating this generic then you have
-- tried to instantiate it with a type whose 'Size is not N*32.
--
-- Put data into the buffer going to a particular display.  All X requests
-- are always a multiple of 32 bits (4 bytes) in length.  If the data
-- does not fit into the buffer then the buffer is flushed first.
-- Display.Last_Req is not set; that is up to the caller.
--  Original        - this is the type of data that needs to be sent
--  Index           - this is the index type for the array type
--  Original_Array  - this is the array type
--  To_Raw          - converts the data to X_Raw_Data
--  Original_Size   - all X protocol requests are 4*N bytes long, this value
--                    corresponds to the number of X_Raw_Data items required
--                    to represent a single Original item
--  Multiple_Of_32  - causes Constraint_Error if Original is of an inappropriate
--                    'Size
--  Display         - display to receive the request
--  D               - the data to send
------------------------------------------------------------------------------

    generic  
        type Original       is private;  
        type Index          is range <>;  
        type Original_Array is array (Index range <>) of Original;  
        with procedure To_Raw (Raw : out X_Raw_Data_Array;  
                               D   :     Original_Array);  
        Original_Size : in X_Raw_Data_Index := Original'Size / 8;  
        Less_Than_32  : in Only_Non_Zero    := Original'Size;  
    procedure Put_Small_Data_1d (Display : X_Display;  
                                 D       : Original_Array);
------------------------------------------------------------------------------
-- For one-dimensional array types where the element type is "small".  A
-- "small" type is any type whose 'Size is less than 32 bits.  This is
-- expected to be used for 8 and 16 bit data types.  Other sizes of
-- data will not probably work properly.
--
-- If you get a Constraint_Error when elaborating this generic then you have
-- tried to instantiate it with a type whose 'Size is not N*32.
--
-- Put data into the buffer going to a particular display.  All X requests
-- are always a multiple of 32 bits (4 bytes) in length.  If the data
-- does not fit into the buffer then the buffer is flushed first.
-- Display.Last_Req is not set; that is up to the caller.
--  Original        - this is the type of data that needs to be sent
--  Index           - this is the index type for the array type
--  Original_Array  - this is the array type
--  To_Raw          - converts the data to X_Raw_Data
--  Original_Size   - all X protocol requests are 4*N bytes long, this value
--                    corresponds to the number of X_Raw_Data items required
--                    to represent a single Original item
--  Less_Than_32    - causes Constraint_Error if Original is of an inappropriate
--                    'Size
--  Display         - display to receive the request
--  D               - the data to send
------------------------------------------------------------------------------

    generic  
        type Original       is private;  
        type Index          is range <>;  
        type Original_Array is array (Index range <>) of Original;  
        with procedure To_Raw (Raw : out X_Raw_Data_Array;  
                               D   :     Original_Array);  
        Original_Size : in X_Raw_Data_Index := Original'Size / 8;  
        Less_Than_32  : in Only_Non_Zero    := Original'Size;  
    procedure Put_Small_Data_1d_Unaligned (Display : X_Display;  
                                           D       : Original_Array);
------------------------------------------------------------------------------
-- For one-dimensional array types where the element type is "small".  A
-- "small" type is any type whose 'Size is less than 32 bits.  This is
-- expected to be used for 8 and 16 bit data types.  Other sizes of
-- data will not probably work properly.
--
-- If you get a Constraint_Error when elaborating this generic then you have
-- tried to instantiate it with a type whose 'Size is not N*32.
--
-- Put data into the buffer going to a particular display.  All X requests
-- are always a multiple of 32 bits (4 bytes) in length.  This routine does
-- not preserve that 4-byte alignment requirement.  Callers of this routine
-- are required to make their request a multiple of 4-bytes when they are
-- finished.  If the data does not fit into the buffer then the buffer is
-- flushed first.  Display.Last_Req is not set; that is up to the caller.
--  Original        - this is the type of data that needs to be sent
--  Index           - this is the index type for the array type
--  Original_Array  - this is the array type
--  To_Raw          - converts the data to X_Raw_Data
--  Original_Size   - all X protocol requests are 4*N bytes long, this value
--                    corresponds to the number of X_Raw_Data items required
--                    to represent a single Original item
--  Less_Than_32    - causes Constraint_Error if Original is of an inappropriate
--                    'Size
--  Display         - display to receive the request
--  D               - the data to send
------------------------------------------------------------------------------

    generic  
        type Original       is private;  
        type Index1         is range <>;  
        type Index2         is range <>;  
        type Original_Array is array (Index1 range <>,  
                                      Index2 range <>) of Original;  
        with procedure To_Raw (Raw : out X_Raw_Data_Array;  
                               D   :     Original);  
        with procedure To_Raw (Raw : out X_Raw_Data_Array;  
                               D   :     Original_Array);  
        Original_Size : in X_Raw_Data_Index := Original'Size / 8;  
        Multiple_Of_8 :    Only_Zero        := Original'Size rem 8;  
    procedure Put_Data_2d (Display : X_Display;  
                           D       : Original_Array);
------------------------------------------------------------------------------
-- For two-dimensional array types where the element type is 8, 16, or N*32
-- bits in length.
--
-- If you get a Constraint_Error when elaborating this generic then you have
-- tried to instantiate it with a type whose 'Size is not N*8.
--
-- Put data into the buffer going to a particular display.  All X requests
-- are always a multiple of 32 bits (4 bytes) in length.  If the data
-- does not fit into the buffer then the buffer is flushed first.
-- Display..Last_Req is not set; that is up to the caller.
--  Original        - this is the type of data that needs to be sent
--  Index1          - this is the first index type for the array type
--  Index2          - this is the second index type for the array type
--  Original_Array  - this is the array type
--  To_Raw          - converts the data to X_Raw_Data
--  Original_Size   - all X protocol requests are 4*N bytes long, this value
--                    corresponds to the number of X_Raw_Data items required
--                    to represent a single Original item
--  Less_Than_32    - causes Constraint_Error if Original is of an inappropriate
--                    'Size
--  Display         - display to receive the request
--  D               - the data to send
------------------------------------------------------------------------------

    generic  
        type Request        is private;  
        type Original       is private;  
        type Index          is range <>;  
        type Original_Array is array (Index range <>) of Original;  
        with procedure To_Raw (Raw : out X_Raw_Data_Array;  
                               D   :     Request);  
        with procedure To_Raw (Raw : out X_Raw_Data_Array;  
                               D   :     Original_Array);  
        Request_Size            : in X_Raw_Data_Index := Request'Size / 8;  
        Multiple_Of_32          : in Only_Zero        := Request'Size rem 32;  
        Original_Size           : in X_Raw_Data_Index := Original'Size / 8;  
        Original_Multiple_Of_32 : in Only_Zero        := Original'Size rem 32;  
    procedure Reserve_Request_Large_1d (Display     :     X_Display;  
                                        Max_Spaces  :     S_Natural;
                                        Req         :     Request;  
                                        D           :     Original_Array;
                                        Reservation : out X_Raw_Data_Index;  
                                        Spaces_Left : out S_Natural);
------------------------------------------------------------------------------
-- For Poly X_Request's with one dimensional array arguments only.
-- Do not use this for ordinary private types or for arrays of "small" types.
--
-- Called in an attempt to
--  a) reserve space for a request record and
--  b) to begin placing the array data into the output buffer.
-- Allocates space in the Display.Output buffer for the request and then
-- allocates space in the buffer for the array data.  The array data is
-- copied into the buffer.  The request is not copied unless
--  a) the request plus the array exactly fill up the buffer
--  b) the request plus the array are larger than the buffer.
-- If Spaces_Left = 0 when this returns then the request and the array are
-- both in the buffer and no further array elements can be added to the
-- request.  If Spaces_left > 0 then use Put_large_Data_1d to add new array
-- elements (up to Spaces_Left) and finally use the Place_Reserved_Request
-- generic to place the request when you are all done.
--
-- This is for the use of the various Poly requests where adjacent requests may
-- be joined together to form a smaller number of longer requests.
--
-- Returns the reserved position for the request and the maximum number of
-- further array elements that can be placed into the buffer.
--
-- If you get a Constraint_Error when elaborating this generic then you have
-- tried to instantiate it with a type whose 'Size is not N*32.
--
-- Put data into the buffer going to a particular display.  All X requests
-- are always a multiple of 32 bits (4 bytes) in length.  If the data
-- does not fit into the buffer then the buffer is flushed first.
-- Display.Last_Req is not set; that is up to the caller.
--  Original        - this is the type of data that needs to be sent
--  Index           - this is the index type for the array type
--  Original_Array  - this is the array type
--  Request         - this is the type of data that needs to be sent
--  To_Raw          - converts the data to X_Raw_Data
--  To_Raw          - converts the data to X_Raw_Data
--  Request_Size    - all X protocol requests are 4*N bytes long, this value
--                    corresponds to the number of X_Raw_Data items required
--                    to represent the Request
--  Multiple_Of_32  - causes Constraint_Error if Request is of an inappropriate
--                    'Size
--  Original_Size   - all X protocol requests are 4*N bytes long, this value
--                    corresponds to the number of X_Raw_Data items required
--                    to represent a single Original item
--  Original_Multiple_Of_32  - causes Constraint_Error if Original is of an
--                    inappropriate 'Size
--  Display         - display to receive the request
--  Req             - the X_Request to send
------------------------------------------------------------------------------

    generic  
        type Request is private;  
        with procedure To_Raw (Raw : out X_Raw_Data_Array;  
                               Req :     Request);  
        Request_Size   : in X_Raw_Data_Index := Request'Size / 8;  
        Multiple_Of_32 : in Only_Zero        := Request'Size rem 32;  
    procedure Place_Reserved_Request (Display     : X_Display;  
                                      Req         : Request;  
                                      Reservation : X_Raw_Data_Index);
------------------------------------------------------------------------------
-- For X_Request's only.  Do not use this for ordinary private types.
--
-- If you get a Constraint_Error when elaborating this generic then you have
-- tried to instantiate it with a type whose 'Size is not N*32.
--
-- Put data into a reserved place within the buffer going to a particular
-- display.  All X requests are always a multiple of 32 bits (4 bytes) in
-- length.  Display.Last_Req is not set; that is up to the caller.
--  Request         - this is the type of data that needs to be sent
--  To_Raw          - converts the data to X_Raw_Data
--  Request_Size    - all X protocol requests are 4*N bytes long, this value
--                    corresponds to the number of X_Raw_Data items required
--                    to represent the Request
--  Multiple_Of_32  - causes Constraint_Error if Request is of an inappropriate
--                    'Size
--  Display         - display to receive the request
--  Req             - the X_Request to send
------------------------------------------------------------------------------

end Xlbmp_Put;  

E3 Meta Data

    nblk1=21
    nid=0
    hdr6=42
        [0x00] rec0=1a rec1=00 rec2=01 rec3=038
        [0x01] rec0=13 rec1=00 rec2=02 rec3=08c
        [0x02] rec0=01 rec1=00 rec2=21 rec3=018
        [0x03] rec0=11 rec1=00 rec2=03 rec3=012
        [0x04] rec0=13 rec1=00 rec2=04 rec3=00e
        [0x05] rec0=00 rec1=00 rec2=20 rec3=012
        [0x06] rec0=10 rec1=00 rec2=05 rec3=078
        [0x07] rec0=12 rec1=00 rec2=06 rec3=096
        [0x08] rec0=01 rec1=00 rec2=1f rec3=008
        [0x09] rec0=10 rec1=00 rec2=07 rec3=08c
        [0x0a] rec0=12 rec1=00 rec2=08 rec3=03e
        [0x0b] rec0=12 rec1=00 rec2=09 rec3=03e
        [0x0c] rec0=00 rec1=00 rec2=1e rec3=02e
        [0x0d] rec0=11 rec1=00 rec2=0a rec3=022
        [0x0e] rec0=12 rec1=00 rec2=0b rec3=056
        [0x0f] rec0=00 rec1=00 rec2=1d rec3=026
        [0x10] rec0=11 rec1=00 rec2=0c rec3=086
        [0x11] rec0=12 rec1=00 rec2=0d rec3=096
        [0x12] rec0=01 rec1=00 rec2=1c rec3=01a
        [0x13] rec0=10 rec1=00 rec2=0e rec3=020
        [0x14] rec0=13 rec1=00 rec2=0f rec3=026
        [0x15] rec0=00 rec1=00 rec2=1b rec3=02c
        [0x16] rec0=11 rec1=00 rec2=10 rec3=088
        [0x17] rec0=01 rec1=00 rec2=1a rec3=014
        [0x18] rec0=12 rec1=00 rec2=11 rec3=060
        [0x19] rec0=01 rec1=00 rec2=19 rec3=00e
        [0x1a] rec0=0d rec1=00 rec2=12 rec3=09a
        [0x1b] rec0=01 rec1=00 rec2=18 rec3=050
        [0x1c] rec0=11 rec1=00 rec2=13 rec3=06c
        [0x1d] rec0=12 rec1=00 rec2=14 rec3=03e
        [0x1e] rec0=12 rec1=00 rec2=15 rec3=040
        [0x1f] rec0=10 rec1=00 rec2=16 rec3=05c
        [0x20] rec0=0b rec1=00 rec2=17 rec3=000
    tail 0x2150095588197806bc45e 0x42a00088462063203