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

MODULE QSRMSG=
!Routines to talk to QUASAR
!FACILITY: NETSPL
!ENVIRONMENT: TOPS-10 6.03 or later
!		also requires use of condition handlers for NETSPL
!
!THESE ROUTINES USE AND MODIFY GLOBAL STORAGE
BEGIN

!
! Table of Contents
!

FORWARD ROUTINE
IPCINI,
GET_QUASAR_PID,
HELLO,
DONEXTJOB,
RELJOB,
REQJOB,
QMRECV,
QSRACK,
GETPID,
IPCSND,		!Send a message to [SYSTEM]IPCC
MSSEND,		!Send a message to anywhere
MSRECV,		!Receive a message
IPCQCK;		!Check IPCF receive queue

!
! Libraries & REQUIRE files
!
REQUIRE 'INTR.REQ';
LIBRARY 'DAPLIB';

!
! Version
!
THIS_IS [QSRM]	VERSION [1]	EDIT [4]	DATE [25,OCT,79]
![4]	No ACKs for REQJOB and RELJOB
![3]	Set mode of local file to ASCII if requested

!
! Macros
!
MACRO SEND_QUASAR(PACK,FLG)=
	BEGIN
	COMPILETIME PAGEFLG=%IF %NULL(FLG) %THEN 0 %ELSE FLG %FI;
	EXTERNAL ROUTINE MSGSND;
	MSGSND(PACK,PAGEFLG)
	END%;

MACRO PREFIX='NJR' %;

!
!LITERALS
!
LITERAL IPCFR_=%O'142';		!IPCF receive
LITERAL IPCFS_=%O'143';		!IPCF send
LITERAL IPCFQ_=%O'144';		!IPCF query
GLOBAL LITERAL SIIPC=%O'126';	!GETTAB for PID of [SYSTEM]IPCC
GLOBAL LITERAL SIQSR=%O'2000126';!GETTAB for PID of [SYSTEM]QUASAR
GLOBAL LITERAL SIQPV=%O'22000126';!GETTAB for PID of [SYSTEM]PRIVATE_QUASAR

LITERAL _IPCSC=6;	!Create a PID
LITERAL _PCIPC=%O'-24';
LITERAL PROGRAMNAME=%SIXBIT'NETSPL';
LITERAL NETDEV=%SIXBIT'TSK';
LITERAL UNTIL_RESET=1;	!PID goes away on reset if so
LITERAL UNTIL_LOGOUT=0;		!Keep PID until log out

!
!GLOBAL DATA AREAS
!
GLOBAL QSRGETTAB: INITIAL(SIQSR); !This way so can be patched to private quasar
GLOBAL IPCFINT: INT_BLOCK;	!Interrupt block for IPCF packet arrival
GLOBAL HIMSG: QSR$HI;		!Hello message for Quasar

!
!Externals
!
EXTERNAL ROUTINE
	RCVACK: NOVALUE,
	ERTEXT,
	ALLOC,	!Get core
	FBINI,	!Initialize file block
	NETQDEV,
	GETTAB,
	MSGSND;
EXTERNAL QSRPID;			!QUASAR's PID goes here

GLOBAL ROUTINE IPCINI=
!Set up interrupts for IPCF packets
!Arguments: none
!Implicit outputs: IPCFINT and HIMSG initialized, QSRPID set up
!Returned value: 1 if successful
BEGIN
EXTERNAL ROUTINE
	NETQDEV,
	INTINI;

GETPID(UNTIL_RESET);		!We want a PID
INTINI(IPCFINT);
IPCFINT[INT$WHAT]=_PCIPC;	!Condition is arrival of IPCF packet
INTERRUPTS(ADD,IPCFINT);

HIMSG[QSR$HI_STATUS]=0;		!Initialize HELLO message block
HIMSG[QSR$HI_VERS]=QSRVER;
HIMSG[QSR$HI_AVAIL]=1;			!Avaliable for scheduling
HIMSG[QSR$MS_TYP]=QSR$MS_HELLO;		!Set message type
HIMSG[QSR$MS_CNT]=QSR$HI_SIZE;		!and length
HIMSG[QSR$HI_NAME]=PROGRAMNAME;		!and our name
HIMSG[QSR$HI_SDEV]=NETQDEV();		!our queue name
HIMSG[QSR$HI_PDEV]=NETDEV;		!Processing device

IF GET_QUASAR_PID() EQL 0 THEN		!QUASAR isn't there!!
	ERROR(QSRNRN);
WIN					!Returned value
END; !IPCINI

ROUTINE GET_QUASAR_PID=
!Find the process ID for QUASAR
!Returns it as value, and stores it in QSRPID
BEGIN
REGISTER R;

R=.QSRGETTAB;
IF CALLI(R,%O'41')		!GETTAB UUO
	THEN QSRPID=.R
	ELSE 0
END;	!GET_QUASAR_PID

GLOBAL ROUTINE HELLO=
!Send a HELLO message
!Implicit parameter: HIMSG (global) should be set up
BEGIN
EXTERNAL ROUTINE RCVACK;

SEND_QUASAR(HIMSG);			!Send it
!No acks for now
!IF .HIMSG[QSR$MS_ACK] THEN RCVACK()	!Get acknowledge and return its value
END; !HELLO

GLOBAL ROUTINE DONEXTJOB(NB,QMSG)=
!Process a NEXTJOB message.  Put information therefrom into an NDB
!NB: address of NDB
!QMSG: Addres of NXTJOB message we got from QUASAR
BEGIN
MAP	NB:	REF NDB,
	QMSG:	REF QSR_EQ;
BIND	FB=.NB[NDB$FB]:	FILE_BLOCK;	!Hook on file block
BIND	FOP=NB[NDB$FOP]: EX;		!FOP field of ATTRIBUTES
LOCAL	FP:	REF QSR$FP,		!Will point to file parameter area
	FD:	REF QSR$FD,		!File data area
	PTR;
EXTERNAL ROUTINE
	WRPPNA;

NB[NDB$EQ]=.QMSG;			!Save pointer to message
NB[NDB$NODEID]=.QMSG[QSR$EQ_NODE];	!Copy NODEID
NB[NDB$ACCFUNC]=
	(CASE .QMSG[QSR$EQ_FUNC] FROM RMC$F_SEND TO RMC$F_EXECUTE OF SET
	[RMC$F_SEND]:	ACC$CREATE;	!Send a file to the remote system
	[RMC$F_GET]:	ACC$OPEN;	!Get a file from the remote system
	[RMC$F_DEL]:	ACC$ERASE;	!Delete a file on the remote system
	[RMC$F_REN]:	ACC$RENAME;	!Rename a file on the remote system
	[RMC$F_DI]:	ACC$LIST;	!List a directory on remote system
	[RMC$F_SUBMIT]:	ACC$CMD;	!Send and Submit a batch stream
	[RMC$F_EXECUTE]:ACC$EXE;	!Submit a batch stream
	[INRANGE,OUTRANGE]:	0;	!Leave it 0, we can't handle it
	TES);

NB[NDB$OPTIONS]=.QMSG[QSR$EQ_OPTIONS];	!Copy over options from RMCOPY
NB[NDB$MASTER]=1;			!Remember we started all this
FB[FILE$MODE]= (IF (.N[RMC$O_ASC] OR .N[RMC$O_ASCB])
		THEN _IOASC ELSE _IOIMG); !Ascii if he asked for it
					!Otherwise image mode
FB[FILE$GODLY]=1;			!Access as if we were requestor
					!This bit must be set to do this


FOP[FB$SUP]=1;				!Always try to supercede
IF .NB[NDB$ACCFUNC] EQL ACC$OPEN
THEN	FOP[FB$DLC]=.NB[NDB$RMC$O_DE];	!Send delete on close to remote system
PTR=CH$PTR(NB[NDB$REQUESTOR]);		!Ascii-ize PPN & store for DAP
WRPPNA((FB[FILE$ALIAS]=.QMSG[QSR$EQ_OWNER]),PTR); !& save for access check also

