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>