Google
 

Trailing-Edge - PDP-10 Archives - bb-lw55a-bm - language-sources/dixgen.bli
There are 22 other files named dixgen.bli in the archive. Click here to see a list.
%TITLE 'DIXGEN -- multi-type conversions'

MODULE dixgen

!  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.

!++
! .CHAPTER >DIXGEN
!
!   FACILITY: Data Conversion Routines (DIX)
!
!   ABSTRACT: Conversion routines inherently touching more than one type,
! including mixed type conversions and multi-type interface routines.
!
!   ENVIRONMENT:
!
!   AUTHOR: David Dyer-Bennet, Creation Date: 23-Feb-82
!--

    (                                   !
    IDENT = '2.1(53)'                   ! \.P;
                                        ! **EDIT**
    %REQUIRE ('DIXSWI.REQ')             ! [%O'34'] 
%BLISS36 (
        , ENTRY (                       ! ;.p;Entry names:
            dixgen, dixdxf, dixfxd, dixpxd, dixdxp, dixfxp, dixpxf      ! \
        )                               ! End entry name list
)                                       ! End %BLISS36 conditional
    ) =
BEGIN

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

REQUIRE 'DIXREQ.REQ';                   ! \.p;\
%sbttl 'Edit History'                   ! [7] Add this entire subsection

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

LIBRARY 'VERSION';

! ; .autotable

!++ COPY 

new_version (1, 0)

edit (7, '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')
 %(  In DIX$$CON_GEN in DIXGEN add call to DIX$$CHECK_FFD to avoid branch
    to random location if invalid FFD's are passed in.
    Files: DIXGEN.BLI )%

Edit (%O'30', '19-Jan-83', 'David Dyer-Bennet')
 %(  Update copyright notices, add mark at end of edit histories.
 )%

Edit (%O'34', '19-May-83', 'David Dyer-Bennet')
 %( Add DIXSWI require file to headings of all modules.  DIXSWI
    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'35', '7-June-83', 'Charlotte L. Richardson')
 %( Declare version 1 complete.  All modules.
 )%

new_version (1, 1)

new_version (2, 0)

Edit (%O'36', '11-Apr-84', 'Sandy Clemens')
%( Put all Version 2 DIX 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: COMDIX.VAX-COM, COMPDX.CTL, DIXCST.BLI, DIXDEB.BLI,
   DIXDN.BLI (NEW), DIXFBN.BLI, DIXFP.BLI, DIXGBL.BLI, DIXGEN.BLI,
   DIXHST.BLI, DIXINT.PR1, DIXINT.PR2, DIXLIB.BLI, DIXPD.BLI (NEW),
   DIXREQ.REQ, DIXSTR.BLI, DIXUTL.BLI, DXCM10.10-CTL, MAKDIXMSG.BLI,
   STAR36.BLI, VERSION.REQ.
)%

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

new_version (2, 1)

Edit (%O'53', '3-Jul-86', 'Sandy Clemens')
  %( Add remaining sources to V2.1 area.  Update copyright notices. )%

! **EDIT**
!-- .autoparagraph

mark_versions ('DIX')

!++
! .hl 1 Debugging Declarations
!--

UNDECLARE %QUOTE $descriptor;           ! \.p;\Something leaves this around.

dix$module_debug (on)
!++
! .hl 1 OWN storage
!--

! [7] Remove version number word

!++
! .HL 1 External references
! .S 1
! .LIST 0, "o"
!--

EXTERNAL ROUTINE
!++ COPY /STRIP .LE;
    dix$$check_ffd: NOVALUE,            ! [11] 
    dix$$con_fbin,
    dix$$con_fp,
    dix$$con_str,
    dix$$con_dn,
    dix$$con_pd,
    dix$$con_dn_xi : NOVALUE,
    dix$$con_pd_xi : NOVALUE,
    dix$$con_fb_xi : NOVALUE,
    dix$$con_xi_dn,
    dix$$con_xi_pd,
    dix$$con_xi_fb,
    dix$$des_by_det,
    dix$$port_hand,
    dil$$return_kludge;