FP=.QMSG+.QMSG[QSR$EQ_LENGTH];		!Point to beginning of file area
INCR I FROM 1 TO .QMSG[QSR$EQ_NUMFIL]	!Decipher as many files as we got
DO	BEGIN
	EXTERNAL ROUTINE COPY;
	FD=.FP[QSR$FP_FPSZ]+.FP;		!FD follows FP
	IF .FP[QSR$FP_LOCAL] NEQ 0		!A LOCAL filespec
	THEN	BEGIN
		LOCAL FB: REF FILE_BLOCK;		!Local or log
		IF .FP[QSR$FP_FLG]
		 THEN	BEGIN
			IF .NB[NDB$LOG_FB] EQL 0
			 THEN	BEGIN
				FB=(NB[NDB$LOG_FB]=ALLOC(FB_LEN));
				FBINI(.FB);
				END;
			END
		 ELSE 	BEGIN
			FB=.NB[NDB$FB];
			FB[FILE$FB$DLC]=.NB[NDB$RMC$O_DE]; !/DELETE after transfer
			END;
		FB[FILE$NAME]=.FD[QSR$FD_NAM];
		FB[FILE$DEVICE]=.FD[QSR$FD_STR];
		FB[FILE$EXTENSION]=.FD[QSR$FD_EXT];
		COPY(FD[QSR$FD_PPN],FB[FILE$DIR],SFDMAX+1);
		!Now move directory spec (1 UFD + SFDMAX SFD's)
		END
	ELSE	BEGIN					!Copy ASCIZ string
		LOCAL RFSP;
		!Second remote filespec (if any) is remote RENAME filespec
		RFSP=(IF .NB[NDB$REMOTEFILE] EQL 0	THEN NB[NDB$REMOTEFILE]
							ELSE NB[NDB$REMRENAME]);
		COPY(.FD,.RFSP,.FP[QSR$FP_FDSZ]);
		END;
	FP=.FD+.FP[QSR$FP_FDSZ];			!Point to next file
	END;
IF .HIMSG[QSR$HI_NEXT] EQL .QMSG[QSR$EQ_SEQ]
	THEN HIMSG[QSR$HI_NEXT]=0; 	!Clear NEXT if we just got it

END; !NEXTJOB

GLOBAL ROUTINE RELJOB(NB)=
!Release a job, i.e. tell QUASAR we did it.
!NB: address of NDB for job
BEGIN
MAP NB: REF NDB;	!NDB for transfer
BIND EQ=.NB[NDB$EQ]: QSR_EQ;		!EQ entry that created this
LOCAL RELMSG: QSR$REL;

CLEARV(RELMSG);				!Start out clean
IF EQ EQL 0
THEN	BEGIN
	INFO('No queue entry to release');
	RETURN 0
	END;

!RELMSG[QSR$MS_ACK]=1;			!RSVP
RELMSG[QSR$MS_TYP]=QSR$MS_RELEASE;
RELMSG[QSR$MS_CNT]=QSR$REL_SIZE;
RELMSG[QSR$REL_ITN]=.EQ[QSR$EQ_TASK];	!Get ITN from original message
SEND_QUASAR(RELMSG);

!May cause trouble if next message in queue isn't an ACK
!RCVACK()				!Get our acknowledgement
END; !RELJOB

GLOBAL ROUTINE REQJOB(NB,AFTER)=
!Reque a job
!NB: address of NDB for job
!AFTER: /AFTER parameter
BEGIN
MAP NB: REF NDB;	!NDB for transfer
BIND EQ=.NB[NDB$EQ]: QSR_EQ;	!EQ entry that created this
LOCAL REQMSG: QSR$REQ;

IF EQ EQL 0
THEN	BEGIN
	WRN('No queue entry to re-queue');
	RETURN 0;				!No queue entry there
	END;

CLEARV(REQMSG);				!Start out clean
!Don't need this?? may cause trouble if what we get back
!is another job, not an ACK
!REQMSG[QSR$MS_ACK]=1;			!RSVP

REQMSG[QSR$MS_TYP]=QSR$MS_REQUE;
REQMSG[QSR$MS_CNT]=QSR$REQ_SIZE;
REQMSG[QSR$REQ_ITN]=.EQ[QSR$EQ_TASK];	!Get ITN from original message
REQMSG[QSR$REQ_AFTER]=.AFTER;		!Fill in /AFTER value
SEND_QUASAR(REQMSG);			!Send it out

!May cause trouble if next message in queue isn't an ACK
!RCVACK()				!Get our acknowledgement
END; !REQJOB

GLOBAL ROUTINE QMRECV(PACK)=
!++
! FUNCTIONAL DESCRIPTION:
!	This routine waits (if necessary) for a message from QUASAR.
!	and receives it, returning the address of the message
!
! FORMAL PARAMETERS:
!
!	Address of an IPCF header block
!
! IMPLICIT INPUTS:
!
!	The IPCF receive Q
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	Address of message from QUASAR
!
! SIDE EFFECTS:
!
!	Storage for the message will have been ALLOCated
!	(if not a page-packet), or a page will have been
!	added to the address space (if a page-packet).
!
!--
BEGIN
!
! Externals
!
EXTERNAL ROUTINE
	MSGERROR,
	GETPAG,
	QUEWAT;
!
! Literals
!
LITERAL IPCFR_=%O'142';		!IPCF receive
!

MAP PACK: REF IPCF_HEADER;	!Something to pass to  QUEWAT
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[0,0,0,0]);		!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;
	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
	ELSE	BEGIN
		EXTERNAL ROUTINE ALLOC;
		PACK[IPCF$MSG_ADR]=(M=(ALLOC(.PACK[IPCF$MSG_LEN])));
		END;
	S2<LH> = IPCF$HEADER_LEN;
	S2<RH> = PACK[0,0,0,0];
	IF CALLI (S2, IPCFR_) THEN
	   RETURN .M
	ELSE
		BEGIN
		UNDECLARE %QUOTE PREFIX;
		MACRO PREFIX='RCV'%;
		EXTERNAL ROUTINE FREE;
		MSG('%','','Receive failure ');TSTR(ERTEXT(IPCERR+.S2));
		 TYPE(CRLF);
		FREE(.PACK[IPCF$MSG_ADR],.PACK[IPCF$MSG_LEN]);
		END;
	END
END;

GLOBAL ROUTINE QSRACK=
!Send an ACKNOWLEDGE message to QUASAR
BEGIN
LOCAL ACKMSG:QSR$MSG_TEXT;

CLEARV(ACKMSG);			!Zero block first

ACKMSG[QSR$MS_CNT]=QSR$TEXT_SIZE;	!Size of message
ACKMSG[QSR$MS_TYP]=QSR$MS_TEXT;
ACKMSG[QSR$TEXT_NOMESS]=1;	!No text, just an ACK

SEND_QUASAR(ACKMSG)
END; !QSRACK

GLOBAL ROUTINE GETPID(PIDTYPE)=
!Routine to get a PID from [SYSTEM]IPCC. Requires IPCF priveleges!!
!PIDTYPE: if 1, PID goes away on RESET, otherwise on logout.
!Returns: your new PID
BEGIN
FIELD GP_FIELDS=SET
DFF[GP$USER_CODE,FIRSTWORD,LH],	!Left alone so user can keep his place
DFF[GP$FUNCTION,THISWORD,RH],	!Function code to IPCC
DFF[GP$PIDTYPE,NEXTWORD,35,1,0],!Destroy PID on RESET if set
DFF[GP$JOB,THISWORD,0,34,0]	!Job number
TES;
LITERAL GP_LEN=%O'10';

LOCAL IPCDATA: BLOCK[GP_LEN] FIELD(GP_FIELDS);
EXTERNAL ROUTINE PJOB;

CLEARV(IPCDATA);
IPCDATA[GP$FUNCTION]=_IPCSC;	!Create a pid
IPCDATA[GP$PIDTYPE]=.PIDTYPE;	!Permanent or not
IPCDATA[GP$JOB]=PJOB();
IPCSND(IPCDATA,GP_LEN);
END; !GETPID

GLOBAL ROUTINE IPCSND(MSG_ADDR,MSG_LEN)=
!Send a message to [SYSTEM]IPCC
!MSG_ADDR: address of message data
!MSG_LEN:  length of message data
BEGIN
OWN IPCCPID;	!Remember PID of [SYSTEM]IPCC
LOCAL HDRBLK: IPCF_HEADER;

