Google
 

Trailing-Edge - PDP-10 Archives - bb-h138f-bm - 7-sources/daptrt.b36
There are 3 other files named daptrt.b36 in the archive. Click here to see a list.
%TITLE 'D A P T R  -- DAP Trace tables'

MODULE Daptr (IDENT = '3.0'
		%BLISS36(,
		    ENTRY(
			  T_Datatype,
			  T_Fop,
			  T_Fac,
			  T_Shr,
			  T_Dsp,
			  T_Ctl,
			  T_Dtm,
			  T_Pro,
			  OTime,
			  GTrJfn
			 ))
		) =
BEGIN

!+
!
!
!
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1977, 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.
!
!
!
!    AUTHOR:	T. SPEER
!	CREATED: 1-FEB-87
!
!
!	Contains tables and low-level routines for TRACEing DAP messages.
!
!
!    REVISION HISTORY:
!
!    PRODUCT	LOCAL
!    EDIT	EDIT	DATE		WHO		PURPOSE
!    ====	====	====		===		==========
!
!    663	04-Feb-87		TGS		Creation
!
!
!    ***** END OF REVISION HISTORY *****
!
!
!
!
!
!-
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
	T_Datatype: NOVALUE,		! Interpret ATT datatype field
	T_Fop: NOVALUE,			! Interpret ATT FOP field
	T_Fac: NOVALUE,			! Interpret ACC FAC
	T_Shr: NOVALUE,			! Interpret SHR
	T_Dsp: NOVALUE,			! Interpret DISPLAY
	T_Ctl: NOVALUE,			! Interpret CTL fields
	T_Dtm: NOVALUE,			! Interpret Date/Time fields
	T_Pro: NOVALUE,			! Interpret PROTECTION fields
	OTime: NOVALUE,			! Output timestamp
	GTrJfn;				! See if DAP$TRACE/OUTPUT are defined
!
! INCLUDE FILES:
!

REQUIRE 'RMSREQ';
REQUIRE 'RMSOSD';
LIBRARY 'BLISSNET';

!
! MACROS:
!

MACRO $LOGIT(TEXT) =
	   SOUT(.D$GTRJFN,CH$PTR(UPLIT(%ASCIZ TEXT)),0);
	   %;

MACRO $CR_LOGIT(TEXT) =
           SOUT(.D$GTRJFN,CH$PTR(UPLIT(%ASCIZ %STRING(%CHAR(13,10),TEXT))),0);
           %;

MACRO LOG$IT(POINTER,LENGTH) = 
	   SOUT(.D$GTRJFN,POINTER,-LENGTH,0);
	   %;

MACRO Crlf=%STRING(%CHAR(13),%CHAR(10)) %;
!
! OWN STORAGE
!

OWN T_Crlf: INITIAL (%ASCII %CHAR(13,10));

!
! EXTERNAL REFERENCES:
!

EXTERNAL D$GTRACE,
	 D$GTRJFN,
	 D$GTRMAX,
	 D$GTWIDTH,
	 TBUFF;

EXTERNAL ROUTINE
	Dap$Get_Bitvector,
	Dap$Get_Variable_String,
	Dap$Get_Date;

BIND Twidth = D$GTwidth;

!+
!   Table of DAP message types
!-

    GLOBAL BIND
	Hdrtab = PLIT (
			  UPLIT ('???'),	!0 - Unknown message type
			  UPLIT ('CNF'),	!1 - CONFIG
			  UPLIT ('ATT'),	!2 - ATTRIBUTES
			  UPLIT ('ACC'),	!3 - ACCESS
			  UPLIT ('CTL'),	!4 - CONTROL
			  UPLIT ('CON'),	!5 - CONTINUE
			  UPLIT ('ACK'),	!6 - ACKNOWLEDGE
			  UPLIT ('CMP'),	!7 - ACCESS-COMPLETE
			  UPLIT ('DAT'),	!8 - DATA
			  UPLIT ('STS'),	!9 - STATUS
			  UPLIT ('KEY'),	!10 - KEY
			  UPLIT ('ALL'),	!11 - ALLOCATION
			  UPLIT ('SUM'),	!12 - SUMMARY
			  UPLIT ('DTM'),	!13 - DATE-TIME
			  UPLIT ('PRO'),	!14 - PROTECTION
			  UPLIT ('NAM'),	!15 - NAME
			  UPLIT ('ACL')		!16 - ACCESS CONTROL

			) : VECTOR;

