Google
 

Trailing-Edge - PDP-10 Archives - BB-LW55A-BM_1988 - language-sources/dixstr.bli
There are 21 other files named dixstr.bli in the archive. Click here to see a list.
%TITLE 'DIXSTR -- String Conversion Module'

MODULE dixstr

!  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 >DIXSTR
!
!   The module DIXSTR contains the string conversion routines.
!
!   FACILITY: Data Conversion Routines (DIX)
! 
!   ABSTRACT: String conversion routines and related data
! 
!   ENVIRONMENT:
! 
!   AUTHOR: David Dyer-Bennet, Creation Date: 11-Feb-82
!--

    (					!
    IDENT = '2.1(53)'                   ! \.p;\
                                        ! **EDIT**
    %REQUIRE ('DIXSWI.REQ')             ! [%O'34'] 
%BLISS36 (
        , ENTRY (                       ! ; .P;Entry names:
        dixstr                          ! \
        )
)
    ) =

BEGIN

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

REQUIRE 'DIXREQ.REQ';                   ! \

!++
! .hl 1 Library files
!--

LIBRARY 'DIXCST';                       ! \
%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 (%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 (off)

!++
! .hl 1 Own storage
!--

! [7] Remove version number word

! [7] Add dixcst library version number word
OWN                                     ! [7] 
    dix$g_dixcst_version: INITIAL (dix$k_dixcst_version);       ! [7] 

!
! ; .hl 2 CST's
! ;   Expand the information from DIXCST into the necessary CST entries
! ; for each character set:
!
build_cst ('ascii')                     ! ; ASCII,
build_cst ('sixbit')                    ! ; SIXBIT, and
build_cst ('ebcdic')                    ! ; EBCDIC.
%SBTTL 'String data-type table extension (dix$adttx_st)'

!++
! .hl 2 >dix$adttx_st
!   The dix$adttx_st is an extension of the basic dix$adtt_st.  They would be one
! table, but combining them would cause loading problems if the string
! conversion routines are not loaded.  The common module will make references
! to the dix$adtt_st, so it cannot be pulled out and added to this.  So it
! got segmented.  Soitgoes.
!
!   The dix$adttx_st contains the maximum value for a character of the specified
! type, and the address of the cst to use in converting to/from that type.
!
!   Here's the exact dttx definition:
! .s1
! .literal
!--

!++ copy
$field
    stdx_fields =
	SET
	stdx$v_max_char = [$byte],      ! Maximum character value
	stdx$v_cst_max = [$byte],       ! Maximum table index
	stdx$v_cst_addr = [$address],   ! Address of cst
        stdx$v_fill_char = [$bits(8)],  ! Widest character set so far is 8
        stdx$v_sub_for_invalid = [$bits(8)]
	TES;

LITERAL
    stdx$k_size = $field_set_size;

!-- .end literal

MACRO
    decl_string_item                    ! \.P;Macro >\ =
        (class_code, item_name, short_name, type_code,
        byt_size, sys_orig, lng_spec, char_set_name, fill_char,
        sub_for_invalid) =
    !++
    ! this local definition will be used when dt_class_string_def is
    ! expanded.  It selects the items we care about from the full set of
    ! information stored in DIXLIB and generates PRESET items to initialize
    ! the table.
    !--
        [type_code, stdx$v_max_char] = %NAME ('cst$k_', char_set_name, '_max'),
        [type_code, stdx$v_cst_max] = MAX (
            %NAME ('cst$k_', char_set_name, '_max'),    ! 
            %NAME ('cst$k_', char_set_name, '_si_max')   ! 
        ),                          ! 
        [type_code, stdx$v_cst_addr] = %NAME ('dix$acst_', char_set_name),
        [type_code, stdx$v_fill_char] = fill_char,
        [type_code, stdx$v_sub_for_invalid] = sub_for_invalid,
    %;

OWN
    dix$adttx_st : BLOCKVECTOR [dt_class_string_max + 1, stdx$k_size]	!
	FIELD (stdx_fields)             !
    	PSECT (readonly_psect)          ! \.p;Assign dix$adttx_st to \.
	PRESET (                        ! Begin PRESET
            dt_class_string_def         ! Pull our info from master table
            [0, stdx$v_cst_addr] = 0    ! Previous macro leaves trailing ","
        );                              ! End PRESET
%SBTTL 'External References'

!++
! .hl 1 External references
!--

EXTERNAL                                ! \.p;\:

!++ copy /strip 
    dix$adtt_st : dtt_st;
!-- 

EXTERNAL ROUTINE                        ! \.p;\:
! ; .list 0, "o"
!++ copy /strip .le;
    dix$$fetch_bits,
    dix$$stuff_bits : NOVALUE,
    dix$$incr_des : NOVALUE,
    dix$$copy_structure : NOVALUE,
    dil$$usr_intrfc_hand,
    dix$$port_hand,
    dix$$check_ffd : NOVALUE;
!-- .end list
%SBTTL 'GLOBAL ROUTINE dix$$con_str'

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

!++
!   Portal For String Conversions.
! 
!   SCH:  Level = 1, DD = 2.  Pseudonym >dixstr>. 
! 
!   Algorithm: Convert string to an 8-bit intermediate form (note: thus
! we cannot handle character sets with more than 256 distinct
! characters).  Convert the intermediate form to the destination
! character set.  Use conversion tables for both directions (thus it's
! very easy to add additional character sets, or to change conversions).
! Strings longer than some threshold value will be converted in chunks
! (thus it is implicit in our definition of string that there is not
! interaction between characters).
! 
!     For first release, chunk size will be 1.  This makes for easiest
! system independence.  If performance becomes a problem and it is found
! feasible to format the conversion tables for use by optimized string
! conversion instructions on various systems, then this could be done.
! 
!   The size of the intermediate bytes, 8 bits, is not a crucial design
! feature.  The main effect of increasing it would most likely be a
! moderate decrease in performance, especially on VAX systems.  It will
! be a compile-time parameter of the source code.  Thus, no problem is
! anticipated if it becomes necessary to support a character set
! containing more than 256 characters.
! 
!   No error checking is performed on the descriptor; this is an
! internal routine, and it is the duty of the calling routines to do the
! necessary checking (remember that, in many cases, the descriptor will
! just have been put together by the caller).
! 
!   Routine value: Status Value, one of the following:
! .s 1.list 1, "o"
! .le;dix$_invalchar
! .le;dix$_graphic
! .le;dix$_fmtlost
! .le;dix$_nonprint
! .le;dix$_trunc
! .end list
! 
!   Formal arguments:
!--
    (                                   ! ; .s 1.list 1
    src_ffd,                            ! \.le;\: Address of FFD describing source field
    dst_ffd                             ! \.le;\: Address of FFD describing destination field
    ) =                                 ! ; .end list

    BEGIN                               ! Begin dix$$con_str

    MAP
	src_ffd : REF forgn_descr,
	dst_ffd : REF forgn_descr;

    $field
        flg_fields =
            SET
            flg$v_invalid = [$bit],
            flg$v_graphic = [$bit],
            flg$v_format = [$bit],
            flg$v_noprint = [$bit],
            flg$v_trunc = [$bit],
            flg$v_src_done = [$bit]
            TES;

    LITERAL
        flg$k_size = $field_set_size;

    LOCAL
        error_temp: VOLATILE,
	src_char,
	dst_char,
	si_char,
	src_tbl,
	dst_tbl,
        char_cnt,
        src_char_cnt,			! Must init to 0
        dst_char_cnt,			! Must init to 0
        flags : BLOCK [flg$k_size] FIELD (flg_fields),	! Must init to 0
	src_pnt : forgn_descr,		! "Pointer" to be incremented
	dst_pnt : forgn_descr;          ! "Pointer" to be incremented

    ENABLE dix$$port_hand (error_temp); ! \.p;

    ROUTINE get_src_si                  ! \.!=;.hl 2 \ (local)
    ! ; .index get_src_si (local)

    !++
    !   Local to dix$$con_str.
    !
    !   This routine attempts to get the next character from the source.
    ! The SI for that character is returned as the routine value, if a
    ! character is found.  The various flags in the flag word are updated.
    ! In particular, the src_done flag is set if no character is returned.
    !
    !   The source pointer is incremented if a character is found and returned.
    ! Note that this means that the address of the character after the last
    ! one in a counted string must be a valid address (it need not be
    ! actually readable).
    !
    !   SCH:  Level = 2
    !
    !   Routine value: String Intermediate (SI) form of character found, or 
    ! si$k_invalid if an invalid source character found, or 0 if nothing found
    ! (in this case, the end-of-source flag should be set).
    !
    !   Formal Arguments:
    !--
        (                               ! ; .s 1.list 1
        src_pnt,                        ! \.le;\: Address of modifiable source FFD
                                        ! ; (the FFD is modified)
        src_tbl,                        ! \.le;\: Address of source CST
        char_cnt,                       ! \.le;\: Adr of count of src chars used
                                        ! ; (incremented)
        flags                           ! \.le;\: Address of flag word
                                        ! ; (the flags are modified)
        ) =                             ! ; .end list

        BEGIN                           ! Routine get_src_si

        MAP
            src_pnt: REF forgn_descr,
            src_tbl: REF cst (0),       ! Actual size is irrelevant
            flags: REF BLOCK [flg$k_size] FIELD (flg_fields);

        LOCAL
            src_char,
            char_found,			! Set if a character from src is being returned
					! Must init to 0
            si_char;

	char_found = 0;			! Initialize local variable
        CASE .dix$adtt_st [.src_pnt [ffd$v_dt_type], std$v_lng_indic] FROM 1 TO std$k_max_lng_indic OF
	SET

	[std$k_lng_spec] :
	    !
	    ! Length of src field is explicitly specified
	    !
	    BEGIN                       ! CASE: std$k_lng_spec
            IF ..char_cnt LSS .src_pnt [ffd$v_length]
            THEN
                BEGIN                   ! IF .char_cnt LSS .src_pnt [ffd$v_length]
                char_found = 1;     ! Something was really found
                src_char = dix$$fetch_bits (.src_pnt [ffd$v_unit], .src_pnt [ffd$v_offset],
                        .dix$adtt_st [.src_pnt [ffd$v_dt_type], std$v_byt_siz]);
                END                     ! IF .char_cnt LSS .src_pnt [ffd$v_length]
            ELSE
                flags [flg$v_src_done] = 1;
	    END;                        ! CASE: std$k_lng_spec

	[std$k_lng_nul] :
	    !
	    ! Source field is terminated by a trailing NUL
	    !
	    BEGIN                       ! CASE: std$k_lng_nul
            src_char = dix$$fetch_bits (.src_pnt [ffd$v_unit], .src_pnt [ffd$v_offset],
                .dix$adtt_st [.src_pnt [ffd$v_dt_type], std$v_byt_siz]);
            IF .src_char EQL 0
            THEN
                flags [flg$v_src_done] = 1
            ELSE
                char_found = 1;     ! Something was found
	    END;                        ! CASE: std$k_lng_nul
	TES;

        IF .char_found 
        THEN
            BEGIN                       ! Character found
            dix$$incr_des (.src_pnt);
            .char_cnt = ..char_cnt + 1;            
            IF .src_char LEQ .dix$adttx_st [.src_pnt [ffd$v_dt_type], stdx$v_cst_max]
            THEN
                BEGIN                   ! Valid character found
                flags [flg$v_noprint] = .flags [flg$v_noprint] OR !
                    .cst_ref (.src_tbl, .src_char, cst$v_to_si_noprint_err) ;
                flags [flg$v_format] = .flags [flg$v_format] OR ! 
                    .cst_ref (.src_tbl, .src_char, cst$v_to_si_format_err) ;
                flags [flg$v_graphic] = .flags [flg$v_graphic] OR !
                    .cst_ref (.src_tbl, .src_char, cst$v_to_si_graphic_err) ;
                IF .cst_ref (.src_tbl, .src_char, cst$v_to_si_valid)
                THEN                    ! CST entry is valid
                    .cst_ref (.src_tbl, .src_char, cst$v_to_si_char)
                                        ! SI char is routine value
                ELSE
                    BEGIN               ! CST entry is invalid 
                    flags [flg$v_invalid] = 1;
                    si$k_invalid        ! SI char means invalid conversion
                    END                 ! CST entry is invalid 
                END                     ! Valid character found
            ELSE                        ! Invalid character found
                BEGIN                   ! CST entry is nonexistent
                flags [flg$v_invalid] = 1;      ! 
                si$k_invalid            ! SI char means invalid conversion
                END                     ! CST entry is nonexistent
            END                         ! Character found
        ELSE
            0                           ! No character found
        END;                            ! Routine get_src_si

    ROUTINE put_si_dst                  ! \.!=;.hl 2 \ (local)
    ! ; .index put_si_dst

    !++
    !   This routine takes the given SI character code and puts the appropriate
    ! destination character code in the next position of the destination string
    ! pointed to by the pointer FFD given.
    !
    !   The pointer FFD is updated if a character is put to the destination.
    ! This means that the address of the character AFTER any string must be
    ! valid, although it need not be accessible).  If a character cannot be
    ! put to the destination (because the destination is too small) the
    ! truncation flag in the flag word is set.
    !
    !   In the case of fields terminated with a terminating char, room is
    ! saved in the field for that character.  This must be done because it
    ! is not possible to decrement a descriptor, and it is not acceptable to
    ! be unable to truncate a field, preserving the part that fits.
    !
    !   SCH:  Level = 2
    !
    !   Routine value: None
    !
    !   Formal Arguments:
    !--
        (                               ! ; .s 1.list 1
        dst_pnt,                        ! \.le;\: Address of destination FFD
                                        ! ; (FFD is incremented)
        dst_tbl,                        ! \.le;\: Address of destination CST
        char_cnt,                       ! \.le;\: Address of num of chars put to dst
                                        ! ; (incremented)
        flags,                          ! \.le;\: Address of flag word
                                        ! ; (flags are modified)
        si_char                         ! \.le;\: SI code for char to put to dst
    ) : NOVALUE =                       ! ; .end list

        BEGIN                           ! ROUTINE put_si_dst
        MAP
            dst_pnt: REF forgn_descr,
            dst_tbl: REF cst (0),       ! Real length doesn't matter
            flags: REF BLOCK [flg$k_size] FIELD (flg_fields);

        IF ..char_cnt GEQ
            (CASE .dix$adtt_st [.dst_pnt [ffd$v_dt_type], std$v_lng_indic] FROM 1 TO std$k_max_lng_indic OF
                SET

                [std$k_lng_spec] :
                    !
                    ! Length of src field is explicitly specified
                    !
                    .dst_pnt [ffd$v_length];
                [std$k_lng_nul] :
                    !
                    ! Source field is terminated by a trailing NUL
                    !
                    .dst_pnt [ffd$v_length] - 1;
                TES )
        THEN
            flags [flg$v_trunc] = 1
        ELSE
            BEGIN
            LOCAL
                loc_si_char;
            loc_si_char = (IF .si_char GTR .dix$adttx_st [.dst_pnt [ffd$v_dt_type], stdx$v_cst_max]
            THEN
                BEGIN
                flags [flg$v_invalid] = 1;
                si$k_invalid
                END
            ELSE
                .si_char);
            IF .cst_ref (.dst_tbl, .loc_si_char, cst$v_to_typ_valid)
            THEN
                BEGIN                   ! CST entry valid
                dix$$stuff_bits (.dst_pnt [ffd$v_unit], .dst_pnt [ffd$v_offset],
                    .dix$adtt_st [.dst_pnt [ffd$v_dt_type], std$v_byt_siz], !
                    .cst_ref (.dst_tbl, .loc_si_char, cst$v_to_typ_char));
                flags [flg$v_noprint] = .flags [flg$v_noprint] OR !
                    .cst_ref (.dst_tbl, .loc_si_char, cst$v_to_typ_noprint_err);
                flags [flg$v_format] = .flags [flg$v_format] OR ! 
                    .cst_ref (.dst_tbl, .loc_si_char, cst$v_to_typ_format_err);
                flags [flg$v_graphic] = .flags [flg$v_graphic] OR !
                    .cst_ref (.dst_tbl, .loc_si_char, cst$v_to_typ_graphic_err);
                END                     ! CST entry valid
            ELSE
                BEGIN                   ! CST entry invalid
                dix$$stuff_bits (.dst_pnt [ffd$v_unit], .dst_pnt [ffd$v_offset],
                    .dix$adtt_st [.dst_pnt [ffd$v_dt_type], std$v_byt_siz], !
                    .dix$adttx_st [.dst_pnt [ffd$v_dt_type], stdx$v_sub_for_invalid]);
                flags [flg$v_invalid] = 1;
                END;                    ! CST entry invalid
            dix$$incr_des (.dst_pnt);
            .char_cnt = ..char_cnt + 1
            END;
        END;                            ! ROUTINE put_si_dst

    ROUTINE dst_cleanup                 ! \.!=;.hl 2 \ (local)
    ! ; .index dst_cleanup

    !++
    !   Local to dix$$con_str.
    !
    !   This routine does necessary tail end processing on an output string
    ! field (such as filling, placing of terminator characters).
    !
    !   SCH:  Level = 2
    !
    !   Routine value: None
    !
    !   Formal Arguments:
    !--
        (                               ! ; .s 1.list 1
        dst_pnt,                        ! \.le;\: Address of destination FFD 
                                        ! ; (FFD is incremented)
        char_cnt,                       ! \.le;\: Character count
        flags                           ! \.le;\: Address of flag word
        ) : NOVALUE =                   ! ; .end list

    BEGIN                               ! ROUTINE dst_cleanup
    MAP
        dst_pnt: REF forgn_descr,
        flags: REF BLOCK [flg$k_size] FIELD (flg_fields);
    !++
    !   Since the terminator for terminated fields is stored in the "fill
    ! character" slot in the dttx, and since put_si_dst guarantees to save
    ! space for the terminator when necessary, all that is necessary to do
    ! is to fill any remaining space with fill characters.
    !--
    INCR local_cnt FROM .char_cnt + 1 TO .dst_pnt [ffd$v_length] DO
        BEGIN                           ! INCR local_cnt
        dix$$stuff_bits (.dst_pnt [ffd$v_unit], .dst_pnt [ffd$v_offset],
            .dix$adtt_st [.dst_pnt [ffd$v_dt_type], std$v_byt_siz], !
            .dix$adttx_st [.dst_pnt [ffd$v_dt_type], stdx$v_fill_char]);
        dix$$incr_des (.dst_pnt)
        END;                            ! INCR local_cnt
    END;                                ! ROUTINE dst_cleanup

    src_char_cnt = 0;			! Initialize local var
    dst_char_cnt = 0;			! Initialize local var
        BEGIN
	LOCAL adr_pnt;
	INCRA adr_pnt FROM flags TO flags + (flg$k_size - 1) * %UPVAL BY %UPVAL DO
	    .adr_pnt = 0		! Initialize local var
	END;

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

    dix$$copy_structure (.src_ffd, ffd$k_size, src_pnt);
    dix$$copy_structure (.dst_ffd, ffd$k_size, dst_pnt);
    src_tbl = .dix$adttx_st [.src_pnt [ffd$v_dt_type], stdx$v_cst_addr];
    dst_tbl = .dix$adttx_st [.dst_pnt [ffd$v_dt_type], stdx$v_cst_addr];
    !
    WHILE 1 DO                          ! Loop until the EXITLOOP executes
        BEGIN
        si_char = get_src_si (src_pnt, .src_tbl, src_char_cnt, flags);
        IF .flags [flg$v_src_done]
        THEN
            BEGIN
            dst_cleanup (dst_pnt, .dst_char_cnt, flags);
            EXITLOOP
            END
        ELSE
            put_si_dst (dst_pnt, .dst_tbl, dst_char_cnt, flags, .si_char);
        END;
    !
    ! ; .hl 2 DIX$$CON_STR status values
    ! ; .p;In order of priority, tell the user what went wrong:
    !
!++ copy /strip .i 5;
    IF .flags [flg$v_invalid] THEN RETURN dix$_invalchar;
    IF .flags [flg$v_graphic] THEN RETURN dix$_graphic;
    IF .flags [flg$v_format] THEN RETURN dix$_fmtlost;
    IF .flags [flg$v_noprint] THEN RETURN dix$_nonprint;
    IF .flags [flg$v_trunc] THEN RETURN dix$_trunc;
    RETURN dix$success_cond;
!--
    END;					! End of dix$$con_str

END						! End MODULE dixstr

ELUDOM