Google
 

Trailing-Edge - PDP-10 Archives - BB-H138B-BM - language-sources/please.mac
There are 31 other files named please.mac in the archive. Click here to see a list.
TITLE	PLEASE	User/Operator communitcations program
SUBTTL	Last update:	4-Dec-79/PJT

;
;
;
;	    COPYRIGHT (c) 1979 BY
;           DIGITAL EQUIPMENT CORPORATION, MAYNARD, MA.
;
;     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  WHICH  IS  NOT SUPPLIED BY
;     DIGITAL.


	SEARCH	GLXMAC			;GET GALAXY SYMBOLS
	PROLOG	(PLEASE)

	SEARCH	ORNMAC
	.REQUI	OPRPAR			;GET THE PARSER


	GLOB	<PARSER,TXTINP>

;Version Declaration

	PARSET					;SETUP PARSER EXTERNALS

	PLSWHO==0
	PLSVER==4
	PLSMIN==0
	PLSEDT==13

	.JBVER==137

	%%.PLS==<VRSN.(PLS)>

	LOC	.JBVER
	EXP	%%.PLS
	RELOC


ENTVEC:	JRST	PLEASE			;MAIN START ADDRESS
	JRST	.REE			;REENTER ADDRESS
	EXP	%%.PLS			;VERSION
	SUBTTL	Revision History

COMMENT \

1	May-14-79	Rewrite and allow sends to terminal if
			user exits before message comes back.
2	Jun-18-79	Add / as a Token to trap the error on
			a switch.
3	Jul-5-79	Change PARSER action routines
4	Aug-9-79	Add code for Nooperator in attendance
			to put out message to the user
5	Aug-9-79	Support WT.KAL to kill all for the JOB
6	Aug-27-79	Change $NODNM to CM%PO for -20 and force
			parse on -10 till :: is added to -10 
			COMND
7	Sept-12-79	Change Operator answer text to include
			the Terminal or Node where it came from
10	Sept-18-79	Use Parser RESCAN logic
11	Sept-20-79	Add Support for P.CEOF to trap error
			on the RESCAN and just reprompt
12			Disable all switches except /MESSAGE and /NOWAIT
13	Dec-4-79	Finish edit 12 and add control c intercept to
			force Pid to go away.
\
;Symbol Definitions

	PDLEN==^D100			;STACK SIZE

;DEFINE A MACRO TO HANDLE FATAL COMMAND ERRORS

DEFINE	$ERRMSG(TXT,%L1) <
	LSTOF.
	CAIA				;;Make macro skippable
	 JRST	%L1
	JSP	TF,ERROR		;;Display the error
	ITEXT	<TXT>			;;Error text is built here
%L1:	LSTON.>

DEFINE	$ERRTXT(TXT) <$ERROR<[MOVEI S2,[ASCIZ@TXT@]
			      $RETF]>>


	OPDEF	$RETIF	[JUMPF .POPJ]	;;RETurn If False
SUBTTL	Local Storage

;STORAGE FOR SOFTWARE INTERRUPT SYSTEM

TOPS20 <
.ICIPC==1
.ICCCC==2
.ICTIM==3		;CHANNEL FOR TIMER INTERRUPTS

LEVTAB:	EXP	LEV1PC
	EXP	LEV1PC
	EXP	LEV1PC

LEV1PC:	BLOCK	1


CHNTAB:	$BUILD	^D36
	$SET(.ICIPC,,<1,,INT>)
	$SET(.ICCCC,,<1,,CNC>)
	$EOB
> ;End TOPS20

TOPS10 <
INTVEC:
IPCINT:	$BUILD	(4)
	$SET(.PSVNP,,INT)
	$EOB

CNCINT:	$BUILD	(4)			;Control-C block
	  $SET	(.PSVNP,,INTCNC)	;Assign Control-C interrupts
	$EOB


CNCBLK:	$BUILD	(3)			;3 word block for Control-C
	  $SET	(0,,.PCSTP)			;Control-C condition
	  $SET	(1,LHMASK,<CNCINT-INTVEC>)	;Offset
		$EOB

> ;End TOPS10