! Table of DAP CONFIG Operating System types

	GLOBAL BIND
	Ostype = PLIT	(
		  UPLIT ('Illegal '),	!0 - Illegal
		  UPLIT ('RT-11   '),	!1
		  UPLIT ('RSTS/E  '),	!2
		  UPLIT ('RSX-11S '),	!3
		  UPLIT ('RSX-11M '),	!4
		  UPLIT ('RSX-11D '),	!5
		  UPLIT ('IAS     '),	!6
		  UPLIT ('VAX/VMS '),	!7
		  UPLIT ('TOPS-20 '),	!8
		  UPLIT ('TOPS-10 '),	!9
		  UPLIT ('RTS-8   '),	!10
		  UPLIT ('OS-8    '),	!11
		  UPLIT ('RSX11M+ '),	!12
		  UPLIT ('COPOS11 '),	!13
		  UPLIT ('P/OS    '),	!14
		  UPLIT ('VAXELN  '),	!15
		  UPLIT ('CP/M    '),	!16
		  UPLIT ('MS-DOS  '),	!17
		  UPLIT ('ULTRIX32'),	!18
		  UPLIT ('ULTRIX11'),	!19
		  UPLIT ('DTF/MVS ')	!20

			): VECTOR;

! Table of DAP CONFIG File System types

	GLOBAL BIND
	Filesys = PLIT (
		  UPLIT ('Illegal '),	!0
		  UPLIT ('RMS-11  '),	!1
		  UPLIT ('RMS-20  '),	!2
		  UPLIT ('RMS-32  '),	!3
		  UPLIT ('FCS-11  '),	!4
		  UPLIT ('RT-11   '),	!5
		  UPLIT ('Uns     '),	!6
		  UPLIT ('TOPS-20 '),	!7
		  UPLIT ('TOPS-10 '),	!8
		  UPLIT ('OS-8    '),	!9
		  UPLIT ('RMS-32S '),	!10
		  UPLIT ('CP/M    '),	!11
		  UPLIT ('MS-DOS  '),	!12
		  UPLIT ('ULTRIX32'),	!13
		  UPLIT ('ULTRIX11')	!14

			):VECTOR;

!Table of DAP ATTRIBUTES Organization types.  NOTE: RMS-20 order!

	    GLOBAL BIND
		Orgtype = PLIT	(
			   UPLIT ('???'),	!0
			   UPLIT ('SEQ'),	!1
			   UPLIT ('REL'),	!2
			   UPLIT ('IDX'),	!3
			   UPLIT ('HSH')	!4

				) : VECTOR;

! Table of DAP ATTRIBUTES Record format types

	    GLOBAL BIND

		Rfmtype = PLIT	(
			   UPLIT ('UDF'),	!0
			   UPLIT ('FIX'),	!1
			   UPLIT ('VAR'),	!2
			   UPLIT ('VFC'),	!3
			   UPLIT ('STM'),	!4
			   UPLIT ('SLF'),	!5
			   UPLIT ('SCR')	!6

				) : VECTOR;

! Table of DAP ATTRIBUTES Record Attribute types

	   GLOBAL BIND
		RATtype = PLIT	(
			  UPLIT ('FTN '),	!0
			  UPLIT ('CR  '),	!1
			  UPLIT ('PRN '),	!2
			  UPLIT ('BLK '),	!3
			  UPLIT ('EMB '),	!4
			  UPLIT ('Rsvd'),	!5
			  UPLIT ('LSA '),	!6
			  UPLIT ('MY11')	!7

				) : VECTOR;

! Table of DAP ACCESS Function types

	    GLOBAL BIND
		Acctype = PLIT (
			  UPLIT ('???'),	!0 - Unknown
			  UPLIT ('OPE'),	!1 - $OPEN
			  UPLIT ('CRE'),	!2 - $CREATE
			  UPLIT ('REN'),	!3 - $RENAME
			  UPLIT ('ERA'),	!4 - $ERASE
			  UPLIT ('Rsv'),	!5 - Reserved
			  UPLIT ('DIR'),	!6 - Directory List
			  UPLIT ('SUB'),	!7 - Submit
			  UPLIT ('EXE')		!8 - Execute

			       ):VECTOR;

! Table of DAP CONTROL Function types

	    GLOBAL BIND
		Ctltype = PLIT (
			  UPLIT ('???'),	!0 - Unknown
			  UPLIT ('GET'),	!1 - $GET
			  UPLIT ('CON'),	!2 - $CONNECT
			  UPLIT ('UPD'),	!3 - $UPDATE
			  UPLIT ('PUT'),	!4 - $PUT
			  UPLIT ('DEL'),	!5 - $DELETE
			  UPLIT ('REW'),	!6 - $REWIND
			  UPLIT ('TRU'),	!7 - $TRUNCATE
			  UPLIT ('MOD'),	!8 - $MODIFY
			  UPLIT ('RLS'),	!9 - $RELEASE
			  UPLIT ('FRE'),	!10 - $FREE
			  UPLIT ('XTB'),	!11 - EXTEND-BEGIN
			  UPLIT ('FLU'),	!12 - $FLUSH
			  UPLIT ('NXV'),	!13 - $NXTVOL
			  UPLIT ('FND'),	!14 - $FIND
			  UPLIT ('XTE'),	!15 - EXTEND-END
			  UPLIT ('DIS'),	!16 - $DISPLAY
			  UPLIT ('SPF'),	!17 - SPACE-FORWARD
			  UPLIT ('SPB'),	!18 - SPACE-BACKWARD
			  UPLIT ('CHK'),	!19 - CHECKPOINT
			  UPLIT ('RCG'),	!20 - RECOVERY-GET
			  UPLIT ('RCP')		!21 - RECOVERY-PUT

			       ):VECTOR;

! Table of DAP CONTINUE function types

	    GLOBAL BIND
		Contype = PLIT (
			  UPLIT ('???'),	!0 - Unknown
			  UPLIT ('RET'),	!1 - Try again
			  UPLIT ('SKP'),	!2 - Skip and continue
			  UPLIT ('ABO'),	!3 - Abort
			  UPLIT ('RES'),	!4 - Resume
			  UPLIT ('TER')		!5 - Terminate

			       ):VECTOR;

