Trailing-Edge
-
PDP-10 Archives
-
tops20-v7-ft-dist1-clock
-
7-sources/daptra.b36
There are 4 other files named daptra.b36 in the archive. Click here to see a list.
MODULE TRACE ( !
IDENT = '3'
%BLISS36(,
ENTRY(
D$STRACE, ! See if Tracing wanted
D$BTRACE, ! Output link banner line
D$ZTRACE, ! Close-link banner
D$CTRACE, ! Close any trace log
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: RMS-20/RMSFAL
!
! ABSTRACT: Contains main routines to trace incoming and outgoing
! DAP messages.
!
! Tracing by either RMS-20 (sending) or the RMSFAL (receiving)
! is controlled by the global variable D$GTRACE. If
! D$GTRACE < 0, each DAP message sent or received is traced.
! There are currently 4 flavors of tracing:
!
! D$GTRACE = -1 => Full trace: Headers are interpreted,
! and each byte of the DAP message traced.
! D$GTRACE = -2 => Only header information and summary fields
! are traced.
! D$GTRACE = -3 => Only headers.
! D$GTRACE = -4 => Only link connect/disconnect.
!
! NOTE: DAP tracing is an UNSUPPORTED utility. Its behavior
! and effects may change at any time, or perhaps not
! be provided in the future.
! D$GTRACE may be turned on or off by the following means:
!
! 1) Patch D$GTRACE (in either RMS-20 or RMSFAL) in DDT.
!
! 2) Issue the [NO]TRACE command in DIU-20 or RMSDEB. (Full
! tracing only.) Note that NOTRACE does not override
! DAP$TRACE.
!
! 3) Issue the RMS $DEBUG JSYS (1013) with an argument of 400000
! in AC1. (Full tracing only.)
!
! 4) For RMS-20 tracing, define the job-wide logical name
! DAP$TRACE: as -1, -2, -3 or -4. If DAP$TRACE is defined
! but its value cannot be interpreted, the default is full
! tracing. If DAP$TRACE is defined, the job-wide logical
! name DAP$OUTPUT is examined. If it has not been defined,
! or if it has been defined but cannot be interpreted as
! a filespec, trace output goes to the terminal; otherwise
! to the file specified by DAP$OUTPUT. Existing output
! files are appended to.
!
! 5) For FAL tracing, define the job-wide logical name
! FAL$LOG: as -1, -2, -3 or -4. If FAL$LOG is defined
! but its value cannot be interpreted, the default is full
! tracing. If FAL$LOG is defined, the job-wide logical
! name FAL$OUTPUT is examined. If it has not been defined,
! or if it has been defined but cannot be interpreted as
! a filespec, trace output goes to PS:[logged-in-directory]
! FAL.LOG; otherwise to the file specified by FAL$OUTPUT.
! Existing output files are appended to.
!
! CAUTION: FAL$OUTPUT should not be defined as TTY:, or
! the FAL may hang. FAL$OUTPUT should not point to
! DAP$OUTPUT.
!
!
! ENVIRONMENT: TOPS-20, Transportable BLISS DecNet Interface
!
! AUTHOR: Andrew Nourse/Tom Speer
!
! 05 [663]- Complete rewrite.
! 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$STRACE: NOVALUE, ! Check if tracing wanted
D$BTRACE: NOVALUE, ! Output startup banner
D$ZTRACE: NOVALUE, ! Output close-down banner
D$CTRACE: NOVALUE, ! Close any trace log
D$TRACE: NOVALUE, ! Trace a DAP message
OMsg: NOVALUE, ! Output a DAP message
Olen; ! Output message length
!
! 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 $CR_LOGIT(TEXT) =
SOUT(.D$GTRJFN,CH$PTR(UPLIT(%ASCIZ %STRING(%CHAR(13,10),TEXT))),0);
%;
MACRO $LOGIT_CR(TEXT) =
SOUT(.D$GTRJFN,CH$PTR(UPLIT(%ASCIZ %STRING(TEXT,%CHAR(13,10)))),0);
%;
MACRO $LOGIT(TEXT) =
SOUT(.D$GTRJFN,CH$PTR(UPLIT(%ASCIZ TEXT)),0);
%;
MACRO LOG$IT(POINTER,LENGTH) =
SOUT(.D$GTRJFN,POINTER,-LENGTH,0);
%;
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
GLOBAL D$In_Count; ! # DAP messages received
GLOBAL D$Out_Count; ! # " " sent
GLOBAL Tbuff: VECTOR[CH$ALLOCATION(135)];
%IF %SWITCHES(TOPS20)
%THEN
GLOBAL D$GTrJfn;
BIND TJfn = D$GTrJfn;
%FI
OWN T_Crlf: INITIAL (%ASCII Crlf),
D_Crlf: $str_Descriptor(String=(2,CH$PTR(T_Crlf)));
OWN IByte; ! # Bytes received
OWN OByte; ! # Bytes sent
OWN Inrec; ! # DAP DATA msgs received
OWN Outrec; ! # " " " sent
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
T_Datatype, ! In DAPTRT
T_Fop,
T_Fac,
T_Shr,
T_Dsp,
T_Ctl,
T_Dtm,
T_Pro,
OTime,
GTrJfn,
Dap$Get_Header, ! (elsewhere)
Dap$Get_Bitvector,
Dap$Get_Longword,
Dap$Get_Variable_String,
Dap$Get_Variable_Counted,
Dap$Unget_Header,
Dap$Unget_Byte,
Dap$Error_Dap_Rms,
Dap$Rfa_Dap_Rms,
Dap$Get_2Byte;
EXTERNAL
D$GTRACE;
! These are the PLIT tables to interpret DAP message fields.
EXTERNAL
HdrTab : VECTOR,
Ostype : VECTOR,
Filesys : VECTOR,
Orgtype : VECTOR,
Rfmtype : VECTOR,
RATType : VECTOR,
Acctype : VECTOR,
CtlType : VECTOR,
Contype : VECTOR,
Accomptype : VECTOR ;
GLOBAL ROUTINE D$STRACE (P_Nodeid : REF $Str_Descriptor(),
P_Nlb_Jfn) :NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Called from RMS-20 remote file open processing to see if DAP$TRACE
! and DAP$OUTPUT have been defined. If both are already defined,
! output end-of-link stats from any simultaneously open link and return.
!
! FORMAL PARAMETERS:
!
! None
!
! IMPLICIT INPUTS:
!
! D$GTRACE
!
!--
BEGIN
BIND Nodeid = .P_Nodeid : $Str_Descriptor();
BIND Net_Jfn = .P_Nlb_Jfn;
LOCAL Nodename : BLOCK[CH$ALLOCATION(11)];
! If we are already tracing, just return now.
IF .D$GTRACE NEQ 0 AND .D$GTRJFN NEQ 0 THEN
BEGIN
IF .D$In_Count NEQ 0 OR .D$Out_Count NEQ 0 THEN
BEGIN
D$CTrace();
D$GTrJfn = GTrJfn();
END;
SOUT(CH$PTR(Nodename),.nodeid[Str$a_Pointer],
-.Nodeid[Str$h_Length]);
D$BTrace(Nodename,Net_Jfn);
RETURN;
END;
D$GTrJfn = GTrjfn();
IF .D$Gtrace LSS 0 THEN
BEGIN
SOUT(CH$PTR(Nodename),.nodeid[Str$a_Pointer],
-.Nodeid[Str$h_Length]);
D$BTrace(Nodename,Net_jfn);
IByte = Obyte = Inrec = Outrec = 0;
END;
END; ! D$STRACE
GLOBAL ROUTINE D$BTRACE (Nodename,Net_Jfn): NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Output a link-startup banner line.
!
! FORMAL PARAMETERS:
!
! NODENAME: Address of remote partner's nodename string
! NET_JFN: NLB's network JFN (Link ID).
!
! IMPLICIT INPUTS:
!
! D$GTRJFN
!
!--
BEGIN
BIND Jfn = D$GTrJfn;
LOCAL ptr;
ptr = CH$PTR(Tbuff);
IF .Jfn NEQ $PRIOU THEN Openf(.Jfn,Of_APP+7^30);
$Cr_Logit('********************************************');
$Cr_Logit('Link ID:');
Nout(.Jfn,.Net_Jfn<rh>,8);
$logit(' established on ');
OTime(.Jfn,0,0,0);
IF Node ($NDGln,ptr) THEN
BEGIN
$Logit('Local: ');
Log$it(CH$PTR(Tbuff),0);
END;
If .Nodename NEQ 0 THEN
BEGIN
$Logit(', Remote: ');
Log$it(CH$PTR(.Nodename),0);
END;
$Cr_Logit('Trace Level: ');
Nout(.Tjfn,.D$Gtrace,10);
SOUT(.TJfn,CH$PTR(T_Crlf),2);
IF .Jfn NEQ $PRIOU THEN Closf(.Jfn+Co_Nrj);
END;
GLOBAL ROUTINE D$ZTRACE (Net_Jfn) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Output an end-of-link banner.
!
! FORMAL PARAMETERS:
!
! NET_JFN: NLB's network JFN (Link ID)
!
! IMPLICIT INPUTS:
!
! D$GTRJFN
!
!--
BEGIN
IF .Tjfn EQL 0 THEN RETURN;
IF .Tjfn NEQ $PRIOU THEN Openf(.Tjfn,OF_APP+7^30);
$cr_Logit('Link ID:');
Nout(.Tjfn,.Net_Jfn<rh>,8);
$logit(' closed on ');
OTime(.TJfn,0,0,0);
Closf(.Tjfn+Co_Nrj);
END;
GLOBAL ROUTINE D$CTRACE :NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Close the logfile whose JFN is in D$GTRJFN and write some
! end-of-link statistics. Called by both RMS and the FAL.
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
! D$GTRJFN
!
!--
BEGIN
IF .Tjfn EQL 0 THEN TJfn = GTrJfn();
IF (.D$In_Count+.D$Out_Count) EQL 0 THEN RETURN;
IF .Tjfn NEQ $PRIOU THEN Openf(.TJfn,Of_APP+7^30);
$cr_Logit('=======================================');
$cr_Logit(' # DAP msgs Exchanged: ');
Nout(.TJfn,.D$In_Count+.D$Out_Count,10);
$cr_Logit(' Recd: ');
Nout(.TJfn,.D$In_Count,10);
$cr_Logit(' Sent: ');
Nout(.TJfn,.D$Out_Count,10);
$cr_Logit(' # DAP bytes Exchanged: ');
Nout(.TJfn,.IByte+.OByte,10);
$cr_Logit(' Recd: ');
Nout(.TJfn,.IByte,10);
$cr_Logit(' Sent: ');
Nout(.TJfn,.Obyte,10);
IF (.Inrec + .Outrec) NEQ 0 THEN
BEGIN
$cr_Logit(' # Data msgs Exchanged: ');
Nout(.TJfn,.Inrec+.Outrec,10);
IF .Inrec NEQ 0 THEN
BEGIN
$cr_Logit(' Recd: ');
Nout(.TJfn,.Inrec,10);
END;
IF .Outrec NEQ 0 THEN
BEGIN
$cr_Logit(' Sent: ');
Nout(.TJfn,.Outrec,10);
END;
END;
$cr_Logit('======================================');
$Logit_cr('=');
IF .Tjfn NEQ $PRIOU THEN Closf(.Tjfn);
TJfn = 0;
D$In_Count = D$Out_Count = IByte = Obyte = Inrec = Outrec = 0;
END; ! D$CTRACE
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
! [Unused] DAP$K_TRACE_INTERRUPT_INPUT (5): Interrupt msg input
! [Unused] DAP$K_TRACE_INTERRUPT_OUTPUT (6): Interrupt msg output
!
!
! IMPLICIT INPUTS:
!
! D$GTRACE,D$GTRMAX
!
!--
BEGIN
MAP Dd: REF $dap_Descriptor;
LABEL Do_Message;
LOCAL
Tdd: $dap_Descriptor, !Temp descriptor
Header,
Function,
Net_Jfn;
BIND Twidth=D$gtwidth;
! And the temporary Dap Descriptor
IF .D$GTRACE+4 EQL 0 THEN RETURN;
$xpn_Desc_Init (Descriptor=Tdd , Class=Bounded );
! Copy in relevant portions of the DAP descriptor
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_Length];
! Brutally and illegally swipe the Nlb's Jfn for an ID.
Net_Jfn<rh> = .((.dd[Dap$a_Nlb])+30);
IF .Tjfn EQL 0 THEN Tjfn = GTrJfn();
Openf(.Tjfn,Of_App+7^30);
!+
! Read the whole message, unblocking as we go. The loop is post-tested
! to catch and trace spurious messages with a byte-length of zero.
!-
DO !DO WHILE
Do_Message: BEGIN
LOCAL filespec: VECTOR[CH$ALLOCATION(255)]; !Store filespec
LOCAL Header_Len,
Message_Length,
Save_pos;
! Output a directional header
CASE .message_Type FROM 1 TO 7 OF
SET
[Dap$k_Trace_Input]:
BEGIN
OTime(.TJfn,Ot_Nda,Dap$k_Trace_Input,.Net_Jfn);
IF .dd[Dap$v_Interrupt]
THEN
BEGIN
$Logit('Int> ');
END
ELSE
BEGIN
$Logit('===> ');
END;
D$In_Count = .D$In_Count+1; ! Count msgs in
END;
[Dap$k_Trace_Output]:
BEGIN
OTime(.Tjfn,Ot_Nda,Dap$k_Trace_Output,.Net_Jfn);
IF .dd[Dap$v_Interrupt]
THEN
BEGIN
$Logit('<Int ');
END
ELSE
BEGIN
$Logit('<=== ');
END;
D$Out_Count = .D$Out_Count + 1; ! Count msgs out
END;
[Dap$k_Trace_Input_Interrupt]:
BEGIN
$Cr_Logit('Int> ');
END;
[Dap$k_Trace_Output_Interrupt]:
BEGIN
$Cr_Logit('<Int ');
END;
[INRANGE,OUTRANGE]:
$xpo_Put_Msg(String='TRACE argument out of range',Severity=Fatal);
TES;
! Save full message length before it is decremented by $Get_Header
Message_Length = .Tdd[Dap$h_Bytes_Remaining];
! If the message has any DAP data in it at all, we can $Get_Header the
! Operator field. Otherwise, $Get_Header goes off to get a new message!
!
IF .Tdd[Dap$h_Bytes_Remaining] GTR 0
THEN
BEGIN
Header = Dap$Get_Header(Tdd); ! Peek at message type
END
ELSE
BEGIN
Header = Get_Byte(Tdd);
END;
! Record how many bytes were actually in the header, so blocked messages
! can be correctly sized according to the LENGTH field (length of
! Operator).
Header_Len = .Message_Length - .Tdd[Dap$h_Bytes_Remaining];
! Calculate actual length of this DAP message (as opposed to total
! blocked length).
! If the LENGTH flag is on, this message may be blocked, so we
! calculate the total byte-length to output as the remaining
! Dap$h_length of this message plus the number of bytes we read
! in the header.
! If the LENGTH flag is off, the message length is the Bytes_Remaining
! plus the header length.
IF .Tdd[Dap$v_Mflags_Length]
THEN Message_Length = .Tdd[Dap$h_Length] + .Header_Len
ELSE Message_Length = .Tdd[Dap$h_Bytes_Remaining] + .Header_Len;
! Keep running total of DAP bytes in and out.
IF .message_type EQL Dap$k_Trace_Input
THEN IByte = .Ibyte + .Message_Length;
IF .message_type EQL Dap$k_Trace_Output
THEN OByte = .OByte + .Message_Length;
! Protect against bogus messages
IF .Header LSS 0 OR .Header GTR .Hdrtab[-1] THEN Header = 0;
! Output the corresponding message type, Englished.
Log$it(CH$PTR(.Hdrtab[.Header]),3);
$Logit(' ');
! If message was really bogus, complete a truncated trace and leave.
IF .Tdd[Dap$h_Bytes_Remaining] LEQ 0 AND .Header EQL 0
THEN
BEGIN
$Logit('msg');
IF NOT Olen(Tdd,0) THEN SOUT(.TJfn,CH$PTR(T_Crlf),2);
Closf(.TJfn+Co_Nrj);
RETURN
END;
!+
! Do some special things by message type.
!-
CASE .Header FROM 0 TO Dap$k_Acl OF
SET
[Dap$k_Config,
Dap$k_Attributes,
Dap$k_Name,
Dap$k_Status,
Dap$k_Date_Time,
Dap$k_Protection]:
BEGIN
Save_pos = .Tdd[Dap$h_Bytes_Remaining]; ! Save our position
$Logit('msg');
IF Olen(Tdd,.Message_Length) THEN LEAVE Do_Message; ! Write msg Len:
$Cr_Logit(' ');
SELECTONE .Header OF
SET
[Dap$k_Config]: ! Englishify upto (not including)
BEGIN ! the SYSCAP field
LOCAL
Bufsiz,
Ost,
Flsys,
Dapver,
Dapeco;
! Get 6 bytes of interesting stuff
Bufsiz = Dap$Get_2Byte(Tdd);
Ost = Get_Byte(Tdd);
Flsys = Get_Byte(Tdd);
Dapver = Get_Byte(Tdd);
Dapeco = Get_Byte(Tdd);
! Output each item, with a preceding ID tag
! BUFSIZ:nnnnnn
$Logit('Bufsiz:');
Nout(.Tjfn,.Bufsiz,8);
! OST:
$Logit(' Ost:');
! Protect against bogus values
IF .Ost GTR .Ostype[-1]
THEN Ost = 0;
! Index into Ostype table for text
Log$it(CH$PTR(.Ostype[.Ost]),8);
! FILESYS:
$Logit('Filesys:');
! Protect against bogus values
IF .Flsys GTR .Filesys[-1]
THEN Flsys = 0;
! Index into Filesys table for text
Log$it(CH$PTR(.Filesys[.Flsys]),8);
! Dap VER:
$Logit('Ver:');
Nout(.Tjfn,.Dapver,8);
! Dap ECO:
$Logit(' Eco:');
Nout(.Tjfn,.Dapeco,8);
END; !DAP$K_CONFIG
[Dap$k_Attributes]:
BEGIN
LOCAL attmenu: BITVECTOR[42] INITIAL(0),
org: INITIAL(0),
rfm: INITIAL(0),
rat: BITVECTOR[21] INITIAL(0),
bls: INITIAL(0),
mrs: INITIAL(0),
tmp;
Dap$Get_Bitvector (Tdd, attmenu, 6); !Attributes menu bits
IF .attmenu[Dap$v_Attmenu_Dat] ! Datatype?
THEN
BEGIN
$Logit('Dtp:');
T_Datatype(Tdd);
END;
IF .attmenu[Dap$v_Attmenu_Org] ! File Organization
THEN
BEGIN
org=$Dap_Translate_Value(Get_Byte(Tdd),
Dap$k_Org_,Fab$k_,
Seq,Rel,Idx,Hsh);
$logit('Org:');
IF .org GTR .Orgtype[-1]
THEN org = 0;
Log$it(CH$PTR(.orgtype[.org]),3);
END;
IF .attmenu[Dap$v_Attmenu_Rfm] ! Record Format
THEN
BEGIN
rfm=Get_Byte(Tdd);
IF .rfm GTR .rfmtype[-1] THEN rfm = 0;
$logit(' Rfm:');
Log$it(CH$PTR(.rfmtype[.rfm]),3);
END;
IF .attmenu[Dap$v_Attmenu_Rat] ! Record Attributes
THEN
BEGIN
LOCAL v: INITIAL(0);
LITERAL Prn = 2;
rat=Get_Byte(Tdd);
IF .Rat[Dap$v_Rat_Ftn] THEN v=0;
IF .Rat[Dap$v_Rat_Cr] THEN v=1;
IF .Rat[Prn] THEN v=2;
IF .Rat[Dap$v_Rat_Blk] THEN v=3;
IF .Rat[Dap$v_Rat_Efc] THEN v=4;
IF .Rat[Dap$v_Rat_Cbl] THEN v=5;
IF .Rat[Dap$v_Rat_Lsa] THEN v=6;
IF .Rat[Dap$v_Rat_Macy11] THEN v=7;
$Logit(' Rat:');
Log$it(CH$PTR(.RATtype[.v]),4);
END;
IF .attmenu[Dap$v_Attmenu_Bls]
THEN
BEGIN
bls=Dap$Get_2Byte(Tdd);
$logit(' Bls:');
Nout(.Tjfn,.Bls,8);
END;
IF .attmenu[Dap$v_Attmenu_Mrs]
THEN
BEGIN
$Logit(' Mrs:');
Mrs = Dap$Get_2Byte(Tdd);
Nout(.Tjfn,.Mrs,8);
END;
IF .attmenu[Dap$v_Attmenu_Alq]
THEN
BEGIN
$Logit(' Alq:');
Nout(.Tjfn,Dap$get_Longword(Tdd),8);
END;
IF .attmenu[Dap$v_Attmenu_Bks]
THEN
BEGIN
$Logit(' Bks:');
Nout(.Tjfn,Get_Byte(Tdd),8);
END;
IF .attmenu[Dap$v_Attmenu_Fsz]
THEN
BEGIN
$Logit(' Fsz:');
Nout(.Tjfn,Get_Byte(Tdd),8);
END;
IF .attmenu[Dap$v_Attmenu_Mrn]
THEN
BEGIN
$Logit(' Mrn:');
Nout(.Tjfn,Dap$Get_Longword(Tdd),8);
END;
IF .attmenu[Dap$v_Attmenu_Run] THEN
BEGIN
LOCAL runsys: VECTOR[CH$ALLOCATION(40)];
Dap$Get_Variable_String(Tdd,CH$PTR(runsys),40);
END;
IF .attmenu[Dap$v_Attmenu_Deq]
THEN tmp = Dap$Get_2Byte(Tdd);
IF .attmenu[Dap$v_Attmenu_Fop] THEN T_Fop(Tdd);
IF .attmenu[Dap$v_Attmenu_Bsz]
THEN
BEGIN
$Logit(' Bsz:');
Nout(.Tjfn,Get_Byte(Tdd),8);
END;
IF .attmenu[Dap$v_Attmenu_Dev]
THEN
BEGIN
LOCAL dev: BITVECTOR[42] INITIAL(0);
$Cr_Logit(' Dev:');
Dap$Get_Bitvector(Tdd, dev, 6);
Nout(.Tjfn,.dev,8);
END;
IF .attmenu[Dap$v_Attmenu_Sdc]
THEN
BEGIN
LOCAL sdc: BITVECTOR[42] INITIAL(0);
Dap$Get_Bitvector (Tdd, sdc, 6);
$Logit(' Sdc:');
Nout(.Tjfn,.sdc,8);
END;
IF .attmenu[Dap$v_Attmenu_Lrl]
THEN
BEGIN
$Logit(' Lrl:');
Nout(.Tjfn,Dap$Get_2byte(Tdd),8);
END;
IF .attmenu[Dap$v_Attmenu_Hbk]
THEN
BEGIN
$Logit(' Hbk:');
Nout(.Tjfn,Dap$Get_Longword(Tdd),8);
END;
IF .attmenu[Dap$v_Attmenu_Ebk]
THEN
BEGIN
$Logit(' Ebk:');
Nout(.Tjfn,Dap$Get_Longword(Tdd),8);
END;
IF .attmenu[Dap$v_Attmenu_Ffb]
THEN
BEGIN
$Logit(' Ffb:');
Nout(.Tjfn,Dap$get_2byte(Tdd),8);
END;
END; !DAP$K_ATTRIBUTES
[Dap$k_Name]:
BEGIN
LOCAL
Nametype: BITVECTOR[21],
Save2;
Dap$Get_Bitvector(Tdd, nametype, 3);
IF .Nametype[Dap$k_Nametype_Fsp]
THEN $Logit('File: ');
IF .Nametype[Dap$k_Nametype_Nam]
THEN $logit('Name: ');
IF .Nametype[Dap$k_Nametype_Dir]
THEN $logit('Directory: ');
IF .Nametype[Dap$k_Nametype_Str]
THEN $logit('Structure: ');
IF .Nametype[Dap$k_Nametype_Def]
THEN $logit('Default file: ');
IF .Nametype[Dap$k_Nametype_Rel]
THEN $logit('Related file: ');
Save2 = Dap$Get_Variable_String(Tdd,CH$PTR(filespec),255);
Log$it(CH$PTR(Filespec),.Save2);
END; !DAP$K_NAME
[Dap$k_Status]:
BEGIN
LOCAL STV,
STS,
Rfa: BYTE8VECTOR[9];
STV = Dap$Get_2Byte(Tdd); ! Get Mac/Mic
STS = Dap$Error_Dap_Rms(.STV); ! Convert to STS
$logit('Mac/Mic:');
Nout(.Tjfn,.STV,8);
$logit(' [Sts:');
Nout(.Tjfn,.STS,8);
$Logit(']');
IF .Tdd[Dap$h_Length] GTR 0
THEN
BEGIN
Dap$Get_Variable_Counted(Tdd,CH$PTR(rfa,0,8),8);
IF (.rfa[0]) GTR 0
THEN
BEGIN
LOCAL v;
v=Dap$Rfa_Dap_Rms(rfa);
v<35,1>=0;
$logit(' Rfa:');
Nout(.Tjfn,.v<lh>,8);
$logit(',,');
Nout(.Tjfn,.v<rh>,8);
END;
END;
END; !DAP$K_STATUS
[Dap$k_Date_Time]:
BEGIN
T_Dtm(Tdd);
END; !DAP$K_DATE_TIME
[Dap$k_Protection]:
BEGIN
T_Pro(Tdd);
END; !DAP$K_PROTECTION
TES;
Save_Pos = .Save_Pos - .Tdd[Dap$h_Bytes_Remaining];
INCR I From 0 to .Save_Pos-1
DO Dap$Unget_Byte(Tdd);
OMsg(Tdd,.Message_Length,Tbuff); ! Output the bytes
END;
[Dap$k_Access,
Dap$k_Control,
Dap$k_Continue,
Dap$k_Access_Complete]:
BEGIN
Save_Pos = .Tdd[Dap$h_Bytes_Remaining];
Function = Get_Byte(Tdd);
SELECTONE .Header OF
SET
[Dap$k_Access]:
BEGIN
LOCAL
Accopt: BITVECTOR[28],
Save2;
IF .Function GTR .Acctype[-1] ! Protect vs bogus vals
THEN Function = 0;
Log$it(CH$PTR(.Acctype[.Function]),3);
IF Olen(Tdd,.Message_Length) THEN LEAVE Do_Message;
Dap$Get_Bitvector(Tdd,Accopt,5); !Access options
Save2 = Dap$Get_Variable_String(Tdd,CH$PTR(filespec),255);
$Cr_logit(' File: ');
Log$it(CH$PTR(Filespec),.Save2);
T_Fac(Tdd);
T_Shr(Tdd);
T_Dsp(Tdd);
END; !DAP$K_ACCESS
[Dap$k_Control]:
BEGIN
IF .Function GTR .Ctltype[-1]
THEN Function = 0;
Log$it(CH$PTR(.Ctltype[.Function]),3);
IF Olen(Tdd,.Message_Length) THEN LEAVE Do_Message;
T_Ctl(Tdd);
END; !DAP$K_CONTROL
[Dap$k_Continue]:
BEGIN
IF .Function GTR .Contype[-1]
THEN Function = 0;
Log$it(CH$PTR(.Contype[.Function]),3);
IF Olen(Tdd,.Message_Length) THEN LEAVE Do_Message;
END; !DAP$K_CONTINUE
[Dap$k_Access_Complete]:
BEGIN
IF .Function GTR .Accomptype[-1]
THEN Function = 0;
Log$it(CH$PTR(.Accomptype[.Function]),3);
IF Olen(Tdd,.Message_Length) THEN LEAVE Do_Message;
IF .Tdd[Dap$h_Length] GTR 0
THEN
BEGIN
$Cr_Logit(' ');
T_Fop(Tdd);
END;
END; !DAP$K_ACCESS_COMPLETE
TES;
Save_Pos = .Save_Pos - .Tdd[Dap$h_Bytes_Remaining];
INCR I From 0 to .Save_Pos-1
DO Dap$Unget_Byte(Tdd);
OMsg(Tdd,.Message_Length,Tbuff); ! Output the bytes
END;
[INRANGE,
OUTRANGE]:
BEGIN
$Logit('msg');
IF .Header EQL Dap$k_Data THEN
BEGIN
IF .message_type EQL Dap$k_Trace_Input
THEN InRec = .InRec +1;
IF .message_type EQL Dap$k_Trace_Output
THEN OutRec = .OutRec + 1;
END;
IF Olen(Tdd,.Message_Length) THEN LEAVE Do_Message;
OMsg(Tdd,.Message_Length,Tbuff);
END;
TES;
END !DO WHILE
WHILE .Tdd[Dap$h_Bytes_Remaining] GTR 0;
Closf(.Tjfn+Co_Nrj);
END; !End of D$TRACE
ROUTINE OMsg (P_Dd: REF $Dap_Descriptor,
Msg_Len,
O_Buff
) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Output-trace a DAP message byte-by-byte.
!
! FORMAL PARAMETERS:
!
! P_DD: addr of DAP descriptor
! Msg_Len: Length in bytes of the discrete DAP message to output
! O_Buff: Output trace buffer
!
! IMPLICIT INPUTS:
!
! D$GTWIDTH,D$GTRMAX
!
!--
BEGIN
LOCAL
Odesc: $str_Descriptor(Class=Bounded); !Output descriptor
BIND Tdd = .P_dd: $Dap_Descriptor;
BIND Tbuff = .O_Buff: VECTOR[CH$ALLOCATION (135)];
BIND Twidth=D$gtwidth;
BIND Trmax=D$gtrmax;
LOCAL Noutbuf: VECTOR[CH$ALLOCATION(10)];
LOCAL Truncated;
! Regurgitate the header we have already read
Dap$Unget_Header(Tdd);
! Is there a limit to our patience?
IF .tdd[Dap$h_Bytes_Remaining] GTR .trmax ! too long a message?
THEN
BEGIN
Truncated=.Msg_Len-.trmax; ! # of bytes truncated
Msg_Len=.trmax;
END
ELSE
Truncated=0;
! If the DAP debug trace flag is -2, forget about tracing DAP bytes.
IF (.D$GTRACE + 2) EQL 0
THEN
BEGIN
DECR I FROM .Msg_Len-1 TO 0
DO Get_Byte(Tdd);
SOUT(.TJfn,CH$PTR(T_Crlf),2);
RETURN
END;
$str_Desc_Init(Descriptor=Odesc,Class=Bounded,
String=(.twidth+3,Ch$ptr(Tbuff)));
$str_Copy(String=%STRING(Crlf,' '), Target=Odesc); ! Space in
!+
! The pointers have been backed up to the start, and we have the total
! length of this DAP message. Pump it out.
!-
DECR I FROM .Msg_Len-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
Nout( CH$PTR(Noutbuf), Get_Byte(Tdd), No_Lfl+Fld(4,No_Col)+8 );
$Str_Append( String=(4,CH$PTR(Noutbuf)), 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; !OMsg
ROUTINE OLen (P_Dd: REF $Dap_Descriptor,Msg_Len) =
BEGIN
BIND Twidth=D$gtwidth;
BIND Tdd = .P_dd: $Dap_Descriptor;
! Tag and output the decimal number of bytes in this message
$LOGIT(' Len: ');
Nout( .Tjfn, .Msg_Len,10);
IF .D$GTRACE+3 EQL 0 THEN
BEGIN
DECR I FROM .Msg_Len-1 TO 0
DO Get_Byte(Tdd);
RETURN 1
END
ELSE RETURN 0;
END; !OLen
END !End of module
ELUDOM