IPBBLK:	$BUILD	IB.SZ
	$SET(IB.PRG,,%%.MOD)		;PROGRAM NAME
	$SET(IB.OUT,,T%TTY)		;TERMINAL AS DEFAULT TEXT OUTPUT
	$SET(IB.FLG,IT.OCT,1)		;OPEN COMMAND TERMINAL
TOPS20 <
	$SET(IB.INT,,<LEVTAB,,CHNTAB>)
> ;End TOPS20
TOPS10 <
	$SET(IB.INT,,INTVEC)
> ;End TOPS10
	$SET(IB.PIB,,PIBBLK)		;ADDRESS OF PID BLOCK
	$EOB

PIBBLK:	$BUILD	PB.MNS			;SIZE OF PID BLOCK
	$SET(PB.HDR,PB.LEN,PB.MNS)	;BLOCK LENGTH
	$SET(PB.FLG,IP.PSI,1)		;CONNECT PID TO PSI
TOPS20 <
	$SET(PB.INT,IP.CHN,1)		;CHANNEL FOR IPCF
> ;END TOPS20
TOPS10 <
	$SET(PB.INT,IP.CHN,<IPCINT-INTVEC>) ;OFFSET FOR IPCF BLOCK
> ;End TOPS10

	$EOB
PDL:	BLOCK	PDLEN			;PUSHDOWN LIST
WTOCOD:	BLOCK	1			;WTOR RESPONSE CODE
MYNODE:	BLOCK	1			;MY LOCATION
SNDLOC:	BLOCK	1			;LOCATION TO SEND TO
PARBLK:	$BUILD	PAR.SZ			;SIZE OF THE BLOCK
	$SET(PAR.TB,,INI010)		;ADDRESS OF TABLES
	$SET(PAR.PM,,PLSPMT)		;PROMPT
	$SET(PAR.CM,,CMDBLK)		;COMMAND RETURN BLOCK
	$EOB				;END THE BLOCK
PLSPMT:	ASCIZ/PLEASE>/			;PROMPT

CMDBLK:	BLOCK	PAGSIZ			;PARSED ARGUMENT PAGE

RESCFL:	BLOCK	1			;RESCAN FLAG
RESPFL:	BLOCK	1			;GET THE RESPFL WORD
WAITFL:	BLOCK	1			;WAIT FLAG WORD
SUBTTL	Command tables

INI010:	$INIT(KEY010)

KEY010:	$KEYDSP(KEY012,$ERRTXT(Invalid PLEASE command specified))
KEY012:	$STAB
	DSPTAB(CAN010,.CANCE,<CANCEL>)
	DSPTAB(EXI010,.EXIT,<EXIT>)
	DSPTAB(MES010,.MESSA,<MESSAGE>)
	DSPTAB(PLE005,.PLEAS,<PLEASE>,CM%INV)
	DSPTAB(SEN010,.PLEAS,<SEND>)
	$ETAB

CAN010:	$NOISE(CAN020,<outstanding messages>)
CAN020:	$CRLF

EXI010:	$CRLF

MES010:	$NOISE(PLE020,<with no reply>)

SEN010:	$NOISE(SEN020,<with reply>)
SEN020:	$SWITCH(SEN020,SEN022,<$ALTER(PLE020),$ERRPDB(PLE040)>)
SEN022:	$STAB
	KEYTAB(PL$NOW,<NOWAIT>)
	$ETAB

PLE005:	$CRLF(<$ALTER(PLE010),$ACTION(CHKREE),$ERRPDB(PLE040)_
	,$HELP(Confirm for multiple line response)>)
PLE010:	$SWITCH(PLE010,PLE012,<$ALTER(PLE020),$ERRPDB(PLE040)>)
PLE012:	$STAB
	KEYTAB(PL$MES,<MESSAGE>)
	KEYTAB(PL$NOW,<NOWAIT>)
	$ETAB

PLE020:	$NODNM(PLE030,<Node name>,<$ALTER(PLE030),$ERRPDB(PLE040)>)
PLE030:	$CRLF(<$ERRPDB(PLE040)_
	,$HELP(Single line response or confirm for multiple line response)>)