! Table of DAP ACCESS-COMPLETE Function Types


	    GLOBAL BIND
		Accomptype = PLIT (
			  UPLIT ('???'),	!0 - Unknown
			  UPLIT ('CLS'),	!1 - Close
			  UPLIT ('RSP'),	!2 - Response
			  UPLIT ('RES'),	!3 - Reset
			  UPLIT ('EOS'),	!4 - End-of-stream
			  UPLIT ('SKP'),	!5 - Skip
			  UPLIT ('CHB'),	!6 - Change-begin
			  UPLIT ('CHE'),	!7 - Change-end
			  UPLIT ('TER')		!8 - Terminate

				   ): VECTOR;
		
	BIND foptype =	PLIT (
			  UPLIT('RWO'),
			  UPLIT('RWC'),
			  UPLIT('???'),
			  UPLIT('POS'),
			  UPLIT('DLK'),
			  UPLIT('DIR'),
			  UPLIT('???'),
			  UPLIT('CTG'),
			  UPLIT('SUP'),
			  UPLIT('NEF'),
			  UPLIT('TMP'),
			  UPLIT('MKD'),
			  UPLIT('???'),
			  UPLIT('DMO'),
			  UPLIT('WCK'),
			  UPLIT('RCK'),
			  UPLIT('CIF'),
			  UPLIT('LKO'),
			  UPLIT('SQO'),
			  UPLIT('MXV'),
			  UPLIT('SPL'),
			  UPLIT('SCF'),
			  UPLIT('DLT'),
			  UPLIT('CBT'),
			  UPLIT('WAT'),
			  UPLIT('DFW'),
			  UPLIT('TEF'),
			  UPLIT('OFP')

			) : VECTOR;

	BIND Factype = PLIT (
			  UPLIT('PUT'),
			  UPLIT('GET'),
			  UPLIT('DEL'),
			  UPLIT('UPD'),
			  UPLIT('TRN'),
			  UPLIT('BIO'),
			  UPLIT('BRO'),
			  UPLIT('APP')

			    ) : VECTOR;

	BIND Shrtype = PLIT (
			  UPLIT('PUT'),
			  UPLIT('GET'),
			  UPLIT('DEL'),
			  UPLIT('UPD'),
			  UPLIT('MSE'),
			  UPLIT('UPI'),
			  UPLIT('NIL')

			    ) : VECTOR;
			  
	BIND Ractype =	PLIT (
			  UPLIT('SEQ'),
			  UPLIT('KEY'),
			  UPLIT('RFA'),
			  UPLIT('SFA'),
			  UPLIT('VBN'),
			  UPLIT('BFT'),
			  UPLIT('SAM')

			     ) : VECTOR;

	BIND Roptype = PLIT (
			  UPLIT('EOF'),
			  UPLIT('FDL'),
			  UPLIT('UIF'),
			  UPLIT('HSH'),
			  UPLIT('LOA'),
			  UPLIT('ULK'),
			  UPLIT('TPT'),
			  UPLIT('RAH'),
			  UPLIT('WBH'),
			  UPLIT('KGE'),
			  UPLIT('KGT'),
			  UPLIT('NLK'),
			  UPLIT('RLK'),
			  UPLIT('BIO'),
			  UPLIT('LIM'),
			  UPLIT('NXR'),
			  UPLIT('WAT'),
			  UPLIT('RRL'),
			  UPLIT('REA')
			   ) : VECTOR;

	BIND Protab = PLIT (
			  UPLIT('RWED'),
			  UPLIT('WED'),
			  UPLIT('RED'),
			  UPLIT('ED'),
			  UPLIT('RWD'),
			  UPLIT('WD'),
			  UPLIT('RD'),
			  UPLIT('D'),
			  UPLIT('RWE'),
			  UPLIT('WE'),
			  UPLIT('RE'),
			  UPLIT('E'),
			  UPLIT('RW'),
			  UPLIT('W'),
			  UPLIT('R'),
			  UPLIT('None')
				) : VECTOR;
GLOBAL ROUTINE T_DATATYPE (P_Dd: REF $Dap_descriptor
			    ) : NOVALUE =
BEGIN

	BIND Tdd = .P_dd: $Dap_descriptor;

	LOCAL  datatype: BITVECTOR[14] INITIAL(0);

	LITERAL Reserved = 6;

	Dap$Get_Bitvector (Tdd, datatype, 2);

	IF .datatype[Dap$v_Datatype_Ascii]
	THEN $Logit('ASCII ');

	IF .datatype[Dap$v_Datatype_Image]
	THEN $Logit('IMAGE ');

	IF .datatype[Dap$v_Datatype_Ebcdic]
	THEN $Logit('EBCDIC ');

	IF .datatype[Dap$v_Datatype_Compressed]
	THEN $Logit('COMPRESSED ');

	IF .Datatype[Dap$v_Datatype_Executable]
	THEN $Logit('EXECUTABLE ');

	IF .Datatype[Dap$v_Datatype_Priveleged]
	THEN $Logit('PRIVILEGED ');

	IF .datatype[Reserved]
	THEN $Logit('Rsv ');

	IF .Datatype[Dap$v_Datatype_Zero_On_Delete]
	THEN $Logit('SENSITIVE ');

