Trailing-Edge
-
PDP-10 Archives
-
BB-R775E-BM
-
sources/dil/trace.bli
There are 21 other files named trace.bli in the archive. Click here to see a list.
MODULE TRACE ( !
IDENT = '1'
%BLISS36(,
ENTRY(
D$TRACE, ! Trace a message
TRFILE, ! TRACE (file)
ST_TRACE, ! Remember /TRACE
ST_TRMAX ! Remember /TRMAX
))
) =
BEGIN
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 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:
!
! ABSTRACT:
!
!
! ENVIRONMENT:
!
! AUTHOR: Andrew Nourse
!
! 03 - Hack to let us live without RMS
! 02 - Put in ENTRY points
! 01 - The beginning
!--
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
D$TRACE: NOVALUE, !
TRFILE: NOVALUE, ! TRACE (file)
ST_TRACE: NOVALUE, ! Remember /TRACE
ST_TRMAX: NOVALUE; ! Remember /TRMAX
!
! INCLUDE FILES:
!
LIBRARY 'RMS';
LIBRARY 'BLISSNET';
LIBRARY 'DAP';
%IF %BLISS(BLISS36)
%THEN
LIBRARY 'TWENTY';
REQUIRE 'JSYSDEF';
%FI
!
! MACROS:
!
KEYWORDMACRO $RMS_PUT(RAB,STRING,ERR)=
BEGIN
EXTERNAL ROUTINE R$PUT;
BIND BRAB=RAB: $RAB_DECL;
%IF NOT %NULL(STRING)
%THEN
BIND STRINGD=STRING: $STR_DESCRIPTOR();
IF BRAB EQL -1
THEN JSYS_SOUT($PRIOU,
.STRINGD[STR$A_POINTER],
.STRINGD[STR$H_LENGTH],
0)
ELSE
BEGIN
BRAB[RAB$H_RSZ]=.STRINGD[STR$H_LENGTH];
BRAB[RAB$A_RBF]=CH$PLUS(.STRINGD[STR$A_POINTER],1)
AND %O'777777';
R$PUT(BRAB,ERR)
END
%FI
END %;
MACRO CRLF=%STRING(%CHAR(13),%CHAR(10)) %;
!
! EQUATED SYMBOLS:
!
!
! OWN STORAGE:
!
GLOBAL D$GTRMAX: INITIAL(4000); ! Max number of bytes to type out
GLOBAL D$GTWIDTH: INITIAL(80); ! Width of typeout
OWN TRACEFAB: REF $FAB_DECL; ! Address of trace FAB
OWN TRACERAB: REF $RAB_DECL; ! Address of trace RAB
!
! EXTERNAL REFERENCES:
!
EXTERNAL
D$GTRACE: BITVECTOR[32]; ! Trace flag
EXTERNAL ROUTINE
R$CLOSE,
R$NULL,
RMS$SIGNAL;
!
! OWN STORAGE
!
OWN TBUFF: VECTOR[CH$ALLOCATION(135)];
OWN DTRAFAB: $FAB(FNA='TTY:', FAC=PUT, RFM=STM, FOP=CIF);
OWN DTRARAB: $RAB(FAB=DTRAFAB,UBF=TBUFF, USZ=135, ROP=EOF);
GLOBAL ROUTINE D$TRACE (DD,MESSAGE_TYPE) :NOVALUE = !
!++
! FUNCTIONAL DESCRIPTION:
!
! Trace DAP message
!
! FORMAL PARAMETERS:
!
! DD: addr of DAP descriptor
! MESSAGE_TYPE:
! DAP$K_TRACE_INPUT (1): Message is being input
! DAP$K_TRACE_OUTPUT (2): Message is being output
! DAP$K_TRACE_INTERRUPT_INPUT (5): Interrupt msg input
! DAP$K_TRACE_INTERRUPT_OUTPUT (6): Interrupt msg output
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
MAP DD: REF $DAP_DESCRIPTOR;
OWN
TDD: $DAP_DESCRIPTOR, !Temp descriptor
OD: $STR_DESCRIPTOR(CLASS=BOUNDED); !Output descriptor
OWN T_CRLF: INITIAL (%ASCII CRLF),
D_CRLF: $STR_DESCRIPTOR(STRING=(2,CH$PTR(T_CRLF)));
BIND TRMAX=D$GTRMAX;
BIND TWIDTH=D$GTWIDTH;
LOCAL TRUNCATED;
$STR_DESC_INIT(DESCRIPTOR=OD,CLASS=BOUNDED,
STRING=(.TWIDTH+2,CH$PTR(TBUFF)));
IF .TRACERAB EQL 0 ! No trace file open?
THEN
BEGIN
TRACERAB=DTRARAB; ! Use default one
TRACEFAB=DTRAFAB;
$CREATE(FAB=TRACEFAB[$], ERR=RMS$SIGNAL);
$CONNECT(RAB=TRACERAB[$], ERR=RMS$SIGNAL);
END;
CASE .MESSAGE_TYPE FROM 1 TO 7 OF
SET
[DAP$K_TRACE_INPUT]: $STR_COPY(STRING=%STRING(CRLF,'Received '),
TARGET=OD);
[DAP$K_TRACE_OUTPUT]: $STR_COPY(STRING=%STRING(CRLF,'Sending '),
TARGET=OD);
[DAP$K_TRACE_INPUT_INTERRUPT]:
$STR_COPY(STRING=%STRING(CRLF,'Received Interrupt message '),
TARGET=OD);
[DAP$K_TRACE_OUTPUT_INTERRUPT]:
$STR_COPY(STRING=%STRING(CRLF,'Sending Interrupt message '),
TARGET=OD);
[INRANGE,OUTRANGE]:
$XPO_PUT_MSG(STRING='TRACE argument out of range',SEVERITY=FATAL);
TES;
$XPN_DESC_INIT(DESCRIPTOR=TDD,CLASS=BOUNDED);
TDD[DAP$A_DATA]=.DD[DAP$A_DATA];
TDD[DAP$H_BYTES_REMAINING]=.DD[DAP$H_BYTES_REMAINING];
TDD[DAP$H_BYTES_USED]=.DD[DAP$H_BYTES_USED];
TDD[DAP$H_MESSAGE_LENGTH]=.DD[DAP$H_MESSAGE_LENGTH];
TDD[DAP$H_LENGTH]=.DD[DAP$H_MESSAGE_LENGTH];
! Is there a limit to our patience?
IF .TDD[DAP$H_BYTES_REMAINING] GTR .TRMAX ! too long a message?
THEN
BEGIN
TRUNCATED=.TDD[DAP$H_BYTES_REMAINING]-.TRMAX; ! # of bytes truncated
TDD[DAP$H_BYTES_REMAINING]=.TRMAX;
END
ELSE
TRUNCATED=0;
DECR I FROM .TDD[DAP$H_BYTES_REMAINING]-1 TO 0
DO BEGIN
IF (.OD[STR$H_MAXLEN]-.OD[STR$H_LENGTH]) LEQ 7
THEN
BEGIN !Add <CR><LF> & put out
$STR_APPEND(STRING=D_CRLF,TARGET=OD);
$RMS_PUT(RAB=TRACERAB[$], STRING=OD[$], ERR=RMS$SIGNAL);
$STR_DESC_INIT(DESCRIPTOR=OD,CLASS=BOUNDED,
STRING=(.TWIDTH+3,CH$PTR(TBUFF)));
$STR_COPY(STRING=' ', TARGET=OD); ! Space in
END;
$STR_APPEND(STRING=$STR_ASCII(GET_BYTE(TDD[$]),
BASE8,LEADING_BLANK,LENGTH=4),
TARGET=OD);
END;
$STR_APPEND(STRING=D_CRLF,TARGET=OD);
$RMS_PUT(RAB=TRACERAB[$],STRING=OD, ERR=RMS$SIGNAL);
IF .TRUNCATED NEQ 0 ! Message was real long
THEN $RMS_PUT(STRING=$STR_CONCAT(' ... (',$STR_ASCII(.TRUNCATED),
%STRING(' more bytes)',CRLF)),
RAB=TRACERAB[$],ERR=RMS$SIGNAL);
END; !End of D$TRACE
GLOBAL ROUTINE TRFILE(R2,CSTATE,CONTEXT): NOVALUE=
BEGIN
IF .DTRAFAB[FAB$A_IFI] NEQ 0 ! If trace file open already
THEN
BEGIN
DTRAFAB[FAB$V_FOP_DRJ]=0; ! Flush JFN
R$CLOSE(DTRAFAB[$],R$NULL); ! Then close it
END;
DTRAFAB[FAB$H_JFN]=.R2;
DTRAFAB[FAB$V_FOP_DRJ]=1; ! Dont lose JFN
TRACERAB=0; ! Make D$TRACE open it next time
END;
GLOBAL ROUTINE ST_TRACE(R2,CSTATE,CONTEXT): NOVALUE=
BEGIN
D$GTRACE=.CONTEXT;
END;
GLOBAL ROUTINE ST_TRMAX(R2,CSTATE,CONTEXT): NOVALUE=
BEGIN
D$GTRMAX=.R2;
END;
END !End of module
ELUDOM