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

MODULE TINFO=
BEGIN

REQUIRE 'INTR.REQ';
LIBRARY 'DAPLIB';

THIS_IS [TINF]	VERSION [1]	EDIT [7]	DATE [14,AUG,79]

![7]	Put in TREQ routine to type out requestor ID 
!
! Table of Contents
!
FORWARD ROUTINE
RXFER,		!Return info about transfer in printable form
TXFER,		!Tell about a transfer (CRLF after)
TXFERNCRLF,	!Tell about a transfer (no CRLF after)
TPROC,		!Tell about a process
TELLJOB,	!Request (Job) startup & completion message typer
TREQ,		!Type out Requestor-ID
SAYONQ,		!Say "--- (On-line to QUASAR) "
SAYRES;		!Say "--- (Pending RESET) "


!
! Revision History
!
%(
[5]	Put in debugging printout for WHAT command
[4]	Change BIND ... REF ... TO BIND ...
)%

!
! Conditionals
!
COMPILETIME FTDEBUG=%SWITCHES(DEBUG);	!On for debugging stuff

!
! Externals
!
EXTERNAL ROUTINE
WRSIXA,
TNPFX,
TFB;

%IF FTDEBUG
	%THEN
	EXTERNAL ROUTINE
		WRNUMA;
	EXTERNAL CMDPBL: PROCESS_BLOCK;
	%FI

!
! Routines
!
GLOBAL ROUTINE TXFER(NB)=
(TXFERNCRLF(.NB);TYPE(CRLF));

GLOBAL ROUTINE TXFERNCRLF(NB)=
!Type a description of the activity on a link
!NB: address of NDB for link
BEGIN
LOCAL STR: VECTOR[CH$ALLOCATION(132)];
LOCAL PTR;

PTR=CH$PTR(STR);
RXFER(.NB,PTR);	!Get the info into our string
TSTR(STR);		!Type & log it
END; !TXFERNCRLF

GLOBAL ROUTINE RXFER(NB,PTR)=
!Return info about transfer in printable format
!NB: addr of NDB
!PTR: addr of byte pointer (for output)
BEGIN
MAP NB: REF NDB;
BIND FB=.NB[NDB$FB]: FILE_BLOCK;
EXTERNAL ROUTINE
FUNPARSE,
WRSIXA,
MOVEAZ,
LOGS;

LABEL TDIRECTION;

IF FB NEQ 0
 THEN	BEGIN
	IF .FB[FILE$NAME] NEQ 0
	 THEN  .PTR=FUNPARSE(FB,..PTR);	!Write in local filespec
	END;

TDIRECTION:	!Indicate direction of transfer (or type if not a transfer)
	BEGIN
	LOCAL SEND;
	CASE .N[CTLFUNC] FROM 0 TO 8 OF SET
	[0,C$CONNECT]:
		BEGIN
		SELECTONE .N[ACCFUNC] OF SET
		[ACC$CREATE]:	SEND=%O'11';
		[ACC$OPEN]:	SEND=%O'10';
		[ACC$RENAME]:	BEGIN
				IF .N[MASTER] THEN
					BEGIN
					WRSIXA(.N[NODEID],.PTR); !Put in nodeid
					CH$WCHAR_A(%C':',.PTR);
					CH$WCHAR_A(%C':',.PTR);
					MOVEAZ(%REF(CH$PTR(N[REMRENAME])),.PTR);
					MOVEAZ(%REF(CH$PTR(UPLIT(
					 %ASCIZ ' <RENAME< ' ))),.PTR);
					LEAVE TDIRECTION;
					END
				ELSE	BEGIN
					MOVEAZ(%REF(CH$PTR(UPLIT(
					 %ASCIZ ' >RENAME> '))),.PTR);
					.PTR=FUNPARSE(.N[RENAME_FB],..PTR);
					RETURN WIN;
					END;
				END;
		[ACC$ERASE]:	BEGIN
				IF .N[MASTER] THEN
					BEGIN
					WRSIXA(.N[NODEID],.PTR); !Put in nodeid
					CH$WCHAR_A(%C':',.PTR);
					CH$WCHAR_A(%C':',.PTR);
					MOVEAZ(%REF(CH$PTR(N[REMOTEFILE])),
					 .PTR);
					END;
				MOVEAZ(%REF(CH$PTR(UPLIT(
				 %ASCIZ ' [DELETE]'))),.PTR);
				RETURN WIN;
				END;
		[ACC$EXE]:	BEGIN
				IF .N[MASTER] THEN
					BEGIN
					WRSIXA(.N[NODEID],.PTR); !Put in nodeid
					CH$WCHAR_A(%C':',.PTR);
					CH$WCHAR_A(%C':',.PTR);
					MOVEAZ(%REF(CH$PTR(N[REMOTEFILE])),
					 .PTR);
					END;
				MOVEAZ(%REF(CH$PTR(UPLIT(
				 %ASCIZ ' [BATCH]'))),.PTR);
				RETURN WIN;
				END;
		[OTHERWISE]:	BEGIN
				MOVEAZ(%REF(CH$PTR(UPLIT(
				 %ASCIZ ' --- '))),.PTR);
				LEAVE TDIRECTION
				END;
		TES;
		END;
	[C$GET]: SEND=0;
	[C$PUT]: SEND=1;
	[INRANGE]: 	BEGIN
			MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ ' <?UIF?> '))),.PTR);
			LEAVE TDIRECTION;
			END;
	[OUTRANGE]: 	BEGIN
			MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ ' <?INV?> '))),.PTR);
			LEAVE TDIRECTION;
			END;
	TES;
	SEND=.SEND EQV .N[MASTER];	!Backwards if slave process

	IF .FB[FILE$FUNCTION] EQL _FODLT
	THEN MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ ' (deleted)'))),.PTR);
	!Tell about delete on close

	IF .N[ACCFUNC] EQL ACC$CMD
	THEN	BEGIN
		IF .N[MASTER]
		THEN MOVEAZ (%REF(CH$PTR(UPLIT(%ASCIZ' >>BATCH>> '))),.PTR)
		ELSE MOVEAZ (%REF(CH$PTR(UPLIT(%ASCIZ' <<BATCH<< '))),.PTR)
		END
	ELSE	MOVEAZ(%REF(CH$PTR(
		(IF .SEND THEN
		 UPLIT(%ASCIZ ' => ') ELSE UPLIT(%ASCIZ ' <= ')))),.PTR);
	END;	!TDIRECTION (still in RXFER)

IF .N[NODEID] NEQ 0 THEN	!Convert to ASCIZ string with '::' at end
	BEGIN
	EXTERNAL ROUTINE WRSIXA;

	WRSIXA(.N[NODEID],.PTR);	!Write in NODEID
	CH$WCHAR_A(%C':',.PTR);CH$WCHAR_A(%C':',.PTR);
	MOVEAZ(%REF(CH$PTR(N[REMOTEFILE])),.PTR);
	END	!Type out remote filespec if any

ELSE	BEGIN
	MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ'	(Listening)'))),.PTR);
	RETURN WIN;
	END;


!Now tell how far we got so far
	BEGIN
	EXTERNAL ROUTINE MOVEAZ,WRNUMA;
	CH$WCHAR_A(%C' ',.PTR);CH$WCHAR_A(%C'(',.PTR);
	WRNUMA(.FB[FILE$READS]+.FB[FILE$WRITES],10,.PTR);
	CH$WCHAR_A(%C'/',.PTR);
		BEGIN
		LOCAL T;
		IF (T=.FB[FILE$ALLOC]) EQL 0 THEN T=.FB[FILE$EST];
		WRNUMA(.T,10,.PTR);
		CH$WCHAR_A(%C')',.PTR);
		END;
	CH$WCHAR(0,..PTR);	!Make ASCIZ
	END;
END;	!RXFER
GLOBAL ROUTINE TPROC(PB,LEVEL)=
!Type out info about a process
!PB: Process block
!LEVEL: # of superiors this process has
BEGIN
MAP PB: REF PROCESS_BLOCK;
LOCAL TXTBUF: VECTOR[CH$ALLOCATION(133)];
LOCAL PTR;
EXTERNAL ROUTINE WRSIXA;

PTR=CH$FILL(%C' ',.LEVEL,CH$PTR(TXTBUF)); !Space over by # of superiors
WRSIXA(.PB[P$NAME],PTR);		!Put in process name
DEBUGMSG(			!Type out address of this process block
	CH$WCHAR_A(%C'(',PTR);
	WRNUMA(.PB,8,PTR);
	CH$WCHAR_A(%C')',PTR);
	);

CH$WCHAR_A(0,PTR);			!Make ASCIZ string
TSTR(TXTBUF);				!Type it out
IF .PB[P$DISPLAY] NEQ 0 THEN (.PB[P$DISPLAY])(.PB);
	!An arbitrary routine to execute to display more stuff

TCHR(%C' ');	!SPACE

IF .PB[P$NDB] NEQ 0
	THEN TXFER(.PB[P$NDB]) !Display transfer, if any
	ELSE TYPE(CRLF);

DEBUGMSG(				!Do stack trace of this process
	IF .PB NEQ CMDPBL		!But not if it is the top one
	 THEN	BEGIN
		ROUTINE PSTACK=();	!Patch in real stuff if desired
		PSTACK(.PB[9,0,18,0],0,99999);
		END;
	);

!Now display inferiors, if any
IF .PB[P$INFERIORS] NEQ 0 THEN
	BEGIN
	LOCAL T: REF PROCESS_BLOCK;
	T=.PB[P$INFERIORS];
	DO	BEGIN
		TPROC(.T,.LEVEL+1);	!Do the same for the inferior
		T=.T[P$LINK]		!Walk down the linked list
		END WHILE .T NEQ 0	!See if we're at the end
	END
END;	!TPROC

GLOBAL ROUTINE TELLJOB(NB)=
!Tell about starting or finishing a job 
!NB: address of NDB of job
BEGIN
MAP NB: REF NDB;
BIND FB=.NB[NDB$FB]: FILE_BLOCK;
EXTERNAL ROUTINE
	NPFX,
	LOGS,
	MOVEAZ;
UNDECLARE %QUOTE PREFIX;
MACRO PREFIX='JOB'%;
LOCAL	STR: VECTOR[CH$ALLOCATION(133)],
	PTR;

PTR=CH$PTR(STR);

SELECT .FB[FILE$FUNCTION] OF SET	!Select severity character
[OPRABO,OPRDEF]: CH$WCHAR_A(%C'%',PTR);
[OTHERWISE]: CH$WCHAR_A(%C'[',PTR);
TES;

MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ %STRING(PPREFIX,PREFIX)))),PTR);
!"[NETJOB"
NPFX(.NB,PTR);	!"[NETJOB(IPCE#1233)"

MOVEAZ(%REF(CH$PTR(
	(SELECTONE .NB[NDB$ACCFUNC] OF SET
	 [ACC$RENAME,ACC$ERASE]: UPLIT(%ASCIZ ' ');
	 [OTHERWISE]:	
		SELECTONE .FB[FILE$FUNCTION] OF SET
		 [_FOCLS,_FODLT]: UPLIT(%ASCIZ ' End '); !"[NETJOB(IPCE#1233) End"
		 [_FORED TO _FOAPP]:	 UPLIT(%ASCIZ ' Start '); !"[NETJOB(IPCE#1233) Start"
		 [OPRABO]:		 UPLIT(%ASCIZ ' Abort ');	!aborted
		 [OPRDEF]:		 UPLIT(%ASCIZ ' Reque ');	!Requeued
		 [OTHERWISE]:		 UPLIT(%ASCIZ ' ');	!Rename or ??????
		TES;
	 TES)
 )),PTR);
RXFER(.NB,PTR);
!"[NETJOB(IPCE#1233) End DSKQ:FOO.BAR[10,777] => IPCC::DSKZ:FOO.BAR[1,2] (5/5)]"

SELECT .FB[FILE$FUNCTION] OF SET
[OPRABO,OPRDEF]:	;	!no closing bracket
[OTHERWISE]:		CH$WCHAR_A(%C']',PTR);
TES;

MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ %STRING (CRLF)))),PTR);
	BEGIN	!Decide whether or not to type it
	LOCAL TYPEIT;
	TYPEIT=0;
	IF .N[MASTER]				!Active task
	 THEN	BEGIN
		IF .FB[FILE$FUNCTION] EQL OPRDEF
		THEN IFMSG(WARN,(TYPEIT=1))
		ELSE IFMSG(LJOB,(TYPEIT=1))
		END
	 ELSE	IFMSG(RJOB,(TYPEIT=1));
	IF .TYPEIT THEN TSTR_NOLOG(STR);	!We typed it!!
	END;
LOGS(STR);		!Always log it
END; !TELLJOB

GLOBAL ROUTINE TREQ(PB)=	!Type Requestor ID for process PB
BEGIN
MAP PB: REF PROCESS_BLOCK;
BIND NB=.PB[P$NDB]: NDB;

TSTR(NB[NDB$REQUESTOR]);
END; !TREQ

GLOBAL ROUTINE SAYONQ=TYPE('  ---	(On-line to QUASAR)');
GLOBAL ROUTINE SAYRES=TYPE('  ---	(Pending RESET)');

END ELUDOM