PLE040:	$TOKEN(,</>,<$ACTION(BADSWI),$ALTER(PLE050)>)
PLE050:	$CTEXT(,Single line response)

BADSWI:	$ERRMSG	(Invalid switch specified)

CHKREE:	SKIPT	RESCFL			;Here from rescan?
	$RETT				;No..continue parse
	JRST	.REE			;Yes..enter command mode
SUBTTL	Program Setup

PLEASE:	RESET				;RESET THE WORLD
	MOVE	P,[IOWD PDLEN,PDL]	;SETUP PUSHDOWN LIST

TOPS10	<
	MOVE	S1,['PLEASE']
	SETNAM	S1,			;TURN JACCT OFF
> ;End TOPS10

	MOVEI	S1,IB.SZ		;GET IB SIZE
	MOVEI	S2,IPBBLK		;AND IB ADDRESS
	$CALL	I%INIT			;AND INITIALIZE THE WORLD
	SETOM	S1			;GET MY JOB NUMBER
	MOVX	S2,JI.JNO		;JOB NUMBER
	PUSHJ	P,I%JINF		;GET THE JOB NUMBER
	MOVEM	S2,WTOCOD		;SAVE AS WTO CODE
	SETOM	S1			;CLEAR S1
	MOVX	S2,JI.LOC		;GET MY LOCATION
	PUSHJ	P,I%JINF		;GET THE VALUE
	MOVEM	S2,MYNODE		;SAVE MY LOCATION
	MOVE	S1,[1,,.ICTIM]	;GET LEVEL NUMBER AND TIMER CHANNEL
	MOVE	S2,IPBBLK+IB.INT	;GET INTERRUPT DATA BASE INFO
	PUSHJ	P,P$INIT##		;INIT THE PARSER
	$CALL	PSIINI			;INIT THE INTERRUPT SYSTEM
	SETOM	RESCFL			;REMEMBER WE ARE HERE FOR RESCAN
	SETOM	PAR.SR+PARBLK		;REQUEST A RESCAN
	$CALL	GETCMD			;PROCESS COMMAND
.EXIT:	$CALL	I%EXIT

ERROR:	$TEXT	(,?^I/@TF/^A)		;Display the error
	SKIPF	RESCFL			;Rescan?
	JRST	.EXIT
.REE:	MOVE	P,[IOWD PDLEN,PDL]	;Reset the stack
	SETZM	RESCFL			;Not doing a rescan
	MOVEI	S1,INI010		;Setup parser arg block
	MOVEM	S1,PAR.TB+PARBLK
	MOVEI	S1,[ASCIZ/PLEASE>/]
	MOVEM	S1,PAR.PM+PARBLK
	MOVEI	S1,CMDBLK
	MOVEM	S1,PAR.CM+PARBLK
	SETZM	PAR.SR+PARBLK
	$CALL	GETCMD
	JRST	.-1			;Continue processing commands
SUBTTL	Parser and Command dispatch

GETCMD:	MOVEI	S1,PAGSIZ		;Clear initial arguments
	MOVEI	S2,CMDBLK
	$CALL	.ZCHNK
	SETOM	WAITFL			;ASSUME WE WANT TO WAIT
	SETOM	RESPFL			;ASSUME WE WANT RESPONSE
	MOVEI	S1,COM.SZ-1
	STORE	S1,.MSTYP+CMDBLK,MS.CNT	;Set initial size
	$CALL	CHKMSG			;Process incomming messages
	 JUMPT	.-1			;Get them all
	MOVEI	S1,PAR.SZ		;Get size of parser block
	MOVEI	S2,PARBLK		;Point to it
	$CALL	PARSER			;Parse the command
	JUMPT	GETCM1			;Onward if command parsed ok
CMDERR:	MOVE	S1,PRT.FL(S2)		;Get the flags
	MOVE	S2,PRT.EM(S2)		;Get the address of error text
	TXNE	S1,P.INTE		;Interrupt durring parse?
	 JRST	GETCMD			;Yes, back to get command
	TXNE	S1,P.CEOF		;End of file on RESCAN?
	 MOVEI	S2,[ASCIZ/Invalid command terminator/]
	 $ERRMSG(^T/0(S2)/)
	JRST	GETCM2			;Check for next command

