Google
 

Trailing-Edge - PDP-10 Archives - bb-lw55a-bm - language-sources/posgen.bli
There are 21 other files named posgen.bli in the archive. Click here to see a list.
%TITLE 'DIX positional interface-specific pieces'

!  COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1983, 1986.
!  ALL RIGHTS RESERVED.
!  
!  THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED  AND
!  COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
!  THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS  SOFTWARE  OR
!  ANY  OTHER  COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
!  AVAILABLE TO ANY OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE
!  SOFTWARE IS HEREBY TRANSFERRED.
!  
!  THE INFORMATION IN THIS SOFTWARE IS  SUBJECT  TO  CHANGE  WITHOUT
!  NOTICE  AND  SHOULD  NOT  BE CONSTRUED AS A COMMITMENT BY DIGITAL
!  EQUIPMENT CORPORATION.
!  
!  DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF
!  ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!
MODULE POSGEN                           ! \.hl 1 \

!++
! .chapter >POSGEN
!
!   This file contains many modules which contribute to the positional
! user interfaces to the Data Conversion Routines on various systems.
! The separate modules are used to facilitate automatic loading of the
! minimal subset of these routines needed to perform the conversions
! that the user actually invokes.  This can be important on systems
! that do not use extended addressing.
!--
    (
    IDENT = '2.1(141)'                  ! \.P;
                                        ! **EDIT**
    %REQUIRE ('DILSWI.REQ')             ! [%O'73']
%BLISS36 (
        , ENTRY  (                      ! ; .P;Entry names: 
            CVGEN, XDESCR
        )                               ! 
)
    ) =
BEGIN

!++
! .hl 1 Debugging declarations
!--

!++
! .hl 1 Require files
!--

REQUIRE 'dixreq';                       ! \.P;
%sbttl 'Edit History'                   ! [8] Add this entire subsection

!++
! .hl 1 Edit History
!--

LIBRARY 'VERSION';

! ; .autotable

!++ COPY 

new_version (1, 0)

edit (8, '23-Aug-82', 'David Dyer-Bennet')
 %( Change version and revision standards everywhere.
    Files: All. )%

edit (10, '22-Sep-82', 'David Dyer-Bennet')
 %( Always use long_relative addressing on VAX. )%

Edit (11, '27-Sep-82', 'David Dyer-Bennet')
 %( Use ARGADR to access dix$by_dix_des arguments.
    Files: POSGEN.BLI )%

Edit (%O'46', '19-Jan-83', 'David Dyer-Bennet')
 %( Update copyright notice, mark end of edit histories.
 )%

Edit (%O'73', '19-May-83', 'David Dyer-Bennet')
 %( Add DILSWI require file to headings of all modules.  DILSWI
    contains the BLISS32 addressing-mode declarations and the TOPS-10
    OTS declaration to avoid invoking the losing default of .REQUESTING
    the OTS library from whatever directory the compiler was called from
    when the build ran.
 )%

Edit (%O'74', '8-June-83', 'Charlotte L. Richardson')
 %( Declare version 1 complete.  All modules.
 )%

new_version (1, 1)

new_version (2, 0)

Edit (%O'75', '12-Apr-84', 'Sandy Clemens')
 %( Put all Version 2 DIL development files under edit control.  Some
    of the files listed below have major code edits, or are new
    modules.  Others have relatively minor changes, such as cleaning
    up a comment.
    FILES:  COMPDL.CTL, DIL.RNH, DIL2VAX.CTL, DILBLD.10-MIC,
    DILHST.BLI, DILINT.BLI, DILOLB.VAX-COM, DILV6.FOR, DILV7.FOR,
    INTERFILS.CTL, MAKDIL.CTL, MASTER-DIL.CMD, POS20.BLI, POSGEN.BLI,
    DLCM10.10-CTL, DLMK10.10-CTL
 )%

Edit (%O'134', '8-Oct-84', 'Sandy Clemens')
  %( Add new format of COPYRIGHT notice.  FILES:  ALL )%

new_version (2, 1)

Edit (%O'141', '1-Jun-86', 'Sandy Clemens')
  %( Add DIL sources to DL21: directory. )%

! **EDIT**
!-- .autoparagraph

mark_versions ('DIL')
!++
! .hl 1 OWN storage
!--

! [8] Remove version number word

!++
! .hl 1 External References
!--

EXTERNAL ROUTINE                        ! \.P;\:
                                        ! ;.list 0, "o"
!++ Copy /strip .le;
    dil$$usr_intrfc_hand,
    dix$$con_gen,
    dil$$return_kludge,
    dix$$des_by_det;
!-- .end list

%IF %BLISS (BLISS36) %THEN              ! .HL 2 If BLISS36
EXTERNAL ROUTINE                        ! \.p;\:
                                        ! ;.list 0, "o"
!++ copy /strip .le;
    dix$$get_argadr
!-- .end list
;
%FI
%SBTTL 'GLOBAL ROUTINE dix$mak_des_det'