!-- .END LIST
%SBTTL 'GLOBAL ROUTINE dix$$con_dn_fb'

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

!++
!   Portal for Display Numeric to Fixed Binary conversions.
!
!   SCH: Level = 1, DD = 1, pseudonym = >dixdxf>.
!
!   Algorithm: Convert display numeric string to fixed intermediate
! (XI) form.  Convert XI to fixed point binary form.  Use the same
! conversion routines called by single-type portals.
!
!   Routine value:  Status value, one of the following:
! .s 1.list 1 "o"
! .le;Any value returned by dix$$con_dn_xi
! .le;Any value returned by dix$$con_xi_fb
! .end list
!
!   Formal arguements:
!--
    (                                   ! .s 1.list 1
    src_ffd,                            ! \.le;\: Address of source FFD
    dst_ffd                             ! \.le;\: Address of destination FFD
    ) =

BEGIN                                   ! global routine dix$$con_dn_fb

MAP src_ffd : REF forgn_descr,
    dst_ffd : REF forgn_descr;

dix$routine_debug (on)

LOCAL
     error_tmp : VOLATILE,              ! used by the condition handler
     xi_field : xi;                     ! the intermediate form used

ENABLE dix$$port_hand (error_tmp);      ! \Establish condition handler: \

dix$$check_ffd (.src_ffd);
dix$$check_ffd (.dst_ffd);

dix$$con_dn_xi (.src_ffd, xi_field);    ! ;.p;Convert source DNUM field to XI
                                        ! ; form.  Signals if error occurs.

dtype (on, 'XI field before scale adjustment: ');       ! debugging code
debug_code (xidmp (xi_field);                           ! debugging code
            tty_put_crlf());                            ! debugging code

dix$$con_xi_fb (xi_field, .dst_ffd)     ! ;.p; Convert XI form to destination
                                        ! ; FBIN field.  Signals if error and
                                        ! ; may return a warning code.

END;                                    ! end global routine dix$$con_dn_fb
%SBTTL 'GLOBAL ROUTINE dix$$con_dn_pd'

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

!++
!   Portal for Display Numeric to Packed Decimal conversions.
!
!   SCH: Level = 1, DD = 1, pseudonym = >dixdxp>.
!
!   Algorithm: Convert display numeric string to fixed intermediate
! (XI) form.  Convert XI to packed decimal form.  Use the same
! conversion routines called by single-type portals.
!
!   Routine value:  Status value, one of the following:
! .s 1.list 1 "o"
! .le;Any value returned by dix$$con_dn_xi
! .le;Any value returned by dix$$con_xi_pd
! .end list
!
!   Formal arguements:
!--
    (                                   ! .s 1.list 1
    src_ffd,                            ! \.le;\: Address of source FFD
    dst_ffd                             ! \.le;\: Address of destination FFD
    ) =

BEGIN                                   ! global routine dix$$con_dn_pd

MAP src_ffd : REF forgn_descr,
    dst_ffd : REF forgn_descr;

dix$routine_debug (on)

LOCAL
     error_tmp : VOLATILE,              ! used by the condition handler
     xi_field : xi;                     ! the intermediate form used

ENABLE dix$$port_hand (error_tmp);      ! \Establish condition handler: \

dix$$check_ffd (.src_ffd);
dix$$check_ffd (.dst_ffd);

dix$$con_dn_xi (.src_ffd, xi_field);    ! ;.p;Convert source DNUM field to XI
                                        ! ; form.  Signals if error occurs.

dtype (on, 'XI field before scale adjustment: ');       ! debugging code
debug_code (xidmp (xi_field);                           ! debugging code
            tty_put_crlf());                            ! debugging code

dix$$con_xi_pd (xi_field, .dst_ffd)     ! ;.p; Convert XI form to destination
                                        ! ; PDEC field.  Signals if error and
                                        ! ; may return a warning code.

