Trailing-Edge
-
PDP-10 Archives
-
BB-FB49A-RM
-
sources/sntmsg.b36
There are no other files named sntmsg.b36 in the archive.
%title 'SNT Message Processor'
module SNTMSG (ident = 'Version 1.02') =
begin
! Copyright (c) 1984, 1985 by
! DIGITAL EQUIPMENT CORPORATION, Maynard, Massachusetts
!
! 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 which is not supplied by Digital.
!++
! FACILITY: DECnet/SNA TOPS-20 Trace Utility Message Processor.
!
! ABSTRACT: This module provides routines to expand message blocks from
! the Access Routines into formatted text strings.
!
! ENVIRONMENT: TOPS-20 Operating Systems, user mode.
!
! AUTHOR: Dennis Brannon, CREATION DATE: January 17, 1984
!
! MODIFIED BY:
!
! D. Brannon, 11-Oct-84 : VERSION 1.00
!
! 1.01 D. Brannon, 29-Oct-84
! Uncommented fatal error SNT$_BADLOGIC in MSG$FORMAT_MESSAGE.
!
! 1.02 D. Brannon, 18-Mar-85
! Removed a -1 on the PU offsets in this file. Changed the offsets
! for PU, SESSION, and CIRCUIT in TRAPRO.R36. PU worked, but
! SESSION and CIRCUIT were off by 3 bytes.
!--
!
! REQUIRED FILES
!
library 'MONSYM'; ! Monitor symbols
library 'SNTDEF'; ! SNT common definitions
library 'SYS:TXTLIB'; ! Text definitions
library 'SNTLIB';
!library 'DBGTRB'; ! Debugging interface to Access Routines
require 'JSYS'; ! TOPS-20 JSYS declarations
!
! FORWARD REFERENCES
!
forward routine
MSG$PRINT_MESSAGE,
MSG$BUILD_OUTPUT,
MSG$FORMAT_LH,
MSG$FORMAT_RH,
MSG$FORMAT_TH,
MSG$FORMAT_DATA : novalue,
MSG$EXPAND_EVENT,
MSG$EXPAND_ERROR,
MSG$WRITE_HEADER_RECORD,
MSG$WRITE_RECORD,
MSG$WRITE_END_RECORD,
MSG$FORMAT_MESSAGE,
MSG$PROCESS_MESSAGE_BLOCK;
!
! OWN STORAGE
!
!
! EXTERNAL REFERENCES
!
external
$EB2AS,
ST: SNTBLOCK;
external ! Buffer for output text
TEXT_BUFFER,
TEXT_POINTER;
external routine
MESAGE_ROUTINES, ! MESAGE routines
GLXLIB_ROUTINES, ! GALAXY routines
TXTWRT,
USP$PLURALIZE,
USP$GET_TIME_STAMP;
!
! MACROS
!
macro ! Interface to MESAGE
EXPAND_MESSAGE_CODE (CODE, ARGS, PTR, SEV) =
begin
local S1;
if MES$EXPAND_CODE (CODE; S1, SEV)
then
begin
ARGS = .S1<18,18,0>;
PTR = ch$ptr (.S1<0,18,0>);
$TRUE
end
else
$FALSE
end %;
%global_routine ('MSG$EXPAND_EVENT', SIZE, MSGBLK) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Function to
!
! FORMAL PARAMETERS:
!
! SIZE Size of the message block
! MSGBLK Address of the message block
!
! ROUTINE VALUE:
!
! $TRUE Successful.
! $FALSE Otherwise.
!
! SIDE EFFECTS:
!
! none
!
!--
begin
MSG$PROCESS_MESSAGE_BLOCK (.SIZE, .MSGBLK);
return $TRUE;
end; ! end of MSG$EXPAND_EVENT
%global_routine ('MSG$EXPAND_ERROR', MSGBLK) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Function to
!
! FORMAL PARAMETERS:
!
! MSGBLK Address of the message block
!
! ROUTINE VALUE:
!
! $TRUE Successful.
! $FALSE Otherwise.
!
! SIDE EFFECTS:
!
! none
!
!--
begin
MSG$PROCESS_MESSAGE_BLOCK (.MSGBLK);
return $TRUE;
end; ! end of MSG$EXPAND_ERROR
%global_routine ('MSG$WRITE_HEADER_RECORD', JFN, MSGADR) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine formats the header into a data buffer as ASCII text
! and then outputs it to the JFN.
!
! FORMAL PARAMETERS:
!
! MSGADR address of the message to be formatted.
! JFN Destination JFN for writting the formatted message
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! TRUE: Successful
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
FOO,
TYPE,
TYPEPTR,
SIZ,
POINTER,
FCT,
TIME,
LENGTH;
bind
L1 = CH$ASCIZ ('SNATRACE Version 1.0 %a Trace %-1y%1< %-1z%N%/'),
L2A = CH$ASCIZ ('Gateway node %X Circuit %X Session %M%N%/'),
L2B = CH$ASCIZ ('Gateway node %X Circuit %X%N%/'),
L2C = CH$ASCIZ ('Gateway node %X Circuit %X%N%/'),
L2D = CH$ASCIZ ('Gateway node %X Circuit %X Session %M%N%/'),
L3 = CH$ASCIZ ('(Protocol version = %M.%M.%M, ',
'Buffering level = %M, Data size = %M)%/%/%N');
TYPE = ch$rchar (ch$ptr (.MSGADR,5,8));
ST[ST_TYPE] = .TYPE;
!
! Type first line
!
selectoneu .TYPE of
SET
[FCT_SESSION_K$TRAPRO]: TYPEPTR = CH$ASCIZ ('Session');
[FCT_PU_K$TRAPRO]: TYPEPTR = CH$ASCIZ ('Physical Unit');
[FCT_CIRCUIT_K$TRAPRO]: TYPEPTR = CH$ASCIZ ('Circuit');
[otherwise]: TYPEPTR = CH$ASCIZ ('<Unknown>');
tes;
POINTER = ch$ptr (.MSGADR,TIME_T$SNTREC,8);
TIME = USP$GET_TIME_STAMP (POINTER);
TEXT_POINTER = ch$ptr(TEXT_BUFFER);
LENGTH = TEXT_BUFFER_LEN;
LENGTH = .LENGTH - TXT_WRITE (TEXT_POINTER, .LENGTH, L1, .TYPEPTR, .TIME);
!
! Setup line 2
!
selectoneu .TYPE of
set
[FCT_SESSION_K$TRAPRO]: FCT = L2A;
[FCT_PU_K$TRAPRO]: FCT = L2B;
[FCT_CIRCUIT_K$TRAPRO]: FCT = L2C;
[otherwise]: FCT = L2D;
tes;
ST[ST_SESSION] = ch$rword (ch$ptr (.MSGADR,SESSION_W$SNTREC,8));
LENGTH = .LENGTH - TXT_WRITE (TEXT_POINTER, .LENGTH, .FCT,
ch$ptr (.MSGADR,NODE_T$SNTREC - 1,8),
ch$ptr (.MSGADR,CIRCUIT_T$SNTREC - 1,8),
.ST[ST_SESSION]);
!
! Setup line 3
!
ST[ST_SIZE] = ch$rword (ch$ptr (.MSGADR,10,8));
SIZ = .ST[ST_SIZE] - SIZE_MIN_K$SNTCOM;
if .TYPE eql FCT_CIRCUIT_K$TRAPRO
then SIZ = .SIZ - 2;
POINTER = ch$ptr (.MSGADR,1,8);
LENGTH = .LENGTH - TXT_WRITE (TEXT_POINTER, .LENGTH, L3,
ch$rchar (.POINTER), ! Version
ch$rchar (ch$plus (.POINTER, 1)), ! DEC ECO
ch$rchar (ch$plus (.POINTER, 2)), ! Customer ECO
ch$rchar (ch$plus (.POINTER, 3)), ! Buffering level
.SIZ); ! Size
LENGTH = TEXT_BUFFER_LEN - .LENGTH;
jsys_sout (.JFN, ch$ptr(TEXT_BUFFER), .LENGTH);
! Write to file
return $TRUE;
end; ! end of MSG$WRITE_HEADER_RECORD
%global_routine ('MSG$WRITE_RECORD', MSGADR, MSGLEN) =
!
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine formats a data buffer into ASCII text and then outputs
! it using the OUTPUT FILE JFN.
!
! FORMAL PARAMETERS:
!
! MSGADR Address of message to be formatted.
! MSGLEN Length of message to be formatted.
! TYPE Type of trace operation being performed.
! WIDE Output width (TRUE=>132 columns, FALSE=>80 columns).
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! none
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! SNT$_NORMAL
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
STATUS;
STATUS = MSG$FORMAT_MESSAGE (.MSGADR, .MSGLEN);
return .STATUS;
end; ! end of MSG$WRITE_RECORD
%global_routine ('MSG$FORMAT_MESSAGE', MSGADR : REF $BPBLOCK, MSGLEN) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine formats a data buffer into ASCII text and then outputs
! it to the output JFN.
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! MSGADR Address of message to be formatted.
! MSGLEN Length of message to be formatted.
! TYPE Type of trace being performed.
! WIDE Width flag (TRUE=>132 columns, FALSE=>80 columns).
! JFN output file or tty jfn.
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! SNT$_NORMAL
! .STATUS
!
! SIDE EFFECTS:
!
! NONE
!
!--
begin
literal
FC_CTL_K$SNAPE = %O'06', ! Control request
FC_TCP_K$SNAPE = %O'12', ! Transmit complete
FC_RCP_K$SNAPE = %O'14', ! Receive complete
FC_CCP_K$SNAPE = %O'20', ! Control complete
HD_LEN_K$SNAPE = 4; ! Length of header
own
TH : $BPBLOCK[2],
RH,
MSG,
LEN;
local
CTLVEC : CH$SEQUENCE (TEXT_BUFFER_LEN),
DATVEC : VECTOR [100] INITIAL (REP 100 OF (0)),
IDX,
FLAG,
ENDMSG,
COUNT,
FNC,
CTL,
CTLPTR,
ADR,
CHRLIM,
CHRPTR,
IFRAME : INITIAL (TRUE),
LENGTH,
MSGNUM,
RHPTR,
RUCNT,
SDLCPTR,
SHORT : INITIAL (FALSE),
STATUS,
THPTR,
POINTER,
PTR,
RUPTR,
RULEN;
bind
NULL = CH$ASCIZ (''),
SP1 = CH$ASCIZ (' '),
SP2 = CH$ASCIZ (' '),
SP3 = CH$ASCIZ (' '),
CTLORG = CH$ASCIZ ('%a'),
CTLCIR = CH$ASCIZ (' Ctl=%K Addr=%K'),
CTLTH = CH$ASCIZ (' TH=%K%K%K%K%K%K'),
CTLNOTH = CH$ASCIZ (' TH=none '),
CTLRH = CH$ASCIZ (' RH=%K%K%K'),
CTLNORH = CH$ASCIZ (' RH=none '),
CTLCNT = CH$ASCIZ (' RU=%(16)M. byte%a %a'),
CTLFNC = CH$ASCIZ ('(%(3)P,%(3)P,%(6)P)%/%a'),
CTLNOHDR = CH$ASCIZ ('Ct=%(16)M. byte%a %a');
MSG = .MSGADR;
LEN = .MSGLEN;
!
! if this is an ANALYZE command with DEBUG enabled,
! then display the trace data we get from the file.
!
if .ST[CMD_ANALYZE]
then begin
$TRACE_MSG (' From file ', .MSGLEN, .MSGADR);
end;
TEXT_POINTER = ch$ptr(TEXT_BUFFER);
LENGTH = TEXT_BUFFER_LEN;
!
! Test for minimum length message.
!
if (PROHDRLEN_K$TRAPRO + HD_LEN_K$SNAPE) GTRA .MSGLEN
then
begin
MSG$PRINT_MESSAGE (SNT$_PROTOCOL);
RETURN SNT$_PROTOCOL;
end;
!
! Test flags for errors.
!
if .MSGADR [FLG_LOST_V$TRAPRO]
then
MSG$PRINT_MESSAGE (SNT$_DATALOST);
if .MSGADR [FLG_TRUN_V$TRAPRO]
then
MSG$PRINT_MESSAGE (SNT$_TRUNC);
CTLPTR = ch$ptr(CTLVEC);
CH$MOVESTRING (CTLPTR, CTLORG);
!
! Set up operation-dependent information.
!
! The type of trace has already been determined from the start trace
! message or from the header in the file.
!
selectone .ST[ST_TYPE] of
set
[FCT_CIRCUIT_K$TRAPRO]:
begin
SDLCPTR = ch$ptr(.MSGADR,PROHDRLEN_K$TRAPRO + HD_LEN_K$SNAPE,8);
THPTR = ch$ptr (.MSGADR,CIRTHT$TRAPRO,8); ! [TRAPRO$T_CIR_TH]
RHPTR = ch$ptr (.MSGADR,CIRRHT$TRAPRO,8); ! [TRAPRO$T_CIR_RH]
RUPTR = ch$ptr (.MSGADR,CIRDAT$TRAPRO,8); ! [TRAPRO$T_CIR_DAT]
end;
[FCT_SESSION_K$TRAPRO]:
begin
SDLCPTR = 0;
THPTR = ch$ptr (.MSGADR,SESTHT$TRAPRO,8); ! [TRAPRO$T_SES_TH]
RHPTR = ch$ptr (.MSGADR,SESRHT$TRAPRO,8); ! [TRAPRO$T_SES_RH]
RUPTR = ch$ptr (.MSGADR,SESDAT$TRAPRO,8); ! [TRAPRO$T_SES_DAT]
end;
[FCT_PU_K$TRAPRO]:
begin
SDLCPTR = 0;
THPTR = ch$ptr (.MSGADR,PUTHT$TRAPRO,8); ! [TRAPRO$T_PU_TH]
RHPTR = ch$ptr (.MSGADR,PURHT$TRAPRO,8); ! [TRAPRO$T_PU_RH]
RUPTR = ch$ptr (.MSGADR,PUDAT$TRAPRO,8); ! [TRAPRO$T_PU_DAT]
end;
[otherwise]:
begin
$SNT_FATAL (SNT$_BADLOGIC,
2,
CH$ASCIZ('MSG$WRITE_RECORD'),
CH$ASCIZ('MSG$FORMAT_MESSAGE'));
end;
tes;
!
! Check the type of trace data (function and modifier).
!
FNC = ch$rchar (ch$ptr (.MSGADR,FNC_B$TRAPRO,8));
selectone .FNC of
set
[FC_TCP_K$SNAPE]: ! Transmit complete
;
[FC_RCP_K$SNAPE]: ! Receive complete
;
[otherwise]: ! Control complete and others
SHORT = TRUE;
tes;
CTL = ch$rchar (ch$ptr (.MSGADR,CIRCTLB$TRAPRO,8));
ADR = ch$rchar (ch$ptr (.MSGADR,CIRADRB$TRAPRO,8));
if (.CTL geqa (.MSGADR + .MSGLEN)) or
(.ADR geqa (.MSGADR + .MSGLEN))
then
begin
SHORT = TRUE;
SDLCPTR = 0;
end;
!
! Move TH into a 6 byte vax style block for MSG$FORMAT_TH
!
PTR = .THPTR;
TH[0,0,8,0] = ch$rchar_a(PTR);
TH[1,0,8,0] = ch$rchar_a(PTR);
TH[2,0,8,0] = ch$rchar_a(PTR);
TH[3,0,8,0] = ch$rchar_a(PTR);
TH[4,0,8,0] = ch$rchar_a(PTR);
TH[5,0,8,0] = ch$rchar_a(PTR);
!
! Check the presence of the message components.
!
ENDMSG = ch$ptr(.MSGADR,.MSGLEN,8);
if not .SHORT
then
begin
!
! if this is a circuit trace but the frame is not an I-frame then
! there is no TH/RH formatting to be done.
!
if .SDLCPTR neqa 0
then
begin
if (not MSG$FORMAT_LH (.CTL, .ADR, TRUE))
then
IFRAME = FALSE;
end;
if (CH$DIFF(.THPTR, .ENDMSG) geq 0) or
(not .IFRAME)
then
begin
RHPTR = .THPTR; ! Back up RU to include TH fields
THPTR = 0;
end;
if (.THPTR eqlu 0) or
(CH$DIFF(.RHPTR, .ENDMSG) geq 0) or
(not MSG$FORMAT_TH (TH, TRUE))
then
begin
RUPTR = .RHPTR; ! Back up RU to include RH fields
RHPTR = 0;
end;
if (CH$DIFF(.RUPTR, .ENDMSG) geq 0)
then
begin
RUPTR = 0;
RULEN = 0;
end
else
RULEN = CH$DIFF(.ENDMSG,.RUPTR);
end
else
begin
SDLCPTR = 0;
THPTR = 0;
RHPTR = 0;
RUPTR = CH$PTR(.MSGADR,PROHDRLEN_K$TRAPRO + HD_LEN_K$SNAPE,8);
RULEN = CH$DIFF(.RUPTR,.ENDMSG);
end;
!
! Build the FAO control string.
!
if not .SHORT
then
begin
if .SDLCPTR neqa 0
then
CH$MOVESTRING (CTLPTR, CTLCIR);
if .THPTR neqa 0
then
CH$MOVESTRING (CTLPTR, CTLTH)
else
CH$MOVESTRING (CTLPTR, CTLNOTH);
if .RHPTR neqa 0
then
CH$MOVESTRING (CTLPTR, CTLRH)
else
CH$MOVESTRING (CTLPTR, CTLNORH);
CH$MOVESTRING (CTLPTR, CTLCNT);
end
else
begin
CH$MOVESTRING (CTLPTR, CTLNOHDR);
end;
!
! Add the one byte function identifier string descriptor.
!
IDX = -1;
selectone .FNC of
set
[FC_TCP_K$SNAPE]: DATVEC [IDX=.IDX+1] = ch$asciz ('T'); ! Transmit
[FC_RCP_K$SNAPE]: DATVEC [IDX=.IDX+1] = ch$asciz ('R'); ! Receive
[FC_CTL_K$SNAPE]: DATVEC [IDX=.IDX+1] = ch$asciz ('C'); ! Control
[FC_CCP_K$SNAPE]: DATVEC [IDX=.IDX+1] = ch$asciz ('D'); ! Ctl done
[otherwise]: DATVEC [IDX=.IDX+1] = ch$asciz ('?'); ! Unknown
tes;
!
! Add control and address information if this is a circuit trace.
!
if .SDLCPTR NEQA 0
then
begin
DATVEC [IDX=.IDX+1] = ch$ptr (.MSGADR,CIRCTLB$TRAPRO,8); ! SDLC header
DATVEC [IDX=.IDX+1] = ch$ptr (.MSGADR,CIRADRB$TRAPRO,8); !
end;
!
! Move the TH.
!
if .THPTR neqa 0
then
begin
PTR = .THPTR;
DATVEC [IDX=.IDX+1] = .PTR;
DATVEC [IDX=.IDX+1] = CH$PLUS (.PTR,1);
DATVEC [IDX=.IDX+1] = CH$PLUS (.PTR,2);
DATVEC [IDX=.IDX+1] = CH$PLUS (.PTR,3);
DATVEC [IDX=.IDX+1] = CH$PLUS (.PTR,4);
DATVEC [IDX=.IDX+1] = CH$PLUS (.PTR,5);
end;
!
! Move the RH.
!
if .RHPTR neqa 0
then
begin
DATVEC [IDX=.IDX+1] = .RHPTR;
DATVEC [IDX=.IDX+1] = CH$PLUS (.RHPTR,1);
DATVEC [IDX=.IDX+1] = CH$PLUS (.RHPTR,2);
end;
!
! Move the count field.
!
COUNT = ch$rword (ch$ptr (.MSGADR,COUNT_W$TRAPRO,8));
COUNT = .COUNT - HD_LEN_K$SNAPE;
if .SDLCPTR neqa 0
then
COUNT = .COUNT - 2;
if .THPTR neqa 0
then
COUNT = .COUNT - THLEN_K$TRAPRO;
if .RHPTR neqa 0
then
COUNT = .COUNT - RHLEN_K$TRAPRO;
!
! Add the count qualifier character.
!
DATVEC [IDX=.IDX+1] = .COUNT;
DATVEC [IDX=.IDX+1] = USP$PLURALIZE (.COUNT);
if .msgadr[FLG_ABBR_V$TRAPRO]
then
DATVEC [IDX=.IDX+1] = ch$asciz ('*')
else
DATVEC [IDX=.IDX+1] = ch$asciz (' ');
!
! Kludge to imitate VMS's tabs to that /CIR trace will
! not wrap-around the screen
!
if .COUNT lequ 10
then CH$MOVESTRING (CTLPTR, SP3)
else if .COUNT lequ 100
then CH$MOVESTRING (CTLPTR, SP2)
else CH$MOVESTRING (CTLPTR, SP1);
CH$MOVESTRING (CTLPTR, CTLFNC);
!
! Add the internal function information.
!
DATVEC [IDX=.IDX+1] = .FNC; ! Function
DATVEC [IDX=.IDX+1] = ch$rchar(ch$ptr(.MSGADR,MOD_B$TRAPRO,8)); ! Modifier
DATVEC [IDX=.IDX+1] = ch$rword(ch$ptr(.MSGADR,STS_W$TRAPRO,8)); ! Status
DATVEC [IDX=.IDX+1] = 0; ! make into an asciz string
!
! Build and output the text.
!
STATUS = MSG$BUILD_OUTPUT (ch$ptr(CTLVEC), .IDX, DATVEC);
!
! Print out the TH fields.
!
if .THPTR neqa 0
then
STATUS = MSG$FORMAT_TH (TH, FALSE);
!
! Print out the RH fields.
!
if .RHPTR neqa 0
then
begin
PTR = .RHPTR;
RH<0,8> = ch$rchar_a(PTR);
RH<8,8> = ch$rchar_a(PTR);
RH<16,8> = ch$rchar_a(PTR);
STATUS = MSG$FORMAT_RH (RH);
end;
!
! Print out the data.
!
if .RUPTR neqa 0
then
MSG$FORMAT_DATA (.RUPTR, .RULEN, .ST[SW_WIDE]);
return .STATUS;
end; ! end of MSG$FORMAT_MESSAGE
%global_routine ('MSG$PRINT_MESSAGE', MSGNUM) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine gets the text associated with a message code and then
! outputs it using the output jfn.
!
! FORMAL PARAMETERS:
!
! MSGNUM Number of message to be printed.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! SNT$_NORMAL
!
! SIDE EFFECTS:
!
! NONE
!
!--
begin
local
FAOVEC : VECTOR [2],
LENGTH,
POINTER,
SEVERITY,
! MSGDSC : $DSC,
MSGBLOCK : VECTOR [10],
STATUS;
!
! Set up the descriptor to receive the message.
!
! MSGDSC [DSC$B_CLASS] = DSC$K_CLASS_D;
! MSGDSC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
! MSGDSC [DSC$W_LENGTH] = 0;
! MSGDSC [DSC$A_POINTER] = 0;
!
! Get the message text.
!
! STATUS = MES$EXPAND_CODE (.MSGNUM,.SEVERITY);
!
! Print the formatted output.
!
! jsys_sout (.ST[ST_OUTPUT_JFN],.MSGNUM<18,35>,.MSGNUM<0,17>);
MSGBLOCK[0] = 2;
MSGBLOCK[1] = .MSGNUM;
STATUS = MSG$EXPAND_EVENT (2,MSGBLOCK);
if not .STATUS
then
$SNT_FATAL (SNT$_FATINTERR, 0, SNT$_LIBGETMSG, 0, .STATUS);
return $TRUE;
end; ! end of MSG$PRINT_MESSAGE
%global_routine ('MSG$FORMAT_LH',CTL : $BBLOCK, ADDR, TSTFLG, PRTRTN, PRTPRM) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine formats the Link Header (LH) and
! outputs it using the output JFN.
!
! FORMAL PARAMETERS:
!
! CTL
! ADDR
! TSTFLG Test flag (TRUE=>Test for I-frame,FALSE=>format LH).
! PRTRTN Address of routine to print the formatted output (optional).
! PRTPRM Parameter to be passed to the print routine (optional).
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! SNT$_NORMAL
! if TSTFLG was set then TRUE is returned if the message is an
! I-frame, FALSE if not.
!
! SIDE EFFECTS:
!
! NONE
!
!--
begin
local
STATUS;
!
! if TSTFLG is set then check for I-frame.
!
if .TSTFLG
then
begin
if (.CTL [0,0,1,0] EQL %B'0')
then
return $TRUE
else
return $FALSE;
end
else
return $TRUE
end; ! end of MSG$FORMAT_LH
%routine ('MSG$FORMAT_TH', THADR, TSTFLG) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine formats the Transmission Header (TH) and
! outputs it using the standard output routine, LIB$PUT_OUTPUT, or it
! calls the specified routine passing it the output text descriptor and
! the specified parameter.
!
! FORMAL PARAMETERS:
!
! THADR Address of 6 byte FID2 TH.
! TSTFLG Test flag (TRUE=>Test for first segement,FALSE=>format TH).
! PRTRTN Address of routine to print the formatted output (optional).
! PRTPRM Parameter to be passed to the print routine (optional).
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! SNT$_NORMAL
! if TSTFLG was set then TRUE is returned if an RH is present, FALSE
! if not.
!
! SIDE EFFECTS:
!
! NONE
!
!--
begin
map
THADR : REF $BPBLOCK;
local
CTLDSC,
FAOVEC : VECTOR [25],
IDX,
STATUS;
bind
FID2 = CH$ASCIZ (' FID2%A%A,DAF=%K,OAF=%K,SNF=%K%K%/%N');
!
! if TSTFLG is set then check for FID2 and FS or OS.
!
if .TSTFLG
then
begin
if (.THADR [0,4,4,0] eql %B'0010') and
((.THADR [0,2,2,0] eql %B'10') or (.THADR [0,2,2,0] eql %B'11'))
then
return $TRUE
else
return $FALSE;
end;
!
! Collect all the pieces of the TH.
!
IDX=-1;
selectone .THADR [0,4,4,0] of
set
[%B'0010']:
begin
CTLDSC = FID2;
end;
[%B'0000',
%B'0001',
%B'0011',
%B'0100',
%B'1111']:
begin
CTLDSC = CH$ASCIZ (' FID type %H not supported.%/');
FAOVEC [IDX=0] = .THADR [0,4,4,0];
end;
[otherwise]:
begin
CTLDSC = CH$ASCIZ (' FID type %H is undefined.%/');
FAOVEC [IDX=0] = .THADR [0,4,4,0];
end;
tes;
if .THADR [0,4,4,0] eql %B'0010'
then
begin
selectone .THADR [0,2,2,0] of
set
[%B'00']: FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',MS');
[%B'01']: FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',LS');
[%B'10']: FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',FS');
[%B'11']: FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',OS');
tes;
if .THADR [0,0,1,0]
then
FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',EFI')
else
FAOVEC [IDX=.IDX+1] = CH$ASCIZ ('');
FAOVEC [IDX=.IDX+1] = CH$PTR(.THADR,2,8); ! Destination addr field
FAOVEC [IDX=.IDX+1] = CH$PTR(.THADR,3,8); ! Origin address field
FAOVEC [IDX=.IDX+1] = CH$PTR(.THADR,4,8); ! Sequence number
FAOVEC [IDX=.IDX+1] = CH$PTR(.THADR,5,8); ! (bytes NOT swapped)
end;
!
! Print the formatted output.
!
FAOVEC [IDX=.IDX+1] = 0;
STATUS = MSG$BUILD_OUTPUT (.CTLDSC, .IDX, FAOVEC);
return .STATUS;
end; ! end of MSG$FORMAT_TH
%routine ('MSG$FORMAT_RH', RHADR) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine formats the Request/Resonse Header (RH) and
! outputs it using the JFN.
!
! FORMAL PARAMETERS:
!
! RHADR Address of 3 byte RH.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! SNT$_NORMAL
!
! SIDE EFFECTS:
!
! NONE
!
!--
begin
MAP
RHADR : REF $BBLOCK;
LOCAL
FAOVEC : VECTOR [25],
IDX,
STATUS;
BIND
CTLDSC = CH$ASCIZ (' %A%A%A%A%A%A%A%A%A%A%A%A%A%A%A');
!
! Collect all the pieces of the RH.
!
IDX = -1;
if .RHADR [SNARH$V_RRI]
then
begin
if .RHADR [SNARH$V_RTI]
then
FAOVEC [IDX=.IDX+1] = CH$ASCIZ ('-RSP')
else
FAOVEC [IDX=.IDX+1] = CH$ASCIZ ('+RSP');
end
else
FAOVEC [IDX=.IDX+1] = CH$ASCIZ ('RQ');
SELECTONE .RHADR [SNARH$V_RUC] OF
SET
[0]: FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',FMD');
[1]: FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',NC');
[2]: FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',DFC');
[3]: FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',SC');
TES;
if .RHADR [SNARH$V_FI]
then
FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',FI');
if .RHADR [SNARH$V_SDI]
then
FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',SDI');
if .RHADR [SNARH$V_BCI]
then
FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',BCI');
if .RHADR [SNARH$V_ECI]
then
FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',ECI');
if .RHADR [SNARH$V_DR1I]
then
FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',DR1I');
if .RHADR [SNARH$V_DR2I]
then
FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',DR2I');
if NOT .RHADR [SNARH$V_RRI]
then
begin
if .RHADR [SNARH$V_ERI]
then
FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',ERI');
end;
if .RHADR [SNARH$V_QRI]
then
FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',QRI');
if .RHADR [SNARH$V_PI]
then
FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',PI');
if .RHADR [SNARH$V_BBI]
then
FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',BBI');
if .RHADR [SNARH$V_EBI]
then
FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',EBI');
if .RHADR [SNARH$V_CDI]
then
FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',CDI');
if .RHADR [SNARH$V_CSI]
then
FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',CSI');
if .RHADR [SNARH$V_EDI]
then
FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',EDI');
if .RHADR [SNARH$V_PDI]
then
FAOVEC [IDX=.IDX+1] = CH$ASCIZ (',PDI');
FAOVEC [IDX=.IDX+1] = CH$ASCIZ(%CHAR(13,10)); ! New line
!
! Print the formatted output.
!
FAOVEC [IDX=.IDX+1] = 0; ! Make asciz string
MSG$BUILD_OUTPUT (CTLDSC, .IDX, FAOVEC);
return $TRUE
end; ! end of MSG$FORMAT_RH
%routine ('MSG$BUILD_OUTPUT', PATTERN, COUNT, LIST) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine formats a data buffer into ASCII text and then outputs
! it using the output jfn.
!
! FORMAL PARAMETERS:
!
! PATTERN Byte Pointer to the Pattern string for TXTWRT control string.
! COUNT Number of entries in the Parameter list
! LIST Address of the Parameter list.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! SNT$_NORMAL
!
! SIDE EFFECTS:
!
!
!--
begin
! external routine
! TXTWRT;
local
LENGTH;
!
! Print the formatted output.
!
TEXT_POINTER = ch$ptr(TEXT_BUFFER);
LENGTH = TXTWRT (TEXT_POINTER,TEXT_BUFFER_LEN,.PATTERN,.COUNT,.LIST);
if .LENGTH leq 0
then
LENGTH = -.LENGTH;
! return $FALSE;
! $SNT_FATAL (SNT$_FATINTERR, 0, .STATUS);
jsys_sout (.ST[ST_OUTPUT_JFN],ch$ptr(TEXT_BUFFER), .LENGTH);
return $TRUE;
end; ! End of MSG$BUILD_OUTPUT
%routine ('MSG$FORMAT_DATA', RUPTR, RULEN, WIDE) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine formats a data buffer into ASCII text and then outputs
! it using the output JFN.
!
! FORMAL PARAMETERS:
!
! RUPTR Address of message to be formatted.
! RULEN Length of message to be formatted.
! WIDE Width flag (TRUE=>132 columns, FALSE=>80 columns).
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! SNT$_NORMAL
!
! SIDE EFFECTS:
!
! NONE
!
!--
begin
external
SNATRATBL;
LOCAL
CHRLIM,
CHRPTR,
! DATAVEC : VECTOR [100] INITIAL (REP 100 OF (0)),
FILL,
IDX,
MAXCHR,
! CTLVEC : CH$SEQUENCE(TEXT_BUFFER_LEN),
CTLPTR,
RUCNT;
OWN
DATAVEC : VECTOR [100] INITIAL (REP 100 OF (0)),
CTLVEC : CH$SEQUENCE(TEXT_BUFFER_LEN);
bind
HEX2BYTE = CH$ASCIZ (' %h%h'),
HEXBYTE = CH$ASCIZ (' %h'),
CTLHEADER = CH$ASCIZ (' '),
CTLTEXT = CH$ASCIZ ('%#S : %#E%/'),
CTLEND = CH$ASCIZ ('%a');
!
! Set the width.
!
if .WIDE
then
MAXCHR = 32
else
MAXCHR = 16;
!
! Print out the data.
!
if .RUPTR neqa 0
then
begin
RUCNT = .RULEN;
while 1 do
begin
if .RUCNT eql 0
then
EXITLOOP;
if .RUCNT lss .MAXCHR
then
begin
CHRLIM = .RUCNT;
FILL = 5 * ((.MAXCHR / 2) - (.RUCNT / 2));
if .RUCNT
then
FILL = .FILL - 3;
end
else
begin
CHRLIM = .MAXCHR;
FILL = 0;
end;
CHRPTR = .RUPTR;
IDX = -1;
CTLPTR = ch$ptr(CTLVEC);
CH$MOVESTRING (CTLPTR,CTLHEADER);
incr CHRCNT from 1 to .CHRLIM / 2 do
begin
DATAVEC [IDX = .IDX + 1] = CH$RCHAR_A(CHRPTR);
DATAVEC [IDX = .IDX + 1] = CH$RCHAR_A(CHRPTR);
CH$MOVESTRING (CTLPTR,HEX2BYTE);
end;
if .CHRLIM
then
begin ! Odd byte
DATAVEC [IDX = .IDX + 1] = CH$RCHAR_A(CHRPTR);
CH$MOVESTRING (CTLPTR,HEXBYTE);
end;
DATAVEC [IDX = .IDX + 1] = .FILL; ! Fill with blanks
DATAVEC [IDX = .IDX + 1] = .CHRLIM; ! Text
DATAVEC [IDX = .IDX + 1] = .RUPTR;
CH$MOVESTRING (CTLPTR,CTLTEXT);
!
! Translate from EBCDIC to ASCII using the loadable translation
! table
!
CH$TRANSLATE( .SNATRATBL,
.CHRLIM, .RUPTR, 0,
.CHRLIM, .RUPTR);
RUPTR = ch$plus(.RUPTR,.CHRLIM);
RUCNT = .RUCNT - .CHRLIM;
DATAVEC [IDX = .IDX + 1] = 0; ! Make asciz string
CH$MOVESTRING(CTLPTR,CTLEND);
MSG$BUILD_OUTPUT(ch$ptr(CTLVEC),.IDX,DATAVEC);
end;
end;
end; ! end of MSG$FORMAT_DATA
%global_routine ('MSG$WRITE_END_RECORD',COUNT) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! COUNT Actual count of trace records
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! SNT$_NORMAL
!
! SIDE EFFECTS:
!
! NONE
!
!--
begin
local
LENGTH,
PTR,
PLU;
bind
CTLDSC = CH$ASCIZ ('%/Total of %M trace record%a processed.');
COUNT = .COUNT - 1; ! Don't include header record
PLU = USP$PLURALIZE (.COUNT);
LENGTH = TEXT_BUFFER_LEN - .LENGTH;
PTR = .TEXT_POINTER;
LENGTH = TXT_WRITE (TEXT_POINTER, .LENGTH, CTLDSC, .COUNT, .PLU);
jsys_sout (.ST[ST_OUTPUT_JFN], .PTR, .LENGTH);
return $TRUE;
end; ! end of MSG$WRITE_end_RECORD
%routine ('MSG$PROCESS_MESSAGE_BLOCK', MSGBLK: ref VECTOR) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Function to
!
! FORMAL PARAMETERS:
!
! SIZE Size of the message block
! MSGBLK Address of the message block
!
! ROUTINE VALUE:
!
! $TRUE Successful.
! $FALSE Otherwise.
!
! SIDE EFFECTS:
!
! none
!
!--
begin
local
ARGPTR,
ARGS,
CODE,
PTR,
SEV,
USED;
ARGPTR = 0;
TEXT_POINTER = ch$ptr (TEXT_BUFFER);
CODE = .MSGBLK[.ARGPTR+1];
EXPAND_MESSAGE_CODE (.CODE, ARGS, PTR, SEV);
USED = TXTWRT (TEXT_POINTER,
TEXT_BUFFER_LEN,
.PTR,
.ARGS,
MSGBLK[.ARGPTR+2]);
TEXT_POINTER = ch$plus (.TEXT_POINTER, -1); ! Backspace over null
ch$wchar_a ($CR, TEXT_POINTER);
ch$wchar_a ($LF, TEXT_POINTER);
ch$wchar_a ($NUL, TEXT_POINTER);
if .ST[CMD_ANALYZE] or .ST[SW_ANALYZE]
then JSYS_SOUT (.ST[ST_OUTPUT_JFN], CH$PTR(TEXT_BUFFER), 0)
else GLX$K_SOUT (TEXT_BUFFER);
return $TRUE;
end; ! end of MSG$PROCESS_MESSAGE_BLOCK
end ! end of SNTMSG module
eludom
! Local Modes:
! Mode:BLISS
! Auto Save Mode:2
! Comment Column:40
! Comment Rounding:+1
! end: