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

MODULE PAGER (			!Interface to page manager and QUASAR
		  IDENT = '1'
		  ) =
BEGIN


! COPYRIGHT (C) 1978
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754
!
! THIS SOFTWARE IS FURNISHED  UNDER A LICENSE FOR USE ONLY ON A SINGLE
! COMPUTER  SYSTEM AND  MAY BE  COPIED ONLY WITH  THE INCLUSION OF THE
! ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANY OTHER COPISE THEREOF,
! MAY NOT BE PROVIDED OR  OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
! EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE
! TERMS.  TITLE TO AND  OWNERSHIP OF THE  SOFTWARE  SHALL AT ALL TIMES
! REMAIN IN DEC.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD  NOT BE CONSTRUED  AS A COMMITMENT  BY DIGITAL  EQUIPMENT
! CORPORATION.
!
! DEC ASSUMES  NO  RESPONSIBLILTY  FOR  THE USE OR  RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
!
!++
! FACILITY:
!	RMCOPY for TOPS-10 only
!
! ABSTRACT:
!	This module provides the system queue interface for RMCOPY.
!	Specifically, it has hooks for doing Q entry creation, listing, and
!	killing.  Internally, it has a rudimentary memory manager, and
!	an IPCF interface, and a QUASAR interface.  The IPCF and QUASAR
!	stuff is patterned after QMANGR and QUENCH.  (QMANGR and QUENCH
!	themselves are NOT used,, we talk DIRECTLY to QUASAR.
!
! ENVIRONMENT:
!	TOPS-10 (TOPS-20 to come)
!
! AUTHOR: Dave Cornelius, CREATION DATE: January, 1978
!
! MODIFIED BY:
!     , : VERSION
! 01	D Cornelius  Mar 31, 1978   - Add /AFTER printer for LISTANSWER
!
! 02	D Cornelius  May 12, 1978  - Clean up LISTON output.
!
! 03	D Cornelius May 15, 1978 - Add RELEASE calls to ADDFILE.
!		Add debugging printout to ADDFILE.
! 04	Andy Nourse 15-Jun-78 Globalize QSRPID and use it if already set up,
!		don't wait for QUASAR if FTNETSPL.
! 05	D Cornelius Jul 20, 1978 - Add PPN fields to QFUNC and
!		KILLR
!--

EXTERNAL
	G$NOW,				!The current daytime (in universal form)
	G$DBUG;				!Poke non-zero w/DDT to get debug info
EXTERNAL ROUTINE
	RELEASE;			!To return an FB (+ its channel) (for ADDFILE)

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
	QUEFLS:NOVALUE,		!Flush input queue
	QUEQRY,			!returns status of next message from QUASAR
	QUEIGN:NOVALUE,		!Receive and ignore the next message
	QUEWAT:NOVALUE,		!Wait for a msg from QUASAR
	RCVACK:NOVALUE,		!Receive a page or short message
	MSGSND:NOVALUE,		!Send a msg to QUASAR
	GETPAG,			!Returns number of a page not in adrs space
	PAGCRE,			!Includes a page in the adrs space
	NEWPAG,			!Creates a page in the adrs space, returns its adrs
	PAGDES,			!Destroys a page, removing it from the adrs space
	LISTEM:NOVALUE,		!Lists a specified Q
	WRPPNA:NOVALUE,		!Converts a ppn bit pattern to ASCII
	WR2DEC:NOVALUE,		!Like WRNUMA, but alwasy writes 2 digits
	WRTIME:NOVALUE,		!Converts universal date-time for output
	LISTON,			!Lists one entry from the Q
	KILLR:NOVALUE,		!Kills one or more request from the Q
	PPN,			!Converts ASCIZ ppn string to bit patttern
	QFUNC,			!Called by RMCOPY to do LIST or KILL
	CREAT,			!Called by RMCOPY to do a CREATE in the NET Q
	ADDFILE,		!Internal, adds files to CREATE's EQ
	UNSIX6;			!Internal, converts 6 SIXBIT chars

!
!Conditional Compilation
!
!IPC modifications are controlled by the LIBRARY file IPCF.REQ
COMPILETIME FTSIGNAL = %IF %VARIANT %THEN 1 %ELSE 0 %FI;
!If "on", use the signalling mechanism
COMPILETIME FTTRUST_PSI=0;
!If "on" then trust software interrupt system (see SPECIAL INSTRUCTIONS)
COMPILETIME FTNETSPL = %IF (%VARIANT AND 2) EQL 2 %THEN 1 %ELSE 0 %FI;
!If "on" then reformat error messages for NETSPL
COMPILETIME FTALLOC = ((%VARIANT AND %O'4000') NEQ 0);
!If "on" then compile for use with ALLOC & FREE (required for NETSPL)
%IF FTNETSPL %THEN
	%ASSIGN(FTALLOC,1)	!Force these on for NETSPL
	%ASSIGN(FTSIGNAL,1)
	%FI
COMPILETIME VAR=(%VARIANT AND 3);	!Pull out interesting bits
COMPILETIME FTINFORM=(%VARIANT AND %O'400') EQL 0;
!If "on" (default), generate messages to tell about feature tests

!
! INCLUDE FILES:
!
%IF FTSIGNAL
%THEN
REQUIRE 'INTR.REQ';		!For MACROs DFF, DLIT, SFDMAX, CALLI, etc
%ELSE
LIBRARY 'RMCOPY';		!For interface to sys-independent portion
LIBRARY 'IPCF';			!For Packet fields, header fields
!LIBRARY 'RMCSND';		!Fields for RMC request block
%FI

!
! Version info
!
THIS_IS [PAGE]	VERSION [1]	EDIT [4]	DATE [15,JUN,78]

!
! Tell User about conditionals
!
%IF FTINFORM
    %THEN %IF (FTSIG OR FTNETSPL) EQL 0
	%THEN %INFORM ('PAGE for RMCOPY')
	%ELSE %IF (FTSIG AND FTNETSPL)
		%THEN %INFORM ('PAGE for NETSPL')
	    %ELSE %IF FTSIG
		%THEN %INFORM ('Interrupt-driven PAGE, but not for NETSPL')
		%ELSE %WARN('This %VARIANT setting not supported')
		%FI
	    %FI
	%FI
    %IF FTIPC
	%THEN %INFORM('IPC-Modified version')
	%FI
    %IF FTALLOC AND (NOT FTNETSPL)
	%THEN %INFORM('ALLOC/FREE support included')
	%FI
    %FI

!
! MACROS:
!
%IF NOT FTNETSPL
	%THEN
	UNDECLARE %QUOTE PPREFIX;
	MACRO PPREFIX='RMC' %;
	%FI

!
! EQUATED SYMBOLS:
!
LITERAL IPCF_INTERVAL = 10;		!How long to wait for receive
LITERAL LSTLEN = 1;			!One page in the request
LITERAL
	IPCFR_ = %O'142',
	IPCFS_ = %O'143',
	IPCFQ_ = %O'144';
LITERAL
	IPCDD = %O'7',			!QUASAR disabled for receives
	IPCRS = %O'10',			!My send quota exhausted
	IPCRR = %O'11',			!QUASAR over quota
	IPCRY = %O'12';			!System full

LITERAL
	HIBER = %O'72',
		HB_IPC = %O'200000000';
LITERAL
	GETTAB = %O'41',
	GETPPN = %O'24',
	SLEEP = %O'31',
	PJOB = %O'30';

LITERAL PAGE_ = %O'145';
LITERAL _PAGCD = 1;			!Create/destroy a page
LITERAL PAG_DSK = %O'200000000000';	!The 'create-page-on-disk' bit for 
					!page creating
LITERAL	PAG_DES = %O'400000000000';	!Don't create,,, destroy!
LITERAL JBFF = %O'121';
LITERAL JBREL = %O'44';

LITERAL NETQNAM = %SIXBIT 'NET';


!
! GLOBAL STORAGE
!
GLOBAL
	QSRPID:INITIAL(0);		!Holds ID over send...recv
!
! OWN STORAGE:
!

OWN
	LISTARG,			!Holds 0 or PPN for list function
	LSTANY,				!Flag... 0==> no jobs checked
	LSTTJL;				!Count of total # jobs listed

!
! EXTERNAL REFERENCES:
!
UNDECLARE ZERO;
EXTERNAL ROUTINE
	ZERO,				!in IO.B36
	RDSIX,
	RDNUMA,
	WRSIXA,
	WRNUMA,
	FBINI,
	FPARSE,
	COPY,				!does BLTs
	MSGERROR;			!In IO10.B36
%IF (NOT FTTRUST_PSI) AND FTSIGNAL %THEN
EXTERNAL ROUTINE
	UDT,			!Get time in UDT
	TSIGNL,			!Set alarm clock
	TSICAN;			!Clear ...
%FI

!
! POSSIBLE ERROR MESSAGES
!
%(
Prefix		Text					Severity

CFQ	Cannot flush the IPCF receive queue		(SEVERE)
AQF	Acknowledgment receive from SYSTEM[QUASAR] failed (SEVERE)
LQF	List answer receive from SYSTEM[QUASAR] failed	(SEVERE)
MFQ	<text of message from QUASAR>			(determined by QUASAR)
NGS	No GALAXY-10 Support in this monitor		(SEVERE)
CQP	Cannot find QUASARs PID				(SEVERE)
WFQ	RMCOPY Waiting for [SYSTEM]QUASAR to start	(INFORMATIVE)
SQF	Send to [SYSTEM]QUASAR failed			(SEVERE)
SQR	RMCOPY Send has failed, message being re-sent	(WARN)

Note that if prefixes are being used, the prefix for the program
(i.e. RMC or NET) will be immediately before the prefix indicated here.
)%

!
! ROUTINES
!

GLOBAL ROUTINE QUEFLS:NOVALUE=
!++
! FUNCTIONAL DESCRIPTION:
!	This routine flushes all outstanding messages from the IPCF receive
!	queue for this job.  It may be useful for initialization purposes
!	to be sure that we are starting with a 'clean slate'. and
!	not picking up garbage from some previous request.
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	The contents and state of the IPCF receive queue.
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	Any data in the IPCF receive queue is THROWN AWAY !!!
!
!--
BEGIN
	LOCAL PACK:IPCF_HEADER;
	WHILE QUEQRY(PACK) NEQ 0  DO  QUEIGN(PACK);
END;

GLOBAL ROUTINE QUEQRY (HDRADR)=		!Returns 1 if QSR mesg is waiting, 0 otherwise
!++
! FUNCTIONAL DESCRIPTION:
!	This routine allows the caller to determine if there are any
!	messages in the IPCF receive queue from QUASAR.
!	If this routine returns 1, the caller may then do a receive
!	and will not block.
!
! FORMAL PARAMETERS:
!
!	An IPCF packet header (IPCF_HEADER structure
!
! IMPLICIT INPUTS:
!
!	The state of the IPCF receive Q
!
! IMPLICIT OUTPUTS:
!
!	A packet header describing the next packet to be received is returned
!	in the passed packet header if the routine returns 1
!
! ROUTINE VALUE:
!
!	1 ==> a message from QUASAR is waiting,, 0 ==> none there
!
! SIDE EFFECTS:
!
!	Any messages which are not from QUASAR are ignored (THROWN AWAY!!)
!
!--
BEGIN
	MAP HDRADR:REF IPCF_HEADER;
	REGISTER S2;			!For the UUO

	WHILE 1 DO
	BEGIN
		ZERO (.HDRADR, .HDRADR + IPCF$HEADER_LEN - 1);
		S2<LH> = IPCF$HEADER_LEN;
		S2<RH> = .HDRADR;
		IF NOT CALLI (S2, IPCFQ_) THEN RETURN 0;
		IF (.HDRADR [IPCF$MSG_LEN] EQL 0) AND
		    (.HDRADR [IPCF$MSG_NWAIT] EQL 0) THEN RETURN 0;
		IF .HDRADR [IPCF$SEND_PID] EQL .QSRPID THEN RETURN 1;
		QUEIGN (.HDRADR);		!Flush the junk mail
	END

END;

GLOBAL ROUTINE QUEIGN (HDRADR):NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!	This routine receives and throws away the next IPCF receive Q entry.
!
! FORMAL PARAMETERS:
!
!	An IPCF header address
!
! IMPLICIT INPUTS:
!
!	The IPCF receive Q
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	If there is no packet waiting, the job will block.
!	The data that was in the message is completely lost.
!
!--
BEGIN
	MAP HDRADR:REF IPCF_HEADER;
	REGISTER S2;

	S2 = .HDRADR [IPCF$PAGE_PACK];
	ZERO (.HDRADR, .HDRADR + IPCF$HEADER_LEN - 1);
	HDRADR [IPCF$PAGE_PACK] = .S2;
	HDRADR [IPCF$TRUNC] = 1;
	S2<LH> = IPCF$HEADER_LEN;
	S2<RH> = .HDRADR;
	IF NOT CALLI (S2, IPCFR_) THEN
		MSGERROR (CH$PTR(PLIT (%ASCIZ
		 'Cannot flush the IPCF receive queue')),'CFQ' OR S$SEVERE);
END;

GLOBAL ROUTINE QUEWAT (HDRADR):NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!	This routine will put the job to sleep until there is a message from
!	QUASAR in the IPCF receive Q.  This routine does not do the receive,
!	it merely sleeps until there is data.

! SPECIAL INSTRUCTIONS:
!	Compile /VARIANT:1 to use software interrupt system and NETSPL
!	condition-handling package.  This requires an interrupt block to
!	have already been set up and IPCF interrupts to have been enabled
!	The interrupt block is assumed to be at IPCFINT (external)
!
! FORMAL PARAMETERS:
!
!	The address of an IPCF header block
!
! IMPLICIT INPUTS:
!
!	The state of the IPCF receive Q
!	IPCFINT (if compiled /VARIANT:1, see SPECIAL INSTRUCTIONS)
!
! IMPLICIT OUTPUTS:
!
!	The IPCF header will have some information about the packet to be received
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	See QUEQRY
!
!--
	BEGIN
	MAP HDRADR:REF IPCF_HEADER;

	%IF FTSIGNAL AND (NOT FTTRUST_PSI)
	%THEN
	LOCAL	IPCFRETRY: INT_BLOCK,
		IR;

	CLEARV(IPCFRETRY);
	%FI

	WHILE QUEQRY (.HDRADR) EQL 0
	DO
	%IF FTSIGNAL
	%THEN	BEGIN
		EXTERNAL IPCFINT;
		EXTERNAL ROUTINE WAIT;
		%IF (NOT FTTRUST_PSI) %THEN
		IR=TSIGNL(IPCFRETRY,UDT()+IPCF_INTERVAL); !Set timer for retry
		%FI
		WAIT(IPCFINT);
		%IF (NOT FTTRUST_PSI) %THEN
		TSICAN(.IR)
		%FI;	!Clear the timer
		END
	%ELSE	BEGIN
		REGISTER S2;
		S2 = HB_IPC + 2000;	!Sleep for 2 seconds
		CALLI (S2, HIBER)
		END
	%FI
	END;

GLOBAL ROUTINE RCVACK:NOVALUE=
!++
! FUNCTIONAL DESCRIPTION:
!	This routine waits for an acknowledgment message from QUASAR.
!	If the ack msg has a text message associated with it,
!	the message is typed on the user's terminal.
!	If the message spans several IPCF packets, then they will
!	all be handled before control is returned.
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	The IPCF receive Q
!
! IMPLICIT OUTPUTS:
!
!	Some data may be typed on the user's terminal
!
! ROUTINE VALUE:
!
!	SS$_NORMAL: success, SS$_WARN or SS$_ERROR if QUASAR complains
!	(any error message will have been printed (via MSGERROR)
!
! SIDE EFFECTS:
!
!	NONE
!
!--
BEGIN
	LOCAL PACK:IPCF_HEADER;		!Something to pass to  QUEWAT
	LOCAL SHORTMSG:BLOCK[20];	!For non-paged acks
	LOCAL T;			!A temporary
	LOCAL M:REF QSR$MSG_TEXT;	!Will point to the msg received
	REGISTER S2;			!For the UUO

	WHILE 1 DO 
	BEGIN
		QUEWAT (PACK);			!Wait for the answer
		T = .PACK [IPCF$PAGE_PACK];	!Save page mode flag
		PACK [IPCF$FLAGS] =
		  PACK [IPCF$SEND_PID] =
		    PACK [IPCF$RECV_PID] = 0;
		PACK [IPCF$MSG_ADR] = M = SHORTMSG; !Aim at short message
		IF (PACK [IPCF$PAGE_PACK] = .T)	!Restore the flag
			NEQ 0 THEN
			BEGIN
				PACK [IPCF$MSG_LEN] = %O'1000';
				PACK [IPCF$MSG_ADR] = GETPAG();
				M = .PACK [IPCF$MSG_ADR] * %O'1000';
			END;
		S2<LH> = IPCF$HEADER_LEN;
		S2<RH> = PACK;
		IF NOT CALLI (S2, IPCFR_) THEN
			MSGERROR (CH$PTR(PLIT (%ASCIZ
			 'Acknowledgment receive from SYSTEM[QUASAR] failed'
			 )),'AQF' OR S$SEVERE);
		IF .M [QSR$TEXT_NOMESS] EQL 0 THEN
		BEGIN
			MSGERROR (CH$PTR (M[QSR$TEXT_MSG]),
				((%IF FTNETSPL %THEN 'MFQ' %FI) OR
				(IF .M[QSR$TEXT_FATAL] THEN S$SEVERE
					ELSE IF .M[QSR$TEXT_WARN] THEN S$WARN
						ELSE S$COMMENT)));
		END;
		IF .M [QSR$TEXT_MORE ] EQL 0
			THEN RETURN	(IF .M[QSR$TEXT_NOMESS]
						THEN SS$_NORMAL	!Good return
					ELSE IF .M[QSR$TEXT_FATAL]
						THEN SS$_ERROR	!We lost
					ELSE IF .M[QSR$TEXT_WARN]
						 THEN SS$_WARN	!Warning
					ELSE SS$_NORMAL);	!Good return
			!Convert QUASAR severity code to ours
	END
END;

GLOBAL ROUTINE MSGSND(MSGADR, PAGEFLG):NOVALUE = !Send a message to QUASAR
!++
! FUNCTIONAL DESCRIPTION:
!	This routine pulls the required UUOs to send a message to QUASAR
!	If the message cannot be sent because of some temporary condition,
!	The routine will sleep, and retry after a while.
!	This routine does not wait for any acks on the message.
!
! FORMAL PARAMETERS:
!
!	MSGADR - The address of a packet or page of information (ie the message)
!	PAGEFLG - A number indicating whether the packet is a page of data or
!		just a short message.  (1==>page, 0==>packet).
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	A message is sent to QUASAR via IPCFS.
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--
BEGIN
	MAP MSGADR:REF QSR$HEADER;	!The only thing we deal with is the header
				!Whatever is tacked on to the header is the caller's
				!Responsibility
	LOCAL IPCFBLK: IPCF_HEADER;
	REGISTER AC;			!For the UUOS
	LOCAL FLAG;			!For first time-thru wait loop

	LITERAL SECNDSTS = %O'106000011';	!Second configuration word GETTAB ptr
	LITERAL STAT_GAL = %O'1000';	!Galaxy is built in
	LITERAL SPIDQSR = %O'2000126';		!GETTAB for [SYSTEM]QUASAR's PID

	ZERO (IPCFBLK, IPCFBLK + IPCF$HEADER_LEN - 1);
	AC = SECNDSTS;
	IF NOT CALLI (AC, GETTAB) THEN AC = 0;
	IF (.AC AND STAT_GAL) EQL 0 THEN
		MSGERROR (CH$PTR(PLIT (%ASCIZ
		 'No GALAXY-10 Support in this monitor')),'NGS' OR S$SEVERE);
	FLAG = 0;
	IF .QSRPID EQL 0
	 THEN	WHILE 1 DO
		BEGIN
		AC = SPIDQSR;
		IF NOT CALLI (AC, GETTAB) THEN
			MSGERROR (CH$PTR(PLIT (%ASCIZ
			 'Cannot get QUASARs PID')),'CQP' OR S$SEVERE);
		QSRPID = .AC;		!Save QUASAR's ID
		IF .AC NEQ 0 THEN EXITLOOP;
		%IF FTNETSPL
		 %THEN ERROR(QSRNRN);
		 %ELSE
		 AC = 3;
		 CALLI (AC, SLEEP);
		 IF (FLAG = .FLAG + 1) NEQ 0 THEN
			MSGERROR (CH$PTR(PLIT (%ASCIZ
			 'RMCOPY Waiting for [SYSTEM]QUASAR to start')),
			 'WFQ' OR S$WARN);
		  %FI
		END;

!Now we know where to send messages so they will get to QUASAR.

	IPCFBLK [IPCF$RECV_PID] = .QSRPID;
	IPCFBLK [IPCF$MSG_ADR] = .MSGADR;
	IPCFBLK [IPCF$MSG_LEN] = .MSGADR [QSR$MS_CNT];	!Assume non-paged length
	IF .PAGEFLG NEQ 0 THEN
	BEGIN
		IPCFBLK [IPCF$PAGE_PACK] = 1;
		IPCFBLK [IPCF$MSG_LEN] = %O'1000';
		IPCFBLK [IPCF$MSG_ADR] = .IPCFBLK [IPCF$MSG_ADR] / %O'1000'
	END;
	WHILE 1 DO
	BEGIN
		AC<LH> = IPCF$HEADER_LEN;
		AC<RH> = IPCFBLK;
		IF CALLI (AC, IPCFS_) THEN RETURN;
		IF (.AC NEQ IPCDD) AND
			 (.AC NEQ IPCRS) AND
			 (.AC NEQ IPCRR) AND
			 (.AC NEQ IPCRY) THEN
			MSGERROR(CH$PTR(PLIT(%ASCIZ
			 'Send to [SYSTEM]QUASAR failed')),'SQF' OR S$SEVERE);
		%IF FTNETSPL EQL 0
		 %THEN
		 AC = 2;
		 CALLI (AC, SLEEP);
		 MSGERROR (CH$PTR(PLIT(%ASCIZ
		  'RMCOPY Send has failed, message being re-sent')),
		  'SQR' OR S$WARN)
		 %FI
	END
END;

GLOBAL ROUTINE GETPAG=			!Returns number of next free
				!page NOT in adress space
				!This routine is NOT reentrant
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	The contents of .JBREL
!
! IMPLICIT OUTPUTS:
!
!	If ALLOC & FREE are being used (FTALLOC, /Variant:#4000)
!	.JBFF is pointed past the free page we are returning so
!	the page will not end up multiply-allocated and
!	any space between the old value of .JBFF and the page is FREE'ed
!
! ROUTINE VALUE:
!
!	The number of the next free page which is not addressable
!
! SIDE EFFECTS:
!
!	NONE
!
!--
BEGIN

%IF FTALLOC %THEN
LOCAL	F,		!Address of hole we are about to make
	L;		!Length
EXTERNAL ROUTINE FREE;
F=.JBFF;		!Save 'Old' value of .JBFF
L=(.JBREL-.JBFF)+1;	!Length of hole

JBFF=.JBREL+%O'1001';	!Mark the page 'in-use'

IF .L GTR 0 THEN FREE(.F,.L); !Free the hole between old .JBFF and the page
%FI

(.JBREL + %O'777') / %O'1000'
END;

GLOBAL ROUTINE PAGCRE (PAGNUM) =
!++
! FUNCTIONAL DESCRIPTION:
!	Places the page 'pagnum' 
!	in the job's address space
!	This routine tries to create the page in core.
!	If we can't create it in core, we try to create it on the swap space
!
! FORMAL PARAMETERS:
!
!	PAGNUM - The number of the page which is to be included in the address space
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	The page is rendered addressable
!
! ROUTINE VALUE:
!
!	0==> The page cannot be had (ie core limits or CORMAX or VIRTAL exceeded)
!	1==> The page is now addressable
!
! SIDE EFFECTS:
!
!	NONE
!
!--
BEGIN
	REGISTER AC;			!For the UUO
	LOCAL PAGEBLOCK:VECTOR [LSTLEN + 1]; !Space for the count, and the request

	PAGEBLOCK [0] = LSTLEN;
	PAGEBLOCK [1] = .PAGNUM;	!Bits 0, 1 are zero...
					!create page, in working set
	DECR I FROM 1 TO 0 DO		!Try in WS, then try on DSK, then quit
	BEGIN
		AC<LH> = _PAGCD;	!Function create/destroy
		AC<RH> = PAGEBLOCK;	!Point to arg list
		IF CALLI (AC, PAGE_) THEN RETURN 1;
		PAGEBLOCK [1] = .PAGEBLOCK [1] OR PAG_DSK;	!Set to try not in Working set
	END;
	RETURN 0;			!Can't have a page
END;

GLOBAL ROUTINE NEWPAG=			!Returns the adrs of a new, adressable page
!++
! FUNCTIONAL DESCRIPTION:
!	This routine combines the functionality of GETPAG and PAGCRE
!	Adds one page to the address space and returns its address.
!	Note that 2 consecutive calls to this routine may not return
!	2 consecutive pages.  This can happen if some calls to PAGDES have been made
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	See GETPAG
!
! IMPLICIT OUTPUTS:
!
!	See PAGCRE
!
! ROUTINE VALUE:
!
!	>=0, that's the address of the new page
!	-1, No free pages can be had
!
! SIDE EFFECTS:
!
!	NONE
!
!--
BEGIN
	LOCAL PAGNUM;			!Holds data across routine calls
	PAGNUM = GETPAG();		!Find a free one
	IF PAGCRE(.PAGNUM) THEN .PAGNUM * %O'1000' ELSE -1
END;

GLOBAL ROUTINE PAGDES(ADRS) =			!Destroy the page whose address is ADRS
!++
! FUNCTIONAL DESCRIPTION:
!	This routine is used to return a page to the monitor.  It is useful
!	for cleanup after some series of IPCF receives has been done,
!	and the data received has been processed.
!
! FORMAL PARAMETERS:
!
!	The address of the first word of the page to be destroyed (ie nnn000)
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	0==> the address is not a page bound, or the UUO failed.
!	1==> the page is gone. (all is ok)
!
! SIDE EFFECTS:
!
!	The job's address space size is reduced by one page
!
!--
BEGIN
	REGISTER AC;			!For the UUO

	LOCAL PAGBLK:VECTOR [LSTLEN + 1]; !a counted list of pages

	IF (.ADRS AND %O'777') NEQ 0 THEN RETURN 0;
	PAGBLK [0] = LSTLEN;		!Count the args
	PAGBLK [1] = PAG_DES + (.ADRS / %O'1000'); !Aim at the desired page
					! ... and set the 'destroy page bit'
	AC<LH> = _PAGCD;		!Function create/destroy
	AC<RH> = PAGBLK;		!Point to arg list
	IF CALLI (AC, PAGE_) THEN 1 ELSE 0
END;

GLOBAL ROUTINE LISTEM(QNAM, SERVROUT):NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!	This routine gets information from QUASAR about
!	a specified Q.  QUASAR returns information about the entries packed
!	contiguously on a series of pages. This routine first requests
!	QUASAR to list the Q by sending a LIST message to QUASAR.
!	The routine then receives all the pages containing all the entries.
!	The answer pages are sequence numbered by QUASAR in the
!	count field of the header word.  Since the pages may arrive in
!	any order, QUASAR will set the ACK (sign) bit on the message
!	with the highest sequence number.
!	This routine builds a linked, ordered list of the answer pages
!	by using the TYP field of the header word.  (That field always
!	contains the code for the LIST ANSWER message type).
!	When all the answer pages have been retrieved, the routine
!	flips thru all pages, examining all entries on each page.
!	For each entry, the listing routine is called with a pointer
!	to the entry.
!
! FORMAL PARAMETERS:
!
!	QNAM - The SIXBIT name of the Q to list (0 ==> all Queues)
!	SERVROUT - The address of the service output routine which must
!		take one parameter (the address of a LIST ANSWER entry).
!		This routine is responsible for decoding and listing each entry
!
! IMPLICIT INPUTS:
!
!	The contents of the specified Q at the time of the call.
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	The Job's address space may temporarily increase if there are
!	many entries in the Q.
!
!--
BEGIN
	LOCAL LIST_REQ:QSR$MSG_LIST;	!For the request
	LOCAL NUMANS;			!Will hold highest message number
	LOCAL NUMREC;			!Counts the number of messages received
	LOCAL M:REF QSR$HEADER;		!Points to the page just rec'd
	LOCAL FSTMSG:REF QSR$HEADER;	!Start of linked page answer list
	LOCAL THISMSG:REF QSR$HEADER;	!For chaining the pages
	LOCAL PREVMSG:REF QSR$HEADER;	!Also for linking entries
	LOCAL THISENT:REF QSR$MSG_LANSW; !Used to ref each Q entry on an answer page
	LOCAL IPCBLK:IPCF_HEADER;	!For waiting, receiving
	REGISTER S2;			!For the receive UUO

	CLEARV(LIST_REQ,IPCBLK);	!Zero these first
	LIST_REQ [QSR$MSTYP] = 0;	!Start w/clean header
	LIST_REQ [QSR$MS_ACK] = 1;	!We want an ack
	LIST_REQ [QSR$MS_CNT] = QSR$LIST_SIZE; !Our size
	LIST_REQ [QSR$MS_TYP] = QSR$MS_LIST; !The code for LIST
	LIST_REQ [QSR$LIST_QNAM] = .QNAM; !Set the Q we want to see
	%IF FTIPC %THEN
		BEGIN
		BIND LRDB = LIST_REQ [QSR$LIST_RDB]: QSR$RDB;
		LRDB [QSR$RDB_DEV] = .QNAM;	!Twice for IPC
		END %FI;
	MSGSND (LIST_REQ, 0);		!Send the request
	RCVACK();			!Wait for ack (we asked for it...
					!... we got it !)

	NUMANS = 0;			!No max is known yet
	NUMREC = 0;			!And none have been received yet, either
	FSTMSG = 0;			!Nothing on the list, either

	DO
	BEGIN
	!Recevive a page
		QUEWAT (IPCBLK);	!Wait for a fish to come by...
		ZERO (IPCBLK, IPCBLK + IPCF$HEADER_LEN - 1);
		IPCBLK [IPCF$PAGE_PACK] = 1; !These messages are always pages
		IPCBLK [IPCF$MSG_LEN] = %O'1000';
		IPCBLK [IPCF$MSG_ADR] = GETPAG(); !Find a free slot.
!	NOTE: If anyone else calls GETPAG before we do the IPCF receive,
!	they, too, will get our page.  Interrupts should be turned off
!	over the interim.
		S2<LH> = IPCF$HEADER_LEN;
		S2<RH> = IPCBLK;
		IF NOT CALLI (S2, IPCFR_) THEN
			MSGERROR (CH$PTR(PLIT(%ASCIZ
			 'List answer receive from SYSTEM[QUASAR] failed'
			 )),'LQF' OR S$SEVERE);
		NUMREC = .NUMREC + 1;
	!Link it to list of answers
		M = .IPCBLK [IPCF$MSG_ADR] * %O'1000'; !Aim at the page to be inserted
		PREVMSG = 0;			!No known predecessor
		THISMSG = .FSTMSG;		!Start looking at the head of the list
		WHILE .THISMSG NEQ 0 DO
		IF .M [QSR$MS_CNT] GEQ .THISMSG [QSR$MS_CNT]
			THEN
			BEGIN			!Doesn't go here, try next entry
				PREVMSG = .THISMSG;
				THISMSG = .THISMSG [QSR$MS_TYP]
			END
			ELSE			!Does go here, quit now
				EXITLOOP;

		M [QSR$MS_TYP] = .THISMSG;	!Point us at the rest of the list
		!Point the first part of the list at us
		(IF .PREVMSG EQL 0 THEN
			FSTMSG			!Goes at the head of list
			ELSE
			PREVMSG [QSR$MS_TYP]	!Goes in the middle of list
			) = .M;
	!check for last message
		IF .M [QSR$MS_ACK] NEQ 0 THEN
		BEGIN
			M [QSR$MS_ACK] = 0;
			NUMANS = .M [QSR$MS_CNT]
		END;
	END
	UNTIL .NUMREC EQL .NUMANS;

	!Now we have all the answer pages read in and linked in increasing order
	!So we just aim at each Q entry, and give it to the output processor

	THISMSG = .FSTMSG;			!Start at the begining
	!Do all pages
	DECR I FROM .NUMANS TO 1 DO
	BEGIN
		!Do all entries on this page
		THISENT = (.THISMSG) + QSR$LANSW_FIRST; !Point at the first on this page
		DECR I FROM QSR$LANSW_APP TO 1 DO
		BEGIN				!List one entry
			IF .THISENT [QSR$LANSW_JOB] EQL 0
				THEN EXITLOOP;	!Quit at end of list (0 JOBNAME)
			(.SERVROUT)(.THISENT);	!Call the output routine
			THISENT = (.THISENT) + QSR$LANSW_SIZE; !Point to the next
		END; !Of loop for all entries on a page
		THISMSG = .THISMSG [QSR$MS_TYP]; !Link to the next page
	END; !Of loop for all pages
!Now return the list pages to the monitor
	WHILE .FSTMSG NEQ 0 DO
	BEGIN
		THISMSG = .FSTMSG [QSR$MS_TYP];	!Remember next page adrs
		PAGDES (.FSTMSG);		!Kill this page
		FSTMSG = .THISMSG;		!Link to next
	END;
END; !Of the LISTEM routine

GLOBAL ROUTINE WRPPNA (VAL, PTR):NOVALUE=
!++
! FUNCTIONAL DESCRIPTION:
!	This routine converts a 36 bit ppn pattern to ASCII
!
! FORMAL PARAMETERS:
!
!	VAL - The left half has the project number, right half has programmer number
!	PTR - The address of a char-seq-ptr.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	The converted ppn is written into the space aimed at by the PTR
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	The pointer at the address PTR is advanced
!
!--
BEGIN
	CH$WCHAR_A(%C'[',.PTR);
	WRNUMA (.VAL<LH>, 8, .PTR);
	CH$WCHAR_A(%C',', .PTR);
	WRNUMA (.VAL<RH>, 8, .PTR);
	CH$WCHAR_A (%C']', .PTR);
END;

ROUTINE WR2DEC (NUMBER, PTRADR) :NOVALUE =		!

!++
! FUNCTIONAL DESCRIPTION:
!	Writes at least 2 decimal digits
!
! FORMAL PARAMETERS:
!
!	NUMBER - The bit pattern to be converted
!	PTRADR - Adrs of a CH$PTR where the digits will be written
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	The number is written at ..PTRADR
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	The pointer at PTRADR is advanced
!
!--

BEGIN
	IF .NUMBER LSS 10 THEN CH$WCHAR_A (%C'0', .PTRADR);
	WRNUMA (.NUMBER, 10, .PTRADR);
END;

ROUTINE WRTIME (TIMWRD, PTRADR) :NOVALUE =		!Universal date-time converter
!++
! FUNCTIONAL DESCRIPTION:
!	This routine takes a universal date-time word (lh has days..
!	 rh has fractional days)  and prints days (if any), hours, and
!	 minutes into the buffer pointed to by PTRADR
!
! FORMAL PARAMETERS:
!
!	TIMWRD - the universal date-time word
!	PTRADR -  the address of a CH$PTR where the output will go
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	The characters are written using the PTRADR
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	The pointer in PTRADR is advanced
!
!--

BEGIN
	LOCAL HOURS,		!Eventually holds hours for printout
		MINS;		!Holds minutes

	IF .TIMWRD <LH> NEQ 0 THEN
		(WRNUMA (.TIMWRD <LH>, 10,.PTRADR);
		 CH$WCHAR_A (%C'd', .PTRADR));
	TIMWRD = (.TIMWRD <RH> * 60 * 24) / %O'1000000';
	HOURS = .TIMWRD / 60;
	MINS = .TIMWRD MOD 60;
	WR2DEC (.HOURS, .PTRADR);
	CH$WCHAR_A (%C':', .PTRADR);
	WR2DEC (.MINS, .PTRADR)
END;

GLOBAL ROUTINE LISTON(ADR)=
!++
! FUNCTIONAL DESCRIPTION:
!	This routine is called once for each Q entry to list it on the
!	user's terminal.
!	It's address is passed by QFUNC to LISTEM, and LISTEM actually calls it.
!
! FORMAL PARAMETERS:
!
!	ADR - The address of a LISTANSWER message from QUASAR
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	The converted data is written on the user's terminal
!	The flags LSTANY and the counter LSTTJL (Total Jobs Listed)
!	are modified by the routine.
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--
BEGIN
	MACRO SPACE(N) = PTR = CH$FILL(%C' ',N,.PTR) %;
	MAP ADR:REF QSR$MSG_LANSW;
	LOCAL LINE:BLOCK[CH$ALLOCATION(150)];
	LOCAL PTR,				!REF to LINE
		PTIME;				!Holds the time job will run
!	OWN LISTARG;				!Initialized by QFUNC
						!Holds 0 (match any ppn)
						!... or p,pn (match this ppn only)
!	OWN LSTANY;				!Flag that we considered any jobs
!	OWN LSTTJL;				!Count of total # listed

	LSTANY = -1;				!Note that we were given a job
	IF (.LISTARG EQL 0) OR (.LISTARG EQL .ADR [QSR$LANSW_OWN]) THEN
	BEGIN
		IF .LSTTJL EQL 0 THEN		!This is the first, add a header
			MSGERROR (CH$PTR (UPLIT (%ASCIZ
'Node    Job     Function   Seq   Limit   PPN        Name       After')), S$MSGCRLF);
		LSTTJL = .LSTTJL + 1;		!We got a job, and it matched spec, so count it
		PTR = CH$PTR(LINE);
		UNSIX6 (%REF (CH$PTR (ADR [QSR$LANSW_NODE], 0, 6)), PTR);
		PTR = CH$MOVE (1,
				CH$PTR ((IF .ADR [QSR$LANSW_PRDEV] NEQ 0
					THEN UPLIT (%ASCII '*')
					ELSE UPLIT (%ASCII ' '))),
				.PTR);
		SPACE (1);
		UNSIX6 (%REF (CH$PTR (ADR [QSR$LANSW_JOB], 0, 6)), PTR);
		SPACE(2);
		PTR = CH$MOVE (9,
				CH$PTR (SELECTONE .ADR [QSR$LANSW_FUNC] OF SET
				[RMC$F_SEND]:	PLIT(%ASCII 'Send     ');
				[RMC$F_GET]:	PLIT(%ASCII 'Retrieve ');
				[RMC$F_REN]:	PLIT(%ASCII 'Rename   ');
				[RMC$F_DEL]:	PLIT(%ASCII 'Delete   ');
				[RMC$F_DI]:	PLIT(%ASCII 'Directory');
				[OTHERWISE]:	PLIT(%ASCII 'Illegal  ');
				TES),
				.PTR);
		SPACE (2);
		WRNUMA (.ADR [QSR$LANSW_SEQ], 10, PTR);
		SPACE (2);
		WRNUMA (.ADR [QSR$LANSW_LIMIT], 10, PTR);
		SPACE (2);
		WRPPNA (.ADR [QSR$LANSW_OWN], PTR);
		SPACE (2);
		UNSIX6 (%REF (CH$PTR (ADR [QSR$LANSW_USER], 0, 6)), PTR);
		UNSIX6 (%REF (CH$PTR (ADR [QSR$LANSW_USER2], 0, 6)), PTR);
		SPACE (2);
		IF (PTIME = .ADR [QSR$LANSW_AFTER] - .G$NOW) GTR 0
			THEN WRTIME (.PTIME, PTR);
		CH$WCHAR_A(0,PTR);
		MSGERROR (CH$PTR(LINE),S$MSGCRLF);
	IF .G$DBUG THEN
	    BEGIN
		PTR = CH$PTR(LINE);
		SPACE(2);
		WRNUMA (.ADR [QSR$LANSW_PRO], 8, PTR);
		SPACE(2);
		WRSIXA (.ADR [QSR$LANSW_DEV], PTR);
		SPACE (2);
		WRSIXA (.ADR [QSR$LANSW_STR], PTR);
		SPACE (2);
		WRNUMA (.ADR [QSR$LANSW_PRIO], 10, PTR);
		SPACE (2);
		WRNUMA (.ADR [QSR$LANSW_OPT], 8, PTR);
		SPACE(2);
		SPACE (2);
		IF .ADR [QSR$LANSW_RTS] NEQ 0 THEN
			WRSIXA (.ADR [QSR$LANSW_RTS], PTR);
		CH$WCHAR_A(0,PTR);
		MSGERROR (CH$PTR(LINE),S$MSGCRLF);
	   END;	!Of debugging stuff
	END;
END;

GLOBAL ROUTINE KILLR (ARG, PPN, ARGTYPE):NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!	This routine is called to kill one or more jobs from the Q
!	The routine may kill by jobname or by sequence number.
!	A PPN may be specified if the request to be killed is not our own.
!
! FORMAL PARAMETERS:
!
!	ARG - either a job number or a SIXBIT job name.
!	PPN - 0==> kill for our ppn only (this is defaulted in QUASAR).
!		.NE. 0 ==> this is a P,PN pair, try to kill for this user
!	ARGTYPE - either QFN$JOB or QFN$SEQ. This arg describes the ARG
!
! IMPLICIT INPUTS:
!
!	The contents of the Q.
!
! IMPLICIT OUTPUTS:
!
!	The entry is removed from the Q, a message is typed on the user's terminal
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--
BEGIN
	LOCAL KILLBL: QSR$MSG_KILL;
	LOCAL KRDB: REF QSR$RDB;

	CLEARV(KILLBL);				!Start out clean
	KILLBL [QSR$MS_ACK] = 1;		!We want an ack
	KILLBL [QSR$MS_CNT] = QSR$KILL_SIZE;	!Set up header w/size, type
	KILLBL [QSR$MS_TYP] = QSR$MS_KILL;
	KILLBL [QSR$KILL_QNAM] = NETQNAM;	!We only kill things from the NET

	KRDB = KILLBL + QSR$KILL_RDB;		!Aim at the RDB part of the message
	%IF FTIPC
	  %THEN KRDB [QSR$RDB_DEV] = NETQNAM;	!Set twice for IPC
	  %FI
	KRDB [QSR$RDB_PPN] = .PPN;		!Supply the ppn
	KRDB [QSR$RDB_PPNMSK] = -1;		!Don't wildcard PPN
	IF (.ARGTYPE EQL QFN$JOB) OR
	   (.ARGTYPE EQL QFN$JOBPPN)
		THEN BEGIN			!Wants to kill by jobname
			KRDB [QSR$RDB_JOB] = .ARG; !Set the jobname
			KRDB [QSR$RDB_JOBMSK] = -1;  !And don't do any wildcarding
		END
		ELSE				!Wants to kill by sequence
			KRDB [QSR$RDB_SEQ] = .ARG; !Set the sequce number

	MSGSND (KILLBL, 0);			!Send the kill request (0==>non-paged)
	RCVACK();				!Wait for the ack, print results
END;

GLOBAL ROUTINE PPN (CHPTR) =
!++
! FUNCTIONAL DESCRIPTION:
!	This routine converts an ASCiz string to a LH,RH ppn word
!
! FORMAL PARAMETERS:
!
!	PTR - a char-seq-ptr to the ASCIZ string
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	The 36 bit ppn word
!
! SIDE EFFECTS:
!
!	NONE
!
!--
BEGIN
	LOCAL RESULT;
	RESULT = 0;
	RESULT<LH> = RDNUMA (CHPTR, 8);
	IF CH$RCHAR_A(CHPTR) EQL %C',' THEN RESULT<RH> = RDNUMA (CHPTR, 8);
	.RESULT
END;

GLOBAL ROUTINE QFUNC (FUNC, PARAMTYPE, PARAMPTR, PARAMPTR2) =
!++
! FUNCTIONAL DESCRIPTION:
!	This is the entry point for the system-dependent Q lister and killer
!	functions.
!
!
! FORMAL PARAMETERS:
!
!	FUNC - either QFN$LIST or QFN$KILL
!	PARMATYPE - describes the type of string aimed at by the PARAMPTR
!	PARAMPTR - pointer to an ASCIZ string
!		LIST can take QFN$NONE (list all entries) or QFN$PPN (list all
!			entries for that ppn), or
!			QFN$SELF (list all entries for my ppn).
!		KILL can take QFN$SEQ (kill just that sequnce number)
!			or QFN$JOB (kill all jobs with that jobname).
!			QFN$JOBPPN or QFN$SEQPPN may also be specified, to 
!			kill by job or sequence for another user.
!	PARAMPTR2 - a pointer to an ASCIZ p,pn string.  This parameter is
!		ignored if the PARAMTYPE is not QFN$JOBPPN or QFN$SEQPPN.
!
! IMPLICIT INPUTS:
!
!	The contents of the Q
!
! IMPLICIT OUTPUTS:
!
!	A message (or a list of entries) is typed on the user's terminal
!	For KILL, one or several jobs may be removed from the Q
!
! ROUTINE VALUE:
!
!	See RMCOPY.REQ for return values.
!
! SIDE EFFECTS:
!
!	NONE
!
!--
SELECTONE .FUNC OF SET
[QFN$LIST]:
	BEGIN
!		OWN LISTARG;			!Used by LISTON
!		OWN LSTANY,LSTTJL;		!Used by LISTON
		QUEFLS();			!Make sure theres nothing in the Q
		LSTANY = LSTTJL = 0;		!Clear flag, and count
		SELECTONE .PARAMTYPE OF SET
		[QFN$PPN]:	LISTARG = PPN (.PARAMPTR);
		[QFN$NONE]:	LISTARG = 0;
		[QFN$SELF]:	BEGIN
					REGISTER AC;
					CALLI (AC, GETPPN);
					LISTARG = .AC
				END;
		[OTHERWISE]:	RETURN QFN$ILP;
		TES;

		LISTEM (NETQNAM,LISTON);	!List the NETQ entries via routine LISTON

		IF .LSTANY EQL 0 THEN MSGERROR (CH$PTR (UPLIT
			(%ASCIZ 'The Queue is empty')), S$COMMENT)
			ELSE IF .LSTTJL EQL 0 THEN
				MSGERROR (CH$PTR (PLIT (%ASCIZ
				 'No jobs match specification')),S$COMMENT)
			ELSE BEGIN
				LOCAL NUM:BLOCK[CH$ALLOCATION(12)];
				LOCAL T;
				MSGERROR (CH$PTR (PLIT (%ASCIZ
				 'Total of ')),S$CRLFMSG);
				T = CH$PTR(NUM);
				WRNUMA (.LSTTJL, 10, T);
				CH$WCHAR_A(0,T);
				MSGERROR (CH$PTR(NUM), S$MSG);
				MSGERROR (CH$PTR (PLIT (%ASCIZ
				 ' jobs in the Queue')),S$MSGCRLF);
			END;
		RETURN QFN$OK;
	END;

[QFN$KILL]:
	BEGIN
		LOCAL KILLARG, KILLPPN;
		QUEFLS();			!Make sure theres nothing in the Q
		SELECTONE .PARAMTYPE OF SET
		[QFN$JOB, QFN$JOBPPN]:	KILLARG = RDSIX (PARAMPTR);
		[QFN$SEQ, QFN$SEQPPN]:	KILLARG = RDNUMA (PARAMPTR, 10);
		[OTHERWISE]:	RETURN QFN$ILP;
		TES;
		KILLPPN = (IF (.PARAMTYPE EQL QFN$JOBPPN) OR
				(.PARAMTYPE EQL QFN$SEQPPN)
				THEN PPN (.PARAMPTR2)
				ELSE 0);
		KILLR (.KILLARG, .KILLPPN, .PARAMTYPE);
		RETURN QFN$OK;
	END;

[OTHERWISE]:	RETURN QFN$ILF;
TES;

GLOBAL ROUTINE CREAT (RB_PTR) =		!Make an entry in QUASAR's Queue

!++
! FUNCTIONAL DESCRIPTION:
!	This routine converts a 'transportable' RMC request block to
!	an IPCF-able packet message for QUASAR's NET queue.  It fills in
!	some defaults, but generally is just a request translator
!
! FORMAL PARAMETERS:
!
!	A pointer to an RMC request block (see XXXXXX.REQ for details)
!
! IMPLICIT INPUTS:
!
!	The running job number, %%.QSR, RMC version
!
! IMPLICIT OUTPUTS:
!
!	An entry in the NET queue
!
! ROUTINE VALUE:
!
!	less than zero is an error
!	See RMCOPY.REQ for details
!
! SIDE EFFECTS:
!
!	Some of the data in the request block (eg pointers) may be modified
!
!--

BEGIN
	MAP RB_PTR:REF SD_RMCBLK;	!the kind of block we're given a ptr to

	LITERAL _GTNM1 = %O'31',	!GETTAB Table numbers for user names
		_GTNM2 = %O'32';
	LOCAL CRE_PTR:REF QSR_EQ;	!Points to the page in which we build
					!the EQ create message
	LOCAL ERRCODE;			!For passing errors back up to caller
	REGISTER AC;			!For the PJOB UUO

	IF (CRE_PTR = NEWPAG()) LSS 0 THEN
		RETURN CRE$NFP;		!Lose quickly, no space left
	ZERO (.CRE_PTR, %O'1000'-1);	!Start with a clean slate

	!Set up the header of the page
	CRE_PTR [QSR$MS_ACK] = 1;	!We will want an ack
	CRE_PTR [QSR$MS_TYP] = QSR$MS_CREATE; !We are doing a create
	CRE_PTR [QSR$MS_CNT] = QSR$EQ_SIZE; !Minimum length, files included
					    !later
	!... header set up for now,
	!  ... start filling in the body

	CRE_PTR [QSR$EQ_VERS] = QSRVER; !Fill in the version we know about
	CRE_PTR [QSR$EQ_LENGTH] = QSR$EQ_SIZE; !Note size of EQ
	CRE_PTR [QSR$EQ_DEVICE] = NETQNAM; !We make entries in the NET Q only
	IF .RB_PTR [SD$CNT_JOB] NEQ 0 THEN	!If there is a job name, then
	   CRE_PTR [QSR$EQ_JOBNAME] = RDSIX (RB_PTR [SD$PTR_JOB]); !Pick up job name
	CRE_PTR [QSR$EQ_NUMFIL] =	!Set the number of files which follow
		(SELECTONE .RB_PTR [SD$RMCFUN] OF SET
			[RMC$F_DEL]:			1;!Delete
			[RMC$F_SEND TO RMC$F_DI]:	2;!Send, get, rename, dir
			[OTHERWISE]:		(PAGDES (.CRE_PTR);
						RETURN CRE$ILF)!No others known
			TES) +		!... perhaps a logfile follows too
		(IF .RB_PTR [RMC$O_CODE] NEQ 0 THEN 1 ELSE 0);
	CRE_PTR [QSR$EQ_PRIOR] = .RB_PTR [SD$PRIOR];	!Copy the priority
	CRE_PTR [QSR$EQ_AFTER] = .RB_PTR [SD$AFTER];	!include AFTER time
	CRE_PTR [QSR$EQ_NODE] = RDSIX (RB_PTR [SD$PTR_RNOD]);	!Remote node name
	CRE_PTR [QSR$EQ_RJOB] = (CALLI (AC, PJOB); .AC);	!Requstor's job #
	CRE_PTR [QSR$EQ_FUNC] = .RB_PTR [SD$RMCFUN];		!Function code
	CRE_PTR [QSR$EQ_RMCVER] = .RB_PTR [SD$RMCVER];		!RMCOPY version #
	CRE_PTR [QSR$EQ_LIMIT] = .RB_PTR [SD$LIMIT];		!The limit (blocks)
	CRE_PTR [QSR$EQ_OPTIONS] = .RB_PTR [SD$RMCOPT];		!Option bits
	!And the 4 protection feilds
	CRE_PTR [QSR$EQ_RPROT_SY] = .RB_PTR [SD$SYSPROTECT];
	CRE_PTR [QSR$EQ_RPROT_OW] = .RB_PTR [SD$OWNPROTECT];
	CRE_PTR [QSR$EQ_RPROT_GR] = .RB_PTR [SD$GRPPROTECT];
	CRE_PTR [QSR$EQ_RPROT_WO] = .RB_PTR [SD$WORPROTECT];
	IF .RB_PTR [RMC$O_RTS] NEQ 0 THEN
		CRE_PTR [QSR$EQ_RUNSYS] = RDSIX (RB_PTR [SD$PTR_RTS]);
	CALLI (AC, GETPPN);			!Find our ID
	CRE_PTR [QSR$EQ_OWNER] = .AC;		!Store it
	AC<LH> = -1;				!Aim at our job
	AC<RH> = _GTNM1;
	CALLI (AC, GETTAB);			!Get first half of name
	CRE_PTR [QSR$EQ_USER] = .AC;
	AC<LH> = -1;				!Aim at our job
	AC<RH> = _GTNM2;
	CALLI (AC, GETTAB);			!Get second half of name
	CRE_PTR [QSR$EQ_USER2] = .AC;

	!Now we have finished all the data that goes in the EQ
	!So we have to tack on the 1, 2, or 3 file descriptor blocks

!Function	Local file	Remote file	Log file	Min #	Max #
!								files	files
!SEND		req'd *		req'd		optional *	2	3
!RETR		req'd *		req'd		optional *	2	3
!REN		req'd %		req'd		optional *	2	3
!DEL		error		req'd		optional *	1	2
!DIR		req'd *		req'd		optional *	2	3
!
!Notes:	*) This file's structure must be online at schedule time
!	%) This file has the remote DAP code (ie it is a remote file)
!	-The local file is always added to the request block first. (except DEL)
!	-The remote is always next,
!	-the Log file (if requested) is last, with the FP.FLG bit lit

	!First, the local file spec.
	IF .RB_PTR [SD$RMCFUN] NEQ RMC$F_DEL THEN
	IF (ERRCODE =
 	ADDFILE (.CRE_PTR,
		.RB_PTR [SD$PTR_REN],
		.RB_PTR [SD$CNT_REN],
		(IF .RB_PTR [SD$RMCFUN] EQL RMC$F_REN THEN
			.RB_PTR [SD$RDAP_NOD] ELSE
			.RB_PTR [SD$LDAP_NOD]),
		0,			!This is not a log file
		(IF .RB_PTR [SD$RMCFUN] EQL RMC$F_REN THEN 0 ELSE 1)))
		NEQ CRE$OK THEN (PAGDES (.CRE_PTR); RETURN .ERRCODE);

	!Then, always, add the remote file spec
	IF (ERRCODE =
	ADDFILE (.CRE_PTR,
		.RB_PTR [SD$PTR_RMT],
		.RB_PTR [SD$CNT_RMT],
		.RB_PTR [SD$RDAP_NOD],
		0,
		0))
		NEQ CRE$OK THEN (PAGDES (.CRE_PTR); RETURN .ERRCODE);

	!And, if specified, add the log file
	IF .RB_PTR [RMC$O_CODE] NEQ 0 THEN
	IF (ERRCODE =
	ADDFILE (.CRE_PTR,
		.RB_PTR [SD$PTR_LOG],
		.RB_PTR [SD$CNT_LOG],
		.RB_PTR [SD$LDAP_NOD],
		1,
		1))
		NEQ CRE$OK THEN (PAGDES (.CRE_PTR); RETURN .ERRCODE);

	!The page message has been built, so let's send it off!
	MSGSND (.CRE_PTR, 1);			!Send to QUASAR
	RCVACK ();				!See what he has to say about it
	RETURN CRE$OK;

END;

GLOBAL ROUTINE ADDFILE (PAGE, FILE_PTR, FILE_COUNT, DAP_CODE, LOG_FLAG, ONLINE_FLAG)=
!++
! FUNCTIONAL DESCRIPTION:
!	This routine will add a file specification to the end of a
!	QUASAR-bound create message.  The QSR$MS_CNT field of the
!	header must reflect the current length of the message.
!	This routine adds an FP area (file parameters), including our
!	DAP code, log file flag, and online flag.
!	It also adds an FD area, which is parsed into a normal -10
!	FD area, if the DAP code indicates it is a -10 spec.
!	If it is not a -10 spec, then FD is added as
!	an ASCIZ string, just like a -20 FD.
!	In any case, both the FP and FD lengths are put in the
!	length word of the FP header, and their sum is added to the
!	QSR$MS_CNT field.
!
! FORMAL PARAMETERS:
!
!	PAGE - The address of a page which has been partially
!		set up as a QUASAR CREATE message
!	FILE_PTR - a CH$PTR to an ASCIZ string describing the file
!	FILE_COUNT - The number of characters in FILE_PTR excluding the null
!	DAP_CODE - The DAP file system code (-10, RSX, -20, etc)
!	LOG_FLAG - If non-zero, indicates this is the log file
!	ONLINE_FLAG - If non-zero, this file's structure must be online
!		in order to service this request (ie this file does or will live
!		on the local system.
!
! IMPLICIT INPUTS:
!
!	The QSR$MS_CNT field must be accurate at time of call
!
! IMPLICIT OUTPUTS:
!
!	An FP and FD with DAP code, log file bit, online bit, are added
!	to the page.  QSR$MS_CNT is updated.
!	If DEBUG, then the file is typed on the TTY.
!
! ROUTINE VALUE:
!
!	If non-zero, there was an error (parsing, room in the block)
!	See RMCOPY.REQ under CREAT for complete details
!
! SIDE EFFECTS:
!
!	NONE
!
!--

BEGIN

	MAP PAGE: REF QSR_EQ;

	LOCAL FP: REF QSR$FP;
	LOCAL FD: REF QSR$FD;
	LOCAL FB: FILE_BLOCK;			!Space into which we parse
						!-10 filespecs

!	First, build the FP area
	FP = .PAGE + .PAGE [QSR$MS_CNT];	!Aim past the end
	FP [QSR$FP_FPSZ] = QSR$FP_SIZE;		!Mark our little header length
	PAGE [QSR$MS_CNT] = .PAGE [QSR$MS_CNT] + QSR$FP_SIZE;	!Note it up top too
	FP [QSR$FP_DAP] = .DAP_CODE;		!Note the system type
	IF .LOG_FLAG NEQ 0 THEN			!Is this the log file?
		FP [QSR$FP_FLG] = 1;		!Yes, mark the log bit
	IF .ONLINE_FLAG NEQ 0 THEN		!If this file should be online,
		FP [QSR$FP_NFH] = 1;		!Yes, mark it.
!	Then add on the FD area
	FD = .PAGE + .PAGE [QSR$MS_CNT];	!Aim at the FD to be added

	IF .G$DBUG THEN
	    BEGIN
		MSGERROR (CH$PTR (UPLIT (%ASCIZ 'Next file: ')), S$MSG);
		MSGERROR (.FILE_PTR, S$MSG);
		MSGERROR (CH$PTR ((IF .ONLINE_FLAG NEQ 0
					THEN UPLIT (%ASCIZ ' On-line')
					ELSE UPLIT (%ASCIZ ' Remote'))),
					S$MSGCRLF);
	    END;	!Of debugging stuff

	IF .ONLINE_FLAG NEQ 0 THEN		!If this file is local, then
	BEGIN					!... Parse it into SIXBIT
		FBINI (FB);
		FB [FILE$PF_NODE_A] = 0;
		IF FPARSE (FB, FILE_PTR) NEQ WIN THEN
			BEGIN
				RELEASE (FB);
				RETURN CRE$PERR
			END;
		IF ((FD [QSR$FD_STR] = .FB [FILE$DEVICE]) EQL 0 )
			AND (.ONLINE_FLAG NEQ 0) THEN
				BEGIN
					RELEASE (FB);
					RETURN CRE$SNR
				END;
		FD [QSR$FD_NAM] = .FB [FILE$NAME];
		FD [QSR$FD_EXT] = .FB [FILE$EXTENSION];
		FD [QSR$FD_PPN] = .FB [FILE$PPN];
		COPY (FB [FILE$SFD], FD [QSR$FD_PATH], SFDMAX);
		FP [QSR$FP_FDSZ] = QSR$FD_SIZE;
		PAGE [QSR$MS_CNT] = .PAGE [QSR$MS_CNT] + QSR$FD_SIZE;
		RELEASE (FB);
	END
	ELSE
	BEGIN
		CH$MOVE (.FILE_COUNT + 1, .FILE_PTR, CH$PTR (.FD));
		FP [QSR$FP_FDSZ] = CH$ALLOCATION (.FILE_COUNT + 1);
		PAGE [QSR$MS_CNT] = .PAGE [QSR$MS_CNT] + CH$ALLOCATION (.FILE_COUNT + 1);
	END;
	RETURN CRE$OK;

END;

ROUTINE UNSIX6 (SIXPTRADR, SEVENPTRADR)=
!++
!
! FUNCTIONAL DESCRIPTION:
!
!	THIS ROUTINE CONVERTS 6 SIXBIT CHARACTERS TO 6 ASCII(7-BIT) CHARACTERS.
!
! FORMAL PARAMETERS:
!
!	SIXPTRADR - The address of a pointer to the first char of the SIXBIT sequence
!
!	SEVENPTRADR - The address of a pointer to the first character of the ASCII destination
!		sequence.
!
!
! IMPLICIT INPUTS:
!
!	THIS ROUTINE ALWAYS CONVERTS SIX CHARACTERS.
!	The SIXBIT string to be converted is input via the SIXPTR parameter.
!
! IMPLICIT OUTPUTS:
!
!	The ASCII string is written out using the SEVENPTR parameter.
!	The pointer specified by SEVENPTRADR is updated to the character
!		position following the last character written.
!	The pointer specified by SIXPTRADR will point somewhere near the
!		end of the SIXBIT sequence converted.
!
! ROUTINE VALUE:
!
!	The number of characters converted (ALWAYS = 6).
!
! SIDE EFFECTS:
!
!	none
!
!--
BEGIN
	LOCAL CHAR;		!HOLDS CHARACTER BEING MUNCHED
	LOCAL CHARSDONE;		!COUNTS HOW MANY CHARS WE CONVERTED


	INCR CHARSDONE FROM 0 TO 5 DO
	BEGIN
		CHAR = CH$RCHAR_A(.SIXPTRADR);
		CH$WCHAR_A (.CHAR + %O'40', .SEVENPTRADR);
	END;
	RETURN .CHARSDONE
END;	!END OF ROUTINE

END ELUDOM	!End of PAGE.B36