END;                                    ! end global routine dix$$con_dn_pd
%SBTTL 'GLOBAL ROUTINE dix$$con_fb_dn'

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

!++
!   Portal for Fixed Binary to Display Numeric conversions.
!
!   SCH: Level = 1, DD = 1, pseudonym = >dixfxd>.
!
!   Algorithm: Convert fixed point binary field to fixed intermediate
! (XI) form.  Convert XI to display numeric string.  Use the same
! conversion routines called by single-type portals.
!
!   Routine value:  Status value, one of the following:
! .s 1.list 1 "o"
! .le;Any value returned by dix$$con_fb_xi
! .le;Any value returned by dix$$con_xi_dn
! .end list
!
!   Formal arguements:
!--
    (                                   ! .s 1.list 1
    src_ffd,                            ! \.le;\: Address of source FFD
    dst_ffd                             ! \.le;\: Address of destination FFD
    ) =

BEGIN                                   ! global routine dix$$con_fb_dn

MAP src_ffd : REF forgn_descr,
    dst_ffd : REF forgn_descr;

dix$routine_debug (on)

LOCAL
     error_tmp : VOLATILE,              ! used by the condition handler
     xi_field : xi;                     ! the intermediate form used

ENABLE dix$$port_hand (error_tmp);      ! \Establish condition handler: \

dix$$check_ffd (.src_ffd);
dix$$check_ffd (.dst_ffd);

dix$$con_fb_xi (.src_ffd, xi_field);    ! ;.p;Convert source FBIN field to XI
                                        ! ; form.  Signals if error occurs.

dtype (on, 'XI field before scale adjustment: ');       ! debugging code
debug_code (xidmp (xi_field);                           ! debugging code
            tty_put_crlf());                            ! debugging code

dix$$con_xi_dn (xi_field, .dst_ffd)     ! ;.p; Convert XI form to destination
                                        ! ; DNUM field.  Signals if error and
                                        ! ; may return a warning code.

END;                                    ! end global routine dix$$con_fb_dn
%SBTTL 'GLOBAL ROUTINE dix$$con_fb_pd'

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

!++
!   Portal for Fixed Binary to Packed Decimal conversions.
!
!   SCH: Level = 1, DD = 1, pseudonym = >dixfxp>.
!
!   Algorithm: Convert fixed point binary field to fixed intermediate
! (XI) form.  Convert XI to packed decimal form.  Use the same
! conversion routines called by single-type portals.
!
!   Routine value:  Status value, one of the following:
! .s 1.list 1 "o"
! .le;Any value returned by dix$$con_fb_xi
! .le;Any value returned by dix$$con_xi_pd
! .end list
!
!   Formal arguements:
!--
    (                                   ! .s 1.list 1
    src_ffd,                            ! \.le;\: Address of source FFD
    dst_ffd                             ! \.le;\: Address of destination FFD
    ) =

BEGIN                                   ! global routine dix$$con_fb_pd

MAP src_ffd : REF forgn_descr,
    dst_ffd : REF forgn_descr;

dix$routine_debug (on)

LOCAL
     error_tmp : VOLATILE,              ! used by the condition handler
     xi_field : xi;                     ! the intermediate form used

ENABLE dix$$port_hand (error_tmp);      ! \Establish condition handler: \

dix$$check_ffd (.src_ffd);
dix$$check_ffd (.dst_ffd);

dix$$con_fb_xi (.src_ffd, xi_field);    ! ;.p;Convert source FBIN field to XI
                                        ! ; form.  Signals if error occurs.

dtype (on, 'XI field before scale adjustment: ');       ! debugging code
debug_code (xidmp (xi_field);                           ! debugging code
            tty_put_crlf());                            ! debugging code

dix$$con_xi_pd (xi_field, .dst_ffd)     ! ;.p; Convert XI form to destination
                                        ! ; PDEC field.  Signals if error and
                                        ! ; may return a warning code.

END;                                    ! end global routine dix$$con_fb_pd
%SBTTL 'GLOBAL ROUTINE dix$$con_pd_dn'

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

