mirror of
https://github.com/PDP-10/stacken.git
synced 2026-04-20 00:43:22 +00:00
290 lines
7.8 KiB
Plaintext
290 lines
7.8 KiB
Plaintext
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
|