Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

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 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
!
! Edit (%O'1', '12-Apr-84', 'Sandy Clemens')
! %( Add the TOPS-10 DAP sources for DIL V2.  Use the standard DIL
!    edit history format.
! )%
!
! Edit (%O'5', '5-Oct-84', 'Sandy Clemens')
!  %( Add new format of COPYRIGHT notice.  FILES:  ALL )%
!
! 04    - Start TOPS-10 support [Doug Rayner]
! 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
%IF %SWITCHES(TOPS20)
%THEN
LIBRARY 'TWENTY';
REQUIRE 'JSYSDEF';
%FI
%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 %SWITCHES(TOPS20)
         %THEN
         IF BRAB EQL -1
         THEN JSYS_SOUT($PRIOU,
                        .STRINGD[STR$A_POINTER],
                        .STRINGD[STR$H_LENGTH],
                        0)
         ELSE
         %FI
             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