!++
!   Portal for Packed Decimal to Display Numeric conversions.
!
!   SCH: Level = 1, DD = 1, pseudonym = >dixpxd>.
!
!   Algorithm: Convert packed decimal to fixed intermediate (XI) form.
! Convert XI to display numeric form.  Use the same conversion
! routines called by single-type portals.
!
!   Routine value:  Status value, one of the following:
! .s 1.list 1 "o"
! .le;Any value returned by dix$$con_pd_xi
! .le;Any value returned by dix$$con_xi_dn
! .end list
!
!   Formal arguements:
!--
    (                                   ! .s 1.list 1
    src_ffd,                            ! \.le;\: Address of source FFD
    dst_ffd                             ! \.le;\: Address of destination FFD
    ) =

BEGIN                                   ! global routine dix$$con_pd_dn

MAP src_ffd : REF forgn_descr,
    dst_ffd : REF forgn_descr;

dix$routine_debug (on)

LOCAL
     error_tmp : VOLATILE,              ! used by the condition handler
     xi_field : xi;                     ! the intermediate form used

ENABLE dix$$port_hand (error_tmp);      ! \Establish condition handler: \

dix$$check_ffd (.src_ffd);
dix$$check_ffd (.dst_ffd);

dix$$con_pd_xi (.src_ffd, xi_field);    ! ;.p;Convert source PDEC field to XI
                                        ! ; form.  Signals if error occurs.

dtype (on, 'XI field before scale adjustment: ');       ! debugging code
debug_code (xidmp (xi_field);                           ! debugging code
            tty_put_crlf());                            ! debugging code

dix$$con_xi_dn (xi_field, .dst_ffd)     ! ;.p; Convert XI form to destination
                                        ! ; DNUM field.  Signals if error and
                                        ! ; may return a warning code.

END;                                    ! end global routine dix$$con_pd_dn
%SBTTL 'GLOBAL ROUTINE dix$$con_pd_fb'

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

!++
!   Portal for Packed Decimal to Fixed Binary conversions.
!
!   SCH: Level = 1, DD = 1, pseudonym = >dixpxf>.
!
!   Algorithm: Convert packed decimal to fixed intermediate (XI) form.
! Convert XI to fixed point binary form.  Use the same conversion
! routines called by single-type portals.
!
!   Routine value:  Status value, one of the following:
! .s 1.list 1 "o"
! .le;Any value returned by dix$$con_pd_xi
! .le;Any value returned by dix$$con_xi_fb
! .end list
!
!   Formal arguements:
!--
    (                                   ! .s 1.list 1
    src_ffd,                            ! \.le;\: Address of source FFD
    dst_ffd                             ! \.le;\: Address of destination FFD
    ) =

BEGIN                                   ! global routine dix$$con_pd_fb

MAP src_ffd : REF forgn_descr,
    dst_ffd : REF forgn_descr;

dix$routine_debug (on)

LOCAL
     error_tmp : VOLATILE,              ! used by the condition handler
     xi_field : xi;                     ! the intermediate form used

ENABLE dix$$port_hand (error_tmp);      ! \Establish condition handler: \

dix$$check_ffd (.src_ffd);
dix$$check_ffd (.dst_ffd);

dix$$con_pd_xi (.src_ffd, xi_field);    ! ;.p;Convert source PDEC field to XI
                                        ! ; form.  Signals if error occurs.

dtype (on, 'XI field before scale adjustment: ');       ! debugging code
debug_code (xidmp (xi_field);                           ! debugging code
            tty_put_crlf());                            ! debugging code

dix$$con_xi_fb (xi_field, .dst_ffd)     ! ;.p; Convert XI form to destination
                                        ! ; FBIN field.  Signals if error and
                                        ! ; may return a warning code.

END;                                    ! end global routine dix$$con_pd_fb
%SBTTL 'GLOBAL ROUTINE dix$$con_gen'

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