GLOBAL ROUTINE dix$mak_des_det          ! \.!=;.hl 1 \
! ; .index  dix$mak_des_det          
            
!++
!   Make A DIX Field Descriptor From Fixed Parameter List
! 
!   SCH:  Level = 1, DD = 1.  Pseudonym >xdescr>.  User interface routine.
!   
!   Algorithm:   This interface routine simply passes the supplied
! parameters on to DIX$$DES_BY_DET, which does the work.
! 
!   The argument checking for descriptor making is performed in the next
! routine down: dix$$des_by_det.  This is an exception to the general rule
! about arguement checking.
! 
!   Side effects / implicit arguments:
! The return_kludge is used.
! 
!   Routine Value:
! Status value, one of the following (this list is inclusive, not exclusive):
! .list 0, "o"
! .le;dix$_invdattyp                  ! Class or type within class invalid
! .le;dix$_invlng                     ! Length invalid for type specified
! .le;dix$_invscal                    ! Scale invalid for type specified
! .le;dix$_unksys                     ! Unknown system of origin
! .le;dix$_invbytsiz                  ! Invalid byte size
! .le;dix$_align                      ! Invalid original-system alignment
! .end list
! 
!   Formal arguments:
!--
    (                                   ! ; .s 1.list 1
    res_ffd,                            ! \.le;\: (by reference, written)
                                        ! ; The DIX descriptor to be produced
    con_rec,                            ! \.le;\: (by reference) The record
        ! ; in which the field exists.  Must be unit-aligned.
    sys_orig,                           ! \.le;\:  (integer) The code for
        ! ; the system of origin of the record
    byt_siz,                            ! \.le;\: (integer) The byte size to
                                        ! ; interpret the offset in
    byt_off,                            ! \.le;\: (integer) The offset to the
                                        ! ; field in the record, in bytes (as
                                        ! ; defined above)
    bit_off,                            ! \.le;\: (integer) The bit offset to
        ! ; the  field  within  the  selected byte
    dat_typ,                            ! \.le;\: (integer) The code for the 
                                        ! ; data type of the field
    fld_lng,                            ! \.le;\: (integer) The length of the
        ! ; field in the natural units for the data type (value ignored if field
        ! ; is not variable length)

    scal_fac                            ! \.le;\: (integer) The scale factor
        ! ; of the field if it is a fixed-point binary or display-numeric
        ! ; field (including packed decimal) 
    ) :                                 ! ; .end list
FORTRAN_FUNC =                          ! \.P;Use \ Linkage

    BEGIN

    LOCAL
	error_temp : VOLATILE;		! Used by condition handler only

    ENABLE                              ! \.P;\
	dil$$usr_intrfc_hand (error_temp);	! \\Standard condition handler
    					! for user interface routines
    dil$$return_kludge (dix$$des_by_det (argadr (.res_ffd),
        argadr (.con_rec), .(argadr (.sys_orig)), 
        .(argadr (.byt_siz)), .(argadr (.byt_off)),
        .(argadr (.bit_off)), .(argadr (.dat_typ)),
        .(argadr (.fld_lng)), .(argadr (.scal_fac))))	! Pass status value upwards
    END;				! END OF DIX$MAK_DES_DET
%SBTTL 'GLOBAL ROUTINE dix$by_det'

GLOBAL ROUTINE dix$by_det               ! \.!=;.hl 1 \
! ; .index  dix$by_det               