GETCM1:	MOVE	S1,[.PRIIN,,.PRIOU]	;Restore primary i/o
	HRRZ	S2,PRT.CF(S2)		;Get address of state block
	MOVEM	S1,.CMIOJ(S2)
	MOVEI	S1,COM.SZ+CMDBLK	;Point to first argument
	$CALL	P$SETU			;Setup for second pass
	$CALL	P$KEYW			;Get keyword value
	 JUMPF	[$ERRMSG(Internal command table error)]
	MOVE	P1,S1			;Save processor address
GETCM9:	$CALL	P$SWIT			;Parse a switch
	JUMPT	[$CALL	0(S1)		;Yes..call the processor
		 JRST	GETCM9]		;Back for next switch
	$CALL	0(P1)			;Call the processor
GETCM2:	$RET				;Return to caller
.CANCE:	$KWTOR(WTOCOD,<$WTMFL(<MF.ACK>),$WTFLG(WT.KAL)>)
	$CALL	GETACK			;Get the ACK
	$RETT

.MESSA:	SETZM	RESPFL			;No response wanted
.PLEAS:	$CALL	P$NODE			;Get node if any
	SKIPF				;Ignore if false
	MOVEM	S1,SNDLOC		; else save the node
	$CALL	P$TEXT			;Get text for message
	 JUMPF	[$CALL TXTINP		;None there, so get some
		 $TEXT (,)		;Return cursor to column 1
		 JRST  .-1]		;Back to set up AC's
	MOVEI	T1,ARG.DA(S1)		;Point to the text
	SKIPF	RESPFL			;Want a response?
	$WTOR(<Message from timesharing user>,<^T/(T1)/>,,WTOCOD,<$WTNOD(SNDLOC),$WTFLG(WT.NFY),$WTMFL(<MF.ACK>)>)
	SKIPT	RESPFL			;Want a response?
	$WTO (<Message from timesharing user>,<^T/(T1)/>,,<$WTNOD(SNDLOC),$WTMFL (<MF.ACK>)>)
	$TEXT	(,<[Message sent at ^C/[-1]/]>)
	$CALL	GETACK			;Get the response
	SKIPF	RESPFL			;Do we expect a response?
	SKIPT	WAITFL			;Yes, want to wait?
	 $RETT				;No, just return
	$CALL	CHKOPR			;See if operator is here
	JUMPF	[$TEXT (,<[Operator is not in attendance]>)
		 $RETT]
	$TEXT	(,<[Waiting for operator response]>)
	PJRST	GETACK			;Yes
	$RETT				;No, just return

;SWITCH PROCESSORS

PL$MES:	SETZM	RESPFL			;No response wanted
	$RETT

PL$NOW:	SETZM	WAITFL			;Don't wait for reply
	$RETT
SUBTTL	CHKOPR	CHECK FOR OPERATOR IN ATTENDANCE


;THIS ROUTINE WILL RETURN TRUE IF PRESENT AND FALSE IF NOT

TOPS20 <
CHKOPR:	MOVEI	S1,.SFOPR		;GET THE OPERATOR IN ATTENDANCE
	SETZM	S2			;CLEAR S2
	TMON				;GET THE VALUE
	SKIPN	S2			;CHECK THE VALUE
	$RETF				;NO OPERATOR
	$RETT				;OPERATOR IN ATTENDANCE
> ;End TOPS20

TOPS10 <
CHKOPR:	MOVX	S1,%CNSTS		;GET THE TABLE AND ITEM
	GETTAB	S1,0			;DO THE FUNCTION
	   JFCL				;IGNORE THE ERROR
	TXNE	S1,ST%NOP		;CHECK FOR NO OPERATOR
	$RETF				;NO OPERATOR
	$RETT				;OPERATOR IN ATTENDANCE
> ;End TOPS10
SUBTTL	CHKMSG	Get a message from ORION

CHKMSG:	PUSHJ	P,C%RECV		;Get a message if any
	 $RETIF			 	;there so return
	SKIPA				;Process it
