Trailing-Edge
-
PDP-10 Archives
-
BB-JF18A-BM
-
sources/rms/daptra.b36
There are 4 other files named daptra.b36 in the archive. Click here to see a list.
MODULE TRACE ( !
IDENT = '2'
%BLISS36(,
ENTRY(
D$TRACE ! Trace a message
))
) =
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
!
! 04 - Move all pure data to hiseg and remove FTS command stuff
! 03 - Hack to let us live without RMS
! 02 - Put in ENTRY points
! 01 - The beginning
!--
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
D$TRACE: NOVALUE; ! Trace a DAP message
!
! INCLUDE FILES:
!
%IF %BLISS(BLISS36) !a572
%THEN %IF %SWITCHES(TOPS10)
%THEN
LIBRARY 'BLI:UUOSYM';
UNDECLARE
ER$FUL,
%QUOTE DATE;
%FI
%FI
REQUIRE 'RMSREQ';
REQUIRE 'RMSOSD';
LIBRARY 'BLISSNET';
!
! MACROS:
!
KEYWORDMACRO Put_Trace (Rab, String)=
BEGIN
BIND Stringd=String: $str_Descriptor();
%IF %SWITCHES(TOPS20) !m572
%THEN
Sout(.D$gTrJfn,
.stringd[Str$a_Pointer],
.stringd[Str$h_Length],
0)
%ELSE
OUTSTR_UUO((CH$PLUS(.stringd[Str$a_pointer], 1))<rh>);
%FI
%(
BIND Brab=Rab: $rab_Decl;
%IF NOT %NULL(String)
%THEN
IF Brab EQL -1
THEN 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';
$Put (%QUOTE Rab=Brab )
END
%FI
)%
END %;
MACRO Crlf=%STRING(%CHAR(13),%CHAR(10)) %;
!
! OWN STORAGE:
!
PSECT OWN=$HIGH$;
PSECT GLOBAL=$HIGH$;
GLOBAL D$GTrMax: INITIAL(4000); ! Max number of bytes to type out
GLOBAL D$GTWidth: INITIAL(80); ! Width of typeout
%IF %SWITCHES(TOPS20)
%THEN
GLOBAL D$GTrJfn: INITIAL($PRIOU); ! Trace output to terminal
%FI
OWN T_Crlf: INITIAL (%ASCIZ Crlf), !m572
D_Crlf: $str_Descriptor(String=(3,CH$PTR(T_Crlf))); !m572
!
! EXTERNAL REFERENCES:
!
EXTERNAL
D$GTRACE: BITVECTOR[32]; ! Trace flag
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:
!
! DTRAFAB,DTRARAB
! D$GTRACE,D$GTRMAX
!
!--
BEGIN
MAP Dd: REF $dap_Descriptor;
LOCAL
Tdd: $dap_Descriptor, !Temp descriptor
Odesc: $str_Descriptor(Class=Bounded), !Output descriptor
Truncated;
LOCAL Tbuff: VECTOR [ CH$ALLOCATION ( 135 ) ];
BIND Trmax=D$gtrmax;
BIND Twidth=D$gtwidth;
$str_Desc_Init(Descriptor=Odesc,Class=Bounded,
String=(.twidth+2,CH$PTR(Tbuff)));
CASE .message_Type FROM 1 TO 7 OF
SET
[Dap$k_Trace_Input]: $str_Copy(String=%STRING(Crlf,'Received '),
Target=Odesc);
[Dap$k_Trace_Output]: $str_Copy(String=%STRING(Crlf,'Sending '),
Target=Odesc);
[Dap$k_Trace_Input_Interrupt]:
$str_Copy(String=%STRING(Crlf,'Received Interrupt message '),
Target=Odesc);
[Dap$k_Trace_Output_Interrupt]:
$str_Copy(String=%STRING(Crlf,'Sending Interrupt message '),
Target=ODESC);
[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 (.Odesc[Str$h_Maxlen]-.Odesc[Str$h_Length]) LEQ 7
THEN
BEGIN !Add <CR><LF> & put out
$str_Append(String=D_Crlf,Target=Odesc);
Put_Trace ( String=Odesc);
$str_Desc_Init(Descriptor=Odesc,Class=Bounded,
String=(.twidth+3,Ch$ptr(Tbuff)));
$str_Copy(String=' ', Target=Odesc); ! Space in
END;
%IF %SWITCHES(TOPS20)
%THEN
! Use NOUT jsys, $Str_Ascii is broken in nonzero sections
BEGIN
LOCAL numbuff;
Nout( CH$PTR(numbuff), Get_Byte(Tdd), No_Lfl+Fld(4,No_Col)+8 );
$Str_Append( String=(4,CH$PTR(numbuff)), Target=Odesc);
END
%ELSE ! beware. this won't work outside section 0 !m572
$str_Append(String=$str_Ascii(Get_Byte(Tdd),
Base8,Leading_Blank,Length=4),
Target=Odesc);
%FI
END;
$str_Append (String=D_Crlf,Target=Odesc);
Put_Trace ( String=Odesc );
IF .truncated NEQ 0 ! Message was real long
THEN Put_Trace ( String=$str_Concat(' ... (',$str_Ascii(.truncated),
' more bytes)', D_Crlf)); !m572
END; !End of D$TRACE
END !End of module
ELUDOM