END;
GLOBAL ROUTINE T_FOP (P_Dd: REF $Dap_descriptor
		       ) : NOVALUE =
BEGIN
BIND Tdd = .P_dd: $Dap_descriptor;

LOCAL	fop: BITVECTOR[42] INITIAL (0),
	count: INITIAL(0);

LITERAL	Fop_min = 0,
	Fop_Max = 27;


Dap$Get_Bitvector(Tdd, fop, 6);

INCR i from Fop_min TO Fop_Max
DO
BEGIN
	IF .fop[.i] THEN 
	BEGIN
	  IF .count NEQ 0 THEN 
	  BEGIN 
		$Logit('+');
	  END
	  ELSE
	  BEGIN
		$Logit(' Fop:');
	  END;
	  Log$it(CH$PTR(.Foptype[.i]),3);
	  Count = .count + 1;
	END;
END;

END;
GLOBAL ROUTINE T_FAC (P_Dd: REF $Dap_descriptor
		       ) : NOVALUE =
BEGIN

BIND Tdd = .P_dd: $Dap_descriptor;

IF .Tdd[Dap$h_Length] GTR 0 THEN
BEGIN

	LOCAL	Fac: BITVECTOR[28] INITIAL (0),
		count: INITIAL(0);

	LITERAL	Fac_min = 0,
		Fac_Max = 7;

	$Cr_Logit('      Fac:  ');
	Dap$Get_Bitvector(Tdd, Fac, 3);

	INCR i from Fac_min TO Fac_Max
	DO
	BEGIN
		IF .Fac[.i] THEN 
		BEGIN
		  IF .count NEQ 0 THEN $Logit('+');
		  Log$it(CH$PTR(.Factype[.i]),3);
		  Count = .count + 1;
		END;
END;
END;

END;
GLOBAL ROUTINE T_SHR (P_Dd: REF $Dap_descriptor
		       ) : NOVALUE =
BEGIN

BIND Tdd = .P_dd: $Dap_descriptor;

IF .Tdd[Dap$h_Length] GTR 0 THEN
BEGIN

	LOCAL	Shr: BITVECTOR[28] INITIAL (0),
		count: INITIAL(0);

	LITERAL	Shr_min = 0,
		Shr_Max = 6;

	$Logit(' Shr:');
	Dap$Get_Bitvector(Tdd, Shr, 3);

	IF .Shr EQL 0 THEN 
	BEGIN
		$Logit('GET');
		RETURN
	END;

	INCR i from Shr_min TO Shr_Max
	DO
	BEGIN
		IF .Shr[.i] THEN 
		BEGIN
		  IF .count NEQ 0 THEN $Logit('+');
		  Log$it(CH$PTR(.Shrtype[.i]),3);
		  Count = .count + 1;
		END;
	END;
END;
END;
GLOBAL ROUTINE T_Dsp (P_Dd: REF $Dap_descriptor
		       ) : NOVALUE =
BEGIN

BIND Tdd = .P_dd: $Dap_descriptor;

IF .Tdd[Dap$h_Length] GTR 0 THEN
BEGIN
	LOCAL Display: BITVECTOR[28] INITIAL(0);

        Dap$Get_Bitvector(Tdd,Display,4);
	$Logit(' Dsp:');
	Nout(.D$GTRJFN,.Display,8);
END;
END;
GLOBAL ROUTINE T_CTL (P_Dd: REF $Dap_descriptor
		       ) : NOVALUE =
BEGIN
BIND Tdd = .P_dd: $Dap_descriptor;

LOCAL	Ctlmenu: BITVECTOR[28] INITIAL(0),
	init,
	v,
	count: INITIAL(0);