GETACK:	PUSHJ	P,C%BRCV		;GET THE ACK
	LOAD	T1,MDB.MS(S1),MD.ADR	;GET MESSAGE ADR.
	LOAD	T2,.MSFLG(T1)		;GET THE MESSAGE TYPE
	TXNE	T2,MF.NOM		;JUST AN ACK
	PJRST	PROREL			;Yes, release it
					;No, process the message

SUBTTL	PROMSG	Process an IPCF message

PROMSG:	LOAD	P1,MDB.MS(S1),MD.ADR	;GET MESSAGE ADR.
	MOVEI	S1,.OHDRS(P1)		;POINT TO THE BLOCKS
	PUSHJ	P,P$SETU		;SETUP THE POINTERS
	PUSHJ	P,P$TEXT		;GET THE TEXT BLOCK
	JUMPF	PROUNK			;GENERATE AN ERROR
	MOVEI	T1,ARG.DA(S1)		;ADDRESS OF THE TEXT
	LOAD	S2,.MSTYP(P1),MS.TYP	;GET THE MESSAGE TYPE
	CAIE	S2,MT.TXT		;IS IT A TEXT MESSAGE
	JRST	PRORSP			;NO, PROCESS AS A RESPONSE
	MOVE	S2,.MSFLG(P1)		;Get the flags
	TXNN	S2,MF.FAT		;FATAL?
	JRST	PROACK			;NO, PROCESS AS AN ACK
	ANDX	S2,MF.SUF		;GET THE SUFFIX
	CAIN	S2,'NMC'		;Was it NO MESSAGE FOUND?
	JRST	[MOVEI	T1,[ASCIZ/No outstanding messages/]
		 PJRST	PROACK]		;Yes, treat as an ACK
	$TEXT	(,<? ^T/(T1)/>)		;Else display the error
	JRST	PROREL			;Release the message

PRORSP:	PUSHJ	P,P$NFLD		;SKIP NEXT FIELD (ACK ID CODE)
	JUMPF	PROUNK			;GENERATE AN ERROR
	CAIE	S1,.ACKID		;CHECK FOR ACKID BLOCK
	JRST	PROUNK			;GENERATE AN ERROR
	MOVE	T2,ARG.DA+1(S2)		;GET THE VALUE
	MOVEI	T3,[ITEXT(<^N/T2/>)]	;NODE NAME
	TLNN	T2,770000		;SIXBIT?... NODE NAME
	MOVEI	T3,[ITEXT(<terminal ^O/T2/>)] ;NO MUST BE termINAL NUMBER
	$TEXT	(,<^C/[-1]/ From operator ^I/(T3)/:
	=^7/[76]/^T/(T1)/>)			;DUMP THE ANSWER
	JRST	PROREL			;Release the message

PROUNK:	MOVEI	T1,[ASCIZ/Unrecognized response from ORION/]
PROERR:	$TEXT(,<? ^T/(T1)/>)		;Display the error
	JRST	PROREL			;Release the message

PROACK:	$TEXT	(,<[^T/(T1)/]>)		;Display the text
PROREL:	$CALL	C%REL			;Release the message
	$RETT				;Return to caller
SUBTTL	Software Interrupt System Routines


TOPS10 <
PSIINI:	MOVX	S1,PS.FAC+CNCBLK	;Enable for Control-C interrupts
	PISYS.	S1,
	 $STOP	(CNC,Can't enable Control-C interrupts)
	$CALL	I%ION
	$RETT

> ;End TOPS10 conditional

TOPS20 <
PSIINI:	MOVE	S1,[.TICCC,,.ICCCC]
	ATI
	MOVX	S1,.FHSLF
	MOVX	S2,1B<.ICCCC>
	AIC
	$CALL	I%ION
	$RETT
> ;End TOPS20 conditional

INT:	$BGINT	1			;BEGIN AN INTERRUPT
	PUSHJ	P,P$INTR##		;PARSER INTERRUPT SUPPORT
	PUSHJ	P,C%INTR		; FLAG RECEIPT OF IPCF INTERRUPT
	$DEBRK				; EITHER RETURN TO SEQUENCE
					; OR CHANGE PC AND HANDLE THE INTERRUPT
CNC:	PJRST	.EXIT

	END	<3,,ENTVEC>