Trailing-Edge
-
PDP-10 Archives
-
BB-H138E-BM
-
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, 1985.
! 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.0(50)' ! \.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 )%
! **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