!++
!   Portal For All Data Types
!
!   SCH: Level = 1, DD = 2, pseudonym = >DIXGEN>.
!
!   Algorithm:  Use source and destination data  types  to  index  into  a
! two-dimensional table and determine the proper portal routine to call,
! then do so.
!
!   Routine value: status value, one of the following:
! .s 1.list 1, "o"
! .le;dix$_unimp [11] 
! .LE;Any value returned by dix$$check_ffd [11] 
! .le;Any value returned by dix$$con_str
! .le;Any value returned by dix$$con_fbin
! .le;Any value returned by dix$$con_fp
! .le;Any value returned by dix$$con_dn
! .le;Any value returned by dix$$con_pd
! .le;Any value returned by dix$$con_dn_fb
! .le;Any value returned by dix$$con_dn_pd
! .le;Any value returned by dix$$con_fb_dn
! .le;Any value returned by dix$$con_fb_pd
! .le;Any value returned by dix$$con_pd_fb
! .le;Any value returned by dix$$con_pd_dn
! .end list
!
!   Formal arguments:
! .s 1
! .list 1
!--
    (
    src_ffd, 				! \.le;\: Adr of source field descriptor
    dst_ffd				! \.le;\: Adr of dest field descriptor
    ) =                                 ! ; .end list


    BEGIN				! dix$$con_gen

    MAP
	src_ffd : REF forgn_descr,
	dst_ffd : REF forgn_descr;

    OWN
	!++
        ! .hl 2 >gen_dispatch_tbl (own)
	!   This table gives the portal routine to dispatch to for all
        ! possible pairs of source and destination type-classes.  It is
        ! statically initialized.  The first subscript specifies source
        ! data type class; the second, destination.
	!--
	gen_dispatch_tbl : array [1, dix$k_max_class, 1, dix$k_max_class] 
    	    PSECT (readonly_psect)
    	    PRESET (                    ! ; Supported conversions:
                                        ! ; .list "o"
                [dt_string, dt_string] = dix$$con_str,  ! ;.le;string to string
                [dt_fbin, dt_fbin] = dix$$con_fbin,     ! ;.le;fbin to fbin
                [dt_fp, dt_fp] = dix$$con_fp,           ! ;.le;fp to fp
                [dt_dnum, dt_dnum] = dix$$con_dn,       ! ;.le;dnum to dnum
                [dt_pdec, dt_pdec] = dix$$con_pd,       ! ;.le;pdec to pdec
                [dt_dnum, dt_fbin] = dix$$con_dn_fb,    ! ;.le;dnum to fbin
                [dt_dnum, dt_pdec] = dix$$con_dn_pd,    ! ;.le;dnum to pdec
                [dt_fbin, dt_dnum] = dix$$con_fb_dn,    ! ;.le;fbin to dnum
                [dt_fbin, dt_pdec] = dix$$con_fb_pd,    ! ;.le;fbin to pdec
                [dt_pdec, dt_fbin] = dix$$con_pd_fb,    ! ;.le;pdec to fbin
                [dt_pdec, dt_dnum] = dix$$con_pd_dn     ! ;.le;pdec to dnum

                                        ! ; .end list
            )                           ! End PRESET
    ;					! end OWN

    LOCAL
	rtn_adr,
	handler_temp : VOLATILE;

! ; .hl 2 Flow of code

    ENABLE                              ! \.P;\
	dix$$port_hand (handler_temp);  ! \

    dix$$check_ffd (.src_ffd);          ! [11] Make sure index is valid
    dix$$check_ffd (.dst_ffd);          ! [11] Make sure index is valid

    rtn_adr = .gen_dispatch_tbl [.src_ffd [ffd$v_dt_class], .dst_ffd [ffd$v_dt_class]];

    IF .rtn_adr EQL 0 THEN RETURN dix$_unimp;	! We don't know how to do that!

    (.rtn_adr) (.src_ffd, .dst_ffd)	! ; .P;Call routine indicated, return value
    					! (by default, use default linkage)
    END;				! dix$$con_gen


END					! End MODULE dixgen

ELUDOM