IF .IPCCPID EQL 0 THEN IPCCPID=GETTAB(SIIPC);
CLEARV(HDRBLK);
HDRBLK[IPCF$PRV_PACK]=1;	!So [SYSTEM]IPCC will listen to us
HDRBLK[IPCF$RECV_PID]=.IPCCPID;
HDRBLK[IPCF$MSG_ADR]=.MSG_ADDR;
HDRBLK[IPCF$MSG_LEN]=.MSG_LEN;
MSSEND(HDRBLK);
DO	BEGIN
	CLEARV(HDRBLK);
	IF IPCQCK(HDRBLK) EQL 0 THEN	!Got a message
	 ERROR(IPCERR);
	IF .HDRBLK[IPCF$PAGE_PACK]
	 THEN HDRBLK[IPCF$MSG_ADR]=(HDRBLK[IPCF$MSG_LEN]=0) !Throw away
	 ELSE	BEGIN
		HDRBLK[IPCF$MSG_ADR]=.MSG_ADDR;
		HDRBLK[IPCF$MSG_LEN]=.MSG_LEN;
		END;
	HDRBLK[IPCF$TRUNC]=1;
	MSRECV(HDRBLK);
	END WHILE .HDRBLK[IPCF$SEND_PID] NEQ .IPCCPID;
	IF .HDRBLK[IPCF$PROC_ERR] NEQ 0
	 THEN	ERROR(IPCERR+.HDRBLK[IPCF$PROC_ERR]);
WIN
END; !IPCSND

GLOBAL ROUTINE MSSEND(HDRBLK)=
!Routine to send a message (to anyone)
!HDRBLK: An IPCF header block, filled in as follows
!HDRBLK[IPCF$RECV_PID]:	PID of recipient.
!HDRBLK[IPCF$MSG_ADR]:	Address of message
!HDRBLK[IPCF$MSG_LEN]:	Length of message
!HDRBLK[IPCF$PRV_PACK] & HDRBLK[IPCF$PAGE_PACK] set if needed
!Returns 1 if successful
BEGIN
REGISTER R;
MAP HDRBLK: REF IPCF_HEADER;
R<RH>=.HDRBLK;		R<LH>=IPCF$HEADER_LEN;
IF CALLI(R,IPCFS_)
 THEN	RETURN WIN
 ELSE	ERROR(IPCERR+.R);
END;	!MSSEND

GLOBAL ROUTINE MSRECV(HDRBLK)=
!Routine to receive a message (from anyone)
!HDRBLK: An IPCF header block, filled in as follows
!HDRBLK[IPCF$MSG_ADR]:	Address of message
!HDRBLK[IPCF$MSG_LEN]:	Length of message
!Returns 1 if successful
!The following will be filled in on return
!HDRBLK[IPCF$SEND_PID]:	PID of sender
!HDRBLK[IPCF$PRV_PACK] & HDRBLK[IPCF$PAGE_PACK] set if appropriate
BEGIN
REGISTER R;
MAP HDRBLK: REF IPCF_HEADER;
R<RH>=.HDRBLK;		R<LH>=IPCF$HEADER_LEN;
IF CALLI(R,IPCFR_)
 THEN	RETURN WIN
 ELSE	ERROR(IPCERR+.R);
END;	!MSRECV

GLOBAL ROUTINE IPCQCK(HDRBLK)=
!Check the IPCF receive queue
!HDRBLK: An IPCF header block, which will be filled in as follows
!HDRBLK[IPCF$FLAGS]
!HDRBLK[IPCF$MSG_LEN]:	Length of message
!HDRBLK[IPCF$MSG_ADR] CONTAINS # OF MESSAGES IN QUEUE
!HDRBLK[IPCF$SEND_PID]:	PID of sender
!HDRBLK[IPCF$PRV_PACK] & HDRBLK[IPCF$PAGE_PACK] set if appropriate
BEGIN
REGISTER R;
MAP HDRBLK: REF IPCF_HEADER;
R<RH>=.HDRBLK;		R<LH>=IPCF$HEADER_LEN;
IF CALLI(R,IPCFQ_)
 THEN	RETURN WIN
 ELSE	BEGIN
	R=IPCERR+.R;
	IF .R EQL IPCNMR THEN RETURN 0;
	ERROR(.R);
	END;
END;	!IPCQCK
END ELUDOM