Trailing-Edge
-
PDP-10 Archives
-
BB-H138F-BM_1988
-
7-sources/diucsr.b36
There are 4 other files named diucsr.b36 in the archive. Click here to see a list.
%TITLE 'Write Conversion Statistics Report'
MODULE DIUCSR (IDENT = '253',
ENTRY (DIU$CSR)
) =
BEGIN
!++
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 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.
!
! FACILITY: DIU Data Interchange Utility
!
! ABSTRACT: Routines to process the DIU transform structure for
! data conversion / transformation. These routines
! extract the appropriate information out of each
! transform node and perform the data conversion
! specified by that information. The data conversion
! is performed by the DIL data conversion routines.
!
! AUTHOR: Sandy Clemens, Creation Date: 26-Jun-85
! EDIT HISTORY:
!
! 253 Change CRX library to DIUCRX.
! Gregory A. Scott 1-Jul-86
!
! 240 Change name to DIU$CSR - something that makes sense for output in DDT.
! Use the DIXTAB that is in DIUERR rather than having another copy here.
! Gregory A. Scott 19-Jun-86
!
! 236 Change library of DIXLIB to DIUDIX.
! Sandy Clemens 19-Jun-86
!
! 235 Add DIUCSR.B36: Rewrite from DIUCSR.BLI to reflect changes in DIU
! and remove TOPS-10 and VMS conditionals.
! Sandy Clemens 18-Jun-86
!--
%SBTTL 'Libraries and Literals'
LIBRARY 'DIUTLB';
LIBRARY 'DIUCRX';
LIBRARY 'BLI:XPORT'; ! XPORT definitions
LIBRARY 'DIU'; ! DIU TOPS-20 MESSAGE definitions
UNDECLARE %QUOTE STS$K_SEVERE, %QUOTE STS$K_ERROR, %QUOTE STS$K_WARNING,
%QUOTE STS$K_SUCCESS, %QUOTE SS$_NORMAL, %QUOTE STS$K_INFO;
LIBRARY 'DIUDIX'; ! DIX definitions
LITERAL header_typ = 1, ! literals used to identify different
field_head_typ = 2, ! types of things which can be written
msg_typ = 3, ! to the terminal or log file for the
end_typ = 4; ! conversion statistics report
EXTERNAL ROUTINE LJ$UTXT,
FAOL,
SINGLE_FQN_NAME;
EXTERNAL dixtab : DIU_ERROR_TABLE(), ! DIX error table
interactive, ! TRUE if interactive
tty : $XPO_IOB(); ! Terminal IOB
%SBTTL'Routine WRITE_LINE -- write a line to the user log file'
ROUTINE WRITE_LINE (type, p_descr, dix_cond, num_errs) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION
!
! This routine writes either a report header, field header, "end of
! report" message, or report entry for the conversion statistics report.
!
! FORMAL PARAMETERS
!
! type integer (literal) identifying the type of entry
! to be written
!
! p_descr the message to be written
!
! dix_cond an error condition if this is a report entry with
! an associated condition value
!
! num_errs the number of times the error occurred (if this is
! a report entry with an associated error condition)
!
! ROUTINE VALUE
!
! NONE
!--
BEGIN
LOCAL descr : REF $STR_DESCRIPTOR(CLASS = DYNAMIC),
strng : $STR_DESCRIPTOR(),
outlen : INITIAL (512), ! for FAOL call
outbuf : $STR_DESCRIPTOR (CLASS = DYNAMIC_BOUNDED, STRING = (0, 0));
$STR_DESC_INIT (DESCRIPTOR = strng, CLASS = DYNAMIC);
SELECTONE .type OF
SET
[header_typ] : ! write the report header
$STR_COPY (TARGET = strng,
STRING = %STRING ('| Conversion statistics',
%CHAR (13, 10)));
[field_head_typ] : ! write field header
BEGIN
descr = .p_descr;
$STR_COPY (TARGET = strng,
STRING = $STR_CONCAT ('|',
%CHAR (13, 10), ! CRLF
'| Field ',
.descr,
%CHAR (13, 10)));
END;
[msg_typ] : ! write a report entry w/ condition
! message and count of occurrences
BEGIN
INCR indx FROM 0 TO dix_max_cond DO
IF .dixtab [.indx, DIU$G_ERRTAB_CODE] EQL .dix_cond
THEN BEGIN
! make string w/dix error in it
$STR_COPY (STRING = $STR_CONCAT ('| ',
dixtab [.indx, DIU$T_ERRTAB_TEXT],
' occurred !SL time!%S',
%CHAR (13, 10)
),
TARGET = strng);
$XPO_GET_MEM (CHARACTERS = .outlen, DESC = outbuf, FILL = %C' ');
FAOL (strng, outlen, outbuf, num_errs); ! let faol fill string
$STR_COPY (STRING = outbuf, TARGET = strng);
$XPO_FREE_MEM (STRING = outbuf);
END;
END;
[end_typ] : ! write "end of report" message
$STR_COPY (TARGET = strng,
STRING = %STRING('|', %CHAR(13,10), '| End conversion statistics'));
TES;
!
! Write the text
!
IF .interactive
THEN $XPO_PUT (IOB = tty, STRING = strng) ! Write message to terminal
ELSE LJ$UTXT(strng); ! Write to LOG file
END; ! end of routine WRITE_LINE
%SBTTL 'DIU$CSR -- Conversion Statistics Report'
GLOBAL ROUTINE DIU$CSR (p_trans) =
!++
! FUNCTIONAL DESCRIPTION
!
! This routine writes a data conversion statistics report to the user log
! file or the terminal after data conversion has been completed.
!
! FORMAL PARAMETERS
!
! p_trans address of the transform node which contains the FFDs for
! which the conversion error occurred
!
! ROUTINE VALUE
!
! FALSE if we had any errors
! TRUE if there were no errors
!
!--
BEGIN
LOCAL trans : REF transform_str,
src_nam : $STR_DESCRIPTOR(),
dst_nam : $STR_DESCRIPTOR(),
header_flag : INITIAL (0),
text : $STR_DESCRIPTOR();
trans = .p_trans;
$STR_DESC_INIT (DESCRIPTOR = text, CLASS = DYNAMIC, STRING = (0, 0));
IF .trans NEQ 0
THEN DO BEGIN
IF .trans [tra_worst] NEQ 0 ! if there are errors for this field
THEN ! then tell the user...
BEGIN
! make single strings for the names of each field
SINGLE_FQN_NAME (.trans [tra_src_addr], src_nam);
SINGLE_FQN_NAME (.trans [tra_dst_addr], dst_nam);
IF .header_flag EQL 0 ! if header hasn't been written yet,
THEN BEGIN ! then write it...
WRITE_LINE (header_typ, 0, 0, 0);
header_flag = 1;
END;
$STR_COPY (TARGET = text, ! always write the field name header
STRING = ! if there are any errors...
$STR_CONCAT (src_nam, ' to ', dst_nam));
WRITE_LINE (field_head_typ, text, 0, 0);
!
! Errors are stored in the transform structure based on the
! data class of the conversion (either fixed-point data,
! floating-point or string)...
!
CASE .trans [tra_src$v_dt_class] FROM 1 TO dix$k_max_class OF
SET
[dt_string] :
BEGIN
IF .trans [tra_str_rounded] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_ROUNDED,
.trans [tra_str_rounded]);
IF .trans [tra_str_unimp] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_UNIMP,
.trans [tra_str_unimp]);
IF .trans [tra_str_graphic] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_GRAPHIC,
.trans [tra_str_graphic]);
IF .trans [tra_str_fmtlost] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_FMTLOST,
.trans [tra_str_fmtlost]);
IF .trans [tra_str_nonprint] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_NONPRINT,
.trans [tra_str_nonprint]);
IF .trans [tra_str_trunc] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_TRUNC,
.trans [tra_str_trunc]);
IF .trans [tra_str_invalchar] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_INVALCHAR,
.trans [tra_str_invalchar]);
END;
[dt_fbin, dt_dnum, dt_pdec] :
BEGIN
IF .trans [tra_fix_rounded] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_ROUNDED,
.trans [tra_fix_rounded]);
IF .trans [tra_fix_unimp] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_UNIMP,
.trans [tra_fix_unimp]);
IF .trans [tra_fix_toobig] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_TOOBIG,
.trans [tra_fix_toobig]);
IF .trans [tra_fix_impossible] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_IMPOSSIBLE,
.trans [tra_fix_impossible]);
IF .trans [tra_fix_unsigned] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_UNSIGNED,
.trans [tra_fix_unsigned]);
IF .trans [tra_fix_invdnumchr] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_INVDNUMCHR,
.trans [tra_fix_invdnumchr]);
IF .trans [tra_fix_invdnumsgn] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_INVDNUMSGN,
.trans [tra_fix_invdnumsgn]);
IF .trans [tra_fix_invpddgt] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_INVPDDGT,
.trans [tra_fix_invpddgt]);
IF .trans [tra_fix_invpdsgn] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_INVPDSGN,
.trans [tra_fix_invpdsgn]);
END;
[dt_fp] :
BEGIN
IF .trans [tra_fp_rounded] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_ROUNDED,
.trans [tra_fp_rounded]);
IF .trans [tra_fp_unimp] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_UNIMP,
.trans [tra_fp_unimp]);
IF .trans [tra_fp_toobig] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_TOOBIG,
.trans [tra_fp_toobig]);
IF .trans [tra_fp_unnorm] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_UNNORM,
.trans [tra_fp_unnorm]);
IF .trans [tra_fp_impossible] NEQ 0
THEN WRITE_LINE (msg_typ, 0, DIX$_IMPOSSIBLE,
.trans [tra_fp_impossible]);
END;
TES;
END;
trans = .trans [tra_next]; ! look at next transform node
END
UNTIL .trans EQL 0; ! until there are no more!
IF .header_flag ! if we had any errors
THEN WRITE_LINE (end_typ, 0, 0, 0); ! write the 'end' message
IF .header_flag ! if we had any errors
THEN FALSE ! return false
ELSE TRUE ! return true
END;
END
ELUDOM