Init = false;
Dap$Get_Bitvector(Tdd, Ctlmenu, 1);

IF .Ctlmenu[Dap$v_Ctl_Rac]
THEN
  BEGIN
	$Cr_Logit('      Rac:');
	V = Get_Byte(Tdd);
	Log$it(CH$PTR(.Ractype[.v]),3);
	Init=true;
  END;
IF .Ctlmenu[Dap$v_Ctl_Key]
THEN Dap$Get_Variable_String(Tdd,0,255);

IF .Ctlmenu[Dap$v_Ctl_Krf]
THEN
  BEGIN
	$Logit(' Krf:');
	Nout(.D$GTRJFN,Get_Byte(Tdd),8);
  END;
	
IF .Ctlmenu[Dap$v_Ctl_Rop] 
THEN
  BEGIN
	LOCAL Rop: BITVECTOR[42] INITIAL(0);
	LITERAL Rop_Min = 0,
		Rop_Max = 18;

	Dap$Get_Bitvector (Tdd, Rop, 6);

	IF .init EQL True THEN
	BEGIN
		$Logit(' Rop:')
	END
	ELSE
	BEGIN
		$Cr_Logit('      Rop: ');
	END;

	INCR i from Rop_min TO Rop_Max
	DO
	BEGIN
		IF .Rop[.i] THEN 
		BEGIN

		  IF .count NEQ 0 THEN $Logit('+');
		  Log$it(CH$PTR(.Roptype[.i]),3);
		  Count = .count + 1;
		END;
	END;

  END;

IF .ctlmenu[dap$v_ctl_display] ! DISPLAY field present
THEN T_Dsp(Tdd);

END;
GLOBAL ROUTINE T_DTM (P_Dd: REF $Dap_descriptor
		       ) : NOVALUE =
BEGIN
BIND Tdd = .P_dd: $Dap_descriptor;

LOCAL dtmstr: VECTOR[CH$ALLOCATION(18)] INITIAL(0);
LOCAL dtmmenu: BITVECTOR[14] INITIAL(0);

	Dap$Get_Bitvector(Tdd, dtmmenu, 2);
        IF .dtmmenu[Dap$v_Dtm_Cdt]  ! Creation date time
	THEN
	BEGIN
		Dap$Get_Date(Tdd,CH$PTR(dtmstr));
		$Logit('Creation: ');
		Log$it(CH$PTR(dtmstr),18);
	END;

END;
GLOBAL ROUTINE T_PRO (P_Dd: REF $Dap_descriptor
		       ) : NOVALUE =
BEGIN
BIND Tdd = .P_dd: $Dap_descriptor;
LOCAL promenu: BITVECTOR[14] INITIAL(0),
      Init;

Init = false;

Dap$Get_Bitvector(Tdd, promenu, 2);	! Get the menu

IF .promenu[Dap$v_Protmenu_Owner]   ! Owner protection
THEN BEGIN
	LOCAL owner: VECTOR[CH$ALLOCATION(40)] INITIAL (0);
	LOCAL v;
	v=Dap$Get_Variable_String(Tdd,CH$PTR(owner),40);
	$Logit('Owner:');
	Log$it(CH$PTR(owner),.v);
	Init = true;
     END;


IF .promenu[DAP$V_PROTMENU_PROTSYS] ! System protection
THEN BEGIN
     LOCAL prot: BITVECTOR[21] INITIAL(0);
     Dap$Get_Bitvector(Tdd, prot, 3);

     IF .init EQL True THEN
     BEGIN
	     $Logit(' Sys:')
     END
     ELSE
     BEGIN
	     $Logit('Sys: ');
	     Init = true;
     END;

     Log$it(CH$PTR(.Protab[.prot AND %O'17']),0);

    END;