!++
!   Convert all data types from fixed parameter list
! 
!   SCH:  Level = 1.  DD = 1.  Pseudonym >cvgen>. User interfacr routine.
! 
!   This  routine  uses  a  positional  parameter  list.   The  use  of  a
! positional  parameter  list  makes  it  easier  to  write  application
! programs layered on top of the DIX.
! 
!   This routine will perform any conversion supported by the DIX package.
! 
!   Algorithm:  Call DIX$$DES_BY_DET  to  make  descriptors,  then  portal
! DIX$$CON_GEN.
! 
!   Note that passing a field as the record and specifying both offsets as
! zero allows you to pass a bare field to CVGEN.
! 
!   This interface routine is part of both the  DEC-10/20  Positional  and
! the DEC-10/20 Non-Positional interfaces.
! 
!   Routine value: Status value
! .list
! .le;dix$_rounded
! .le;dix$_toobig
! .le;dix$_invdattyp
! .le;dix$_unkargtyp
! .le;dix$_unksys
! .le;dix$_invlng
! .le;dix$_invscal
! .le;dix$_graphic
! .le;dix$_fmtlost
! .le;dix$_nonprint
! .le;dix$_trunc
! .le;dix$_unimp
! .le;dix$_invalchar
! .le;dix$_align
! .le;dix$_unnorm
! .le;dix$_impossible
! .le;dix$_unsigned
! .le;dix$_invbytsiz
! .le;dix$_invdnumchr
! .le;dix$_invdnumsgn
! .le;dix$_invpddgt
! .le;dix$_invpdsgn
! .end list
!
!   Formal arguments:
!--
    (
    					! ; .p;Source:
                                        ! ; .s 1.list 1
    src_rec, 				! \.le;\: Record (use argadr; may be descriptor)
    src_sys, 				! \.le;\: Adr of system code
    src_byt_siz, 			! \.le;\: adr of byte size
    src_byt_off, 			! \.le;\: adr of byte offset
    src_bit_off, 			! \.le;\: adr of bit offset
    src_dat_typ, 			! \.le;\: adr of data type
    src_lng, 				! \.le;\: adr of length
    src_scal_fac, 			! \.le;\: adr of scale factor
    					! ; .end list
                                        ! ; .P; Destination:
                                        ! ; .list 1
    dst_rec, 				! \.le;\: Record (use argadr; may be descriptor)
    dst_sys, 				! \.le;\: Adr of system code
    dst_byt_siz, 			! \.le;\: adr of byte size
    dst_byt_off, 			! \.le;\: adr of byte offset
    dst_bit_off, 			! \.le;\: adr of bit offset
    dst_dat_typ, 			! \.le;\: adr of data type
    dst_lng, 				! \.le;\: adr of length
    dst_scal_fac			! \.le;\: adr of scale factor
    ) :                                 ! ;.end list
    FORTRAN_FUNC =                      ! \.p;Use \ linkage

    BEGIN				! dix$by_det

    LOCAL
	src_ffd : forgn_descr,
	dst_ffd : forgn_descr,
	handler_temp : VOLATILE,
	temp_status : condition_value;

    ENABLE                              ! \.p;\
	dil$$usr_intrfc_hand (handler_temp);    ! \

    ! ; .HL 3 Flow of code

    !++
    !   Make a descriptor (in local storage) for the source and destination
    ! fields.
    !--
    temp_status = dix$$des_by_det (src_ffd,
        argadr (.src_rec), .(argadr (.src_sys)), 
        .(argadr (.src_byt_siz)), .(argadr (.src_byt_off)), 
        .(argadr (.src_bit_off)), .(argadr (.src_dat_typ)), 
        .(argadr (.src_lng)), .(argadr (.src_scal_fac)));

    IF NOT .temp_status [sts$v_success] THEN RETURN dil$$return_kludge (.temp_status);

    temp_status = dix$$des_by_det (dst_ffd,
        argadr (.dst_rec), .(argadr (.dst_sys)),
        .(argadr (.dst_byt_siz)), .(argadr (.dst_byt_off)),
        .(argadr (.dst_bit_off)), .(argadr (.dst_dat_typ)),
        .(argadr (.dst_lng)), .(argadr (.dst_scal_fac)));

    IF NOT .temp_status [sts$v_success] THEN RETURN dil$$return_kludge (.temp_status);

    !++
    !   Perform the indicated conversion.
    !--
    dil$$return_kludge (dix$$con_gen (src_ffd, dst_ffd))	! ; Return the status value.
    END;				! dix$by_det
%SBTTL 'GLOBAL ROUTINE DIX$BY_DIX_DES'

GLOBAL ROUTINE dix$by_dix_des           ! \.!=;.hl 1 \
! ; .index  dix$by_dix_des           

!++
!    Convert all types by descriptor
!
!   SCH:  Level = 1, DD = 1.  Pseudonym >xcgen>.  User interface routine.
!
!   Algorithm:  This interface routine simply passes its arguments on  in
! proper  form  to  >DIX$$CON_GEN>,  which  dispatches  to  the conversion
! routines necessary.
!
!   Routine value:
! .list
! .le;dix$_rounded
! .le;dix$_toobig
! .le;dix$_invdattyp
! .le;dix$_unkargtyp
! .le;dix$_unksys
! .le;dix$_invlng
! .le;dix$_invscal
! .le;dix$_graphic
! .le;dix$_fmtlost
! .le;dix$_nonprint
! .le;dix$_trunc
! .le;dix$_unimp
! .le;dix$_invalchar
! .le;dix$_align
! .le;dix$_unnorm
! .le;dix$_impossible
! .le;dix$_unsigned
! .le;dix$_invbytsiz
! .le;dix$_invdnumchr
! .le;dix$_invdnumsgn
! .le;dix$_invpddgt
! .le;dix$_invpdsgn
! .end list
!
!   Formal arguments:
! .s 1
! .list 1
!--
    (
    src_ffd,				! \.le;\: Adr of FFD for source field
    dst_ffd				! \.le;\: Adr of FFD for destination field
    ) : FORTRAN_FUNC =                  ! ; .END LIST

    BEGIN				! routine dix$by_dix_des

    MAP
    	src_ffd: REF forgn_descr,
    	dst_ffd: REF forgn_descr;

    LOCAL
    	temp_status: condition_value,
    	handler_temp : VOLATILE;

    ENABLE                              ! \.P;
        dil$$usr_intrfc_hand (handler_temp);    ! \

    dil$$return_kludge (dix$$con_gen (argadr (.src_ffd),        ! [11] 
        argadr (.dst_ffd)))             ! [11] 
    END;				! routine dix$by_dix_des

END                                     ! MODULE POSGEN
ELUDOM