IF .promenu[Dap$v_Protmenu_Protown] ! Owner protection
THEN BEGIN
     LOCAL prot: BITVECTOR[21] INITIAL(0);
     Dap$Get_Bitvector(Tdd, prot, 3);

     IF .init EQL True THEN
     BEGIN
	     $Logit(' Own:')
     END
     ELSE
     BEGIN
	     $Cr_Logit('Own: ');
	     Init = true;
     END;

     Log$it(CH$PTR(.Protab[.prot AND %O'17']),0);

     END;

IF .promenu[DAP$V_PROTMENU_PROTGRP] ! Group protection
THEN BEGIN
     LOCAL prot: BITVECTOR[21] INITIAL(0);
     Dap$Get_Bitvector(Tdd, prot, 3);

     IF .init EQL True THEN
     BEGIN
	     $Logit(' Grp:')
     END
     ELSE
     BEGIN
	     $Cr_Logit('Grp: ');
	     Init = true;
     END;
     Log$it(CH$PTR(.Protab[.prot AND %O'17']),0);

     END;

IF .promenu[DAP$V_PROTMENU_PROTWLD] ! World protection
THEN BEGIN
     LOCAL prot: BITVECTOR[21] INITIAL(0);
     Dap$Get_Bitvector(Tdd, prot, 3);

     IF .init EQL True THEN
     BEGIN
	     $Logit(' Wld:')
     END
     ELSE
     BEGIN
	     $Cr_Logit('Wld: ');
	     Init = true;
     END;

     Log$it(CH$PTR(.Protab[.prot AND %O'17']),0);

     END;

END;
GLOBAL ROUTINE Otime (JFN,FLAGS,MESSAGE_TYPE,NET_JFN) : NOVALUE =

BEGIN

	IF .message_type EQL 0 THEN
	BEGIN
		ODTIM(.Jfn,-1,.flags);
		SOUT(.Jfn,CH$PTR(T_Crlf),2);
	END
	ELSE
	BEGIN
		SOUT(.Jfn,CH$PTR(T_Crlf),2);
		ODTIM(.Jfn,-1,.Flags);
		IF .message_type EQL Dap$k_Trace_Input
		THEN $Logit(' Receiving');
		IF .message_type EQL Dap$k_Trace_Output
		THEN $Logit(' Sending');
		$Logit(', Link ID:');
		Nout(.Jfn,.Net_Jfn<rh>,8);
		SOUT(.Jfn,CH$PTR(T_Crlf),2);	
	END;

END;
GLOBAL ROUTINE GTrJfn =
BEGIN
	BIND Trace_Ln = CH$PTR(UPLIT(%ASCIZ'DAP$TRACE'));
	BIND Output_Trace_Ln = CH$PTR(UPLIT(%ASCIZ'DAP$OUTPUT'));
	LOCAL Ln_Buf: VECTOR[CH$ALLOCATION(80)];
	LOCAL Jfn;

!	See if a logical has been defined.

	IF Lnmst ($Lnsjb, Trace_Ln, CH$PTR(Ln_Buf))
	THEN 						
	   BEGIN		! DAP$TRACE is defined to something
	   LOCAL v;

	   D$GTRACE = -1;	! Default to full tracing
	   IF Nin(CH$PTR(Ln_Buf),8 ;Ln_Buf,v)  ! But try to NIN a value
	   THEN D$GTRACE = .v;   ! If a number, use it
	   END;


	Jfn = 0;
!	See if DAP$OUTPUT has been defined as a logical name

	IF Lnmst ($Lnsjb, Output_Trace_Ln, CH$PTR(Ln_Buf))
	THEN
	BEGIN
	   
!	If an old output file exists, use it, else create a new one.
!	If both these operations fail, we default output to TTY:.

	IF NOT Gtjfn(GJ_Sht+GJ_Old,CH$PTR(Ln_Buf);Jfn)
	THEN IF NOT Gtjfn(GJ_Sht+GJ_Fou,CH$PTR(Ln_Buf);Jfn)
	THEN Jfn = 0;

	END;
	IF .Jfn EQL 0 THEN Jfn = $PRIOU;

	.Jfn

END;

END
ELUDOM