Trailing-Edge
-
PDP-10 Archives
-
BB-JR93N-BB_1990
-
10,7/galaxy/operat/opr.mac
There are 37 other files named opr.mac in the archive. Click here to see a list.
TITLE OPR -- Parser Routines for ORION
SUBTTL Murry Berkowitz/PJT 12-SEP-85
;
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975,1976,1977,1978,1979
;1980,1981,1982,1983,1984,1986,1987. ALL RIGHTS RESERVED.
;
;
; 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
.directive flblst
PROLOG (OPR)
SEARCH ORNMAC
;** OPR/ORION's VERSION is defined in ORNMAC.MAC
%%.OPR==:%%.OPR ;REFERENCE ORNMAC'S VERSION
OPRVRS==:OPRVRS ;AND OPR/ORION'S
LOC 137
EXP OPRVRS
RELOC
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1971,1987. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO
ENTVEC: JRST OPR ;MAIN ENTRY POINT
JRST OPRRMT ;REMOTE OPR ENTRY
EXP OPRVRS ;VERSION
SUBTTL Table of Contents
; TABLE OF CONTENTS FOR OPR
;
;
; SECTION PAGE
; 1. Table of Contents......................................... 2
; 2. Revision History.......................................... 3
; 3. Special accumulator assignments........................... 4
; 4. OPR impure data........................................... 5
; 5. Interrupt vector definitions.............................. 6
; 6. Initialization blocks..................................... 7
; 7. Table building data base.................................. 8
; 8. OPR Main entry and initialization..................... 9
; 9. CCLOOK CCL entry file lookup (TOPS10).................... 10
; 10. MAIN Main processing loop.............................. 11
; 11. SETIME Routine to set timer intervals.................... 13
; 12. TAKEND Process end of TAKE command....................... 14
; 13. DSPCMD Display TAKE commands if desired.................. 15
; 14. PRCMSG Process IPCF messages............................. 16
; 15. VALMSG Validate a message from ORION..................... 16
; 16. ACKOPR Display a GALAXY text message..................... 17
; 17. DSPOPD Process DISPLAY message from ORION................ 18
; 18. SHWDSP Process DISPLAY message from ORION................ 19
; 19. TABSET Setup tables for parser call...................... 20
; 20. Software interrupt system routines........................ 21
; 21. Command and application action routines................... 22
; 22. ENTER and RETURN command tables........................... 23
; 23. Control-Z and EXIT command tables and action routines..... 24
; 24. TAKOPR Process a take command............................ 25
; 25. WAIOPR Process a wait command............................ 26
; 26. SETRTN and SETTRM Process SET TERMINAL command...... 27
; 27. ESCAPE Sequence Table for Operator Terminals.............. 28
; 28. SHWDAY Process SHOW DAYTIME command...................... 30
; 29. OPRRMT Entry and initialization for REMOTE OPR........... 31
; 30. WAITCN Wait for output link connect...................... 32
; 31. REMSET Setup OPR links................................... 33
; 32. SETOUT Setup output of data.............................. 34
; 33. SNDOUT Send output over the link......................... 34
; 34. OUTRTN Output routine for links.......................... 34
; 35. SETPTR Setup pointers for output......................... 34
; 36. INPINT Input over link interrupt......................... 35
; 37. OUTINT Output link connected............................. 35
; 38. IPCRMT IPCF interrupt routine for remote OPR............. 35
; 39. INPDAT Input the data from link.......................... 36
; 40. CONNEC Process connect message........................... 37
; 41. TXTLIN Check if multiple line input allowed.............. 38
; 42. SETFAL Send a setup failure for OPR errors............... 39
; 43. PUSHRT Process the PUSH command (TOPS20)................. 40
; 44. TERMFK Process fork termination interrupt................ 41
; 45. OPRSON OPR signon to ORION............................... 42
; 46. OPRRST OPR reply to setup................................ 43
; 47. SETREP Setup reply message............................... 44
; 48. SETMES Setup message reply............................... 45
; 49. TABCHK Routine to check out syntax tables................ 46
; 50. GETLOC Get OPR location.................................. 47
SUBTTL Special accumulator assignments
FLAG==14 ;FLAG AC FOR OPR
O.ACKP==1B0 ;ACK MESSAGE BEING PROCESSED
O.LAST==1B1 ;LAST LINE OF MESSAGE
O.ERRP==1B2 ;ERROR PROCESSING OF MESSAGE
O.DSPM==1B3 ;DISPLAY MESSAGE SENT
O.CCL==1B4 ;CCL ENTRY
MD==15 ;MESSAGE FOR DISPLAY ADDRESS
M==16
XP PDLEN,^D200 ;SIZE OF OUR STACK
SUBTTL OPR impure data
$DATA PDL,PDLEN
OPRDAT: $DATA DEFTAB,1 ;ADDRESS OF TABLES BEING USED
$DATA HDRTAB,1 ;MAIN TABLE SETTING
$DATA HDRPMT,10 ;PROMPT FOR APPLICATION
$DATA CMDDAT,1 ;COMND DATA COLLECTED IN PARSE
$DATA ENTCOD,1 ;CODE OF THE TABLE TYPE
$DATA TABCOD,1 ;CODE FOR APPLICATION TYPE
$DATA MYNODE,1 ;NODE OF THIS OPR
;STORAGE FOR PARSER TO EVENT PROCESSOR COMMUNICATION
$DATA PARBLK,PAR.SZ ;SPACE FOR PARSER CALL ARGUMENTS
;STORAGE FOR DISPLAY PROCESSING
$DATA DSPPTR,1 ;DESTINATION DISPLAY POINTER
$DATA SRCPTR,1 ;SOURCE POINTER
$DATA DSPFLG,1 ;DISPLAY BLOCK FLAGS
$DATA TEMOUT,^D20 ;LEAVE ROOM FOR A LINE
$DATA REMOPR,1 ;REMOTE OPERATOR IN USE FLAG
$DATA REMACC,1 ;REMOTE ACCESS (NSP ON -20)
$DATA TEMPTR,1 ;TEMPORARY POINTER FOR TEXT
$DATA HOSTNM,1 ;HOST NAME FOR OPR
$DATA ERRCOD,1 ;ERROR CODE FOR OPR ERRORS
$DATA INTDSP,1 ;INTERRUPT DISPLAY FLAG
$DATA MSGCNT,1 ;COUNT OF IPCF MESSAGES ON WAKEUP
$DATA TAKFLG,1 ;TAKE COMMAND FLAG
$DATA ARG1,1 ;ARGUMENT FOR ERROR PROCESSING
TOPS10 <$DATA CTXDAT,12> ;CTX. UUO DATA BLOCK
TOPS20 <
$DATA DCNDAT,5 ;BLOCK FOR TASK CONNECT NAME
$DATA INPJFN,1 ;LINK INPUT JFN
$DATA OUTJFN,1 ;LINK OUTPUT JFN
$DATA BUFADR,1 ;BUFFER ADDRESS FOR OUTPUT
$DATA OUTPTR,1 ;POINTER FOR OUTPUT TO LINK
$DATA OUTCNT,1 ;COUNT FOR OUTPUT TO LINK
$DATA INPDON,1 ;INPUT DONE ON LINK
$DATA OUTCON,1 ;OUTPUT CONNECT LINK
$DATA OUTACT,1 ;OUTPUT LINK ACTIVE
$DATA NETBUF,1 ;ADDRESS OF NETWORK BUFFER
$DATA FRKRUN,1 ;FORK RUNNING (-1 IF RUNNING)
$DATA FRKJFN,1 ;JFN FOR EXEC
$DATA FRKHND,1 ;HANDLE FOR FORK
$DATA TRPCHN,1 ;TRAP CHANNELS FOR CONTL-C
$DATA SAVTWD,2 ;SAVE TERMINAL WORD
$DATA SAVMOD,1 ;SAVE MODE WORD
$DATA LEV1PC,1
$DATA LEV2PC,1
$DATA LEV3PC,1
> ;End TOPS20
$DATA DATEND,0 ;END OF THE DATA AREA
DATASZ==DATEND-OPRDAT ;SIZE OF DATA AREA
SUBTTL Interrupt vector definitions
XP TIMCHN,2 ;CHANNEL FOR TIMER INTERRUPTS
XP IPCLEV,1 ;IPCF INTERRUPT LEVEL (MUST BE 1)
XP DETLEV,1 ;Detach/attach interrupt level
TOPS20 <
LEVTAB: EXP LEV1PC
EXP LEV2PC
EXP LEV3PC
CHNTAB: $BUILD ^D36
$SET(1,,<IPCLEV,,INT>)
$SET(.ICIFT,,<IPCLEV,,TERMFK>)
$EOB
> ;End TOPS20
TOPS10 <
INTVEC:
IPCINT: $BUILD .PSVIS+1
$SET(.PSVNP,,INT) ;IPCF interrupt block
$EOB
DETINT: $BUILD .PSVIS+1
$SET (.PSVNP,,DET) ;Detached interrupt block
$EOB
TIMINT: $BUILD .PSVIS+1 ;Timer interrupt block
$EOB
TIMVEC==TIMINT-INTVEC
> ;End TOPS10
;IB FOR LOCAL OPR INITIALIZATION
SUBTTL Initialization blocks
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
$SET(IB.FLG,IP.STP,1) ;STOPCODES TO ORION
TOPS20< $SET(IB.INT,,<LEVTAB,,CHNTAB>)>
TOPS10< $SET(IB.INT,,INTVEC)>
$SET(IB.PIB,,PIBBLK) ;ADDRESS OF PID BLOCK
$EOB
;IB FOR REMOTE OPR INITIALIZATION
TOPS20 <
IPBRMT: $BUILD IB.SZ
$SET(IB.PRG,,%%.MOD) ;PROGRAM NAME
$SET(IB.OUT,,OUTRTN) ;DEFAULT $TEXT OUTPUT ROUTINE
$SET(IB.FLG,IP.STP,1) ;STOPCODES TO ORION
$SET(IB.INT,,<LEVTAB,,CHNTAB>) ;INTERRUPT SYSTEM ADDRESS
$SET(IB.PIB,,PIBBLK) ;ADDRESS OF PID BLOCK
$EOB
> ;End TOPS20
;IPCF PID DECLARATION BLOCK
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
TOPS10< $SET(PB.INT,IP.CHN,<IPCINT-INTVEC>)> ;OFFSET FOR IPCF BLOCK
$EOB
SUBTTL Table building data base
TABNUM: EXP NUMAPL+1 ;NUMBER OF TABLES INCLUDED
DEFINE X(A,B,C,D),<EXP C ;SET UP ADDRESS OF EACH ENTRY
EXTERNAL C ;SET UP AS EXTERNAL
.REQUIRE C>
SYNTAB: EXP OPRCMD## ;MAIN OPR TABLES
TABAPL ;ADDRESS OF APPLICATION TABLES
TABINI: $INIT(MANTAB) ;INIT FUNCTION FOR TABLES
MANTAB: $KEYDSP(APLALT,<$ACTION(CMDACT)>) ;KEYWORD TABLE BLOCK
APLALT: $STAB
TOPS10< ORNDSP(,\"32,CTZ,CM%INV) > ;ORANGE TOADS DON'T UNDERSTAND THIS
ORNDSP(ENTFDB,ENTER,ENT) ;ENTER COMMAND FDB
ORNDSP(EXTFDB,EXIT,EXT) ;EXIT COMMAND
ORNDSP(PUSFDB##,<PUSH>,PUS) ;PUSH COMMAND
ORNDSP(RETFDB,RETURN,RTN) ;RETURN FDB
ORNDSP(TAKOPR,TAKE,TAK) ;TAKE FDB
ORNDSP(WAIFDB##,WAIT,WAI) ;WAIT COMMAND
$ETAB
OPRPMT: [ASCIZ /OPR>/] ;DEFAULT STARTING PROMPT
APLTAB: $KEYDSP(KEYAP1,<$ACTION(APLACT)>) ;MAIN APPL. TABLE
DEFINE X(A,B,C,D),<ORNDSP(,<A>,<B>)>
KEYAP1: $STAB ;START TABLE OF NAMES
TABAPL ;EXPAND APPLICATION ENTRIES
$ETAB
SUBTTL OPR Main entry and initialization
OPR: TDZA FLAG,FLAG ;CLEAR THE FLAGS
MOVX FLAG,O.CCL ;UNLESS CCL START
RESET ;RESET THE UNIVERSE
MOVE P,[IOWD PDLEN,PDL] ;SET UP STACK
MOVX S1,IB.SZ ;GET THE LENGTH
MOVEI S2,IPBBLK ;AND THE ADDRESS OF THE ARGS
$CALL I%INIT ;INITIALIZE THE WORLD
MOVEI S1,DATASZ ;GET THE SIZE OF THE DATA
MOVEI S2,OPRDAT ;START OF THE IMPURE DATA
$CALL .ZCHNK ;CLEAR THE DATA AREA
$CALL GETLOC ;GET OPRS LOCATION
SETOM HDRTAB ;INIT TO USE MAIN TABLES AND PROMPT
TOPS10< MOVE S1,[IPCLEV,,TIMVEC]> ;INTERRUPT LEVEL,,VECTOR OFFSET
TOPS20< MOVE S1,[IPCLEV,,TIMCHN]> ;GET LEVEL NUMBER AND TIMER CHANNEL
MOVE S2,IPBBLK+IB.INT ;GET INTERRUPT DATA BASE INFO
$CALL P$INIT## ;INIT THE PARSER
$CALL I%HOST ;GET HOST NAME
MOVEM S1,HOSTNM ;SAVE HOST NAME
$CALL TABCHK ;CHECK THE TABLES
$CALL OPRSON ;OPR SIGNON TO ORION
SETOM INTDSP ;INIT INTERRUPT DISPLAY FLAG
TOPS20 <
HRRZI S1,.MSIIC ;BYPASS MOUNT COUNTS
MSTR ;DO THE FUNCTION
ERJMP .+1 ;IGNORE THE ERROR
MOVEI S1,.FHSLF ;GET MY HANDLE
MOVX S2,1B<.ICIFT> ;INFERIOR TERMINATIONS
AIC ;ACTIVATE THE CHANNEL
> ;End TOPS20
TOPS10 <
MOVX T1,.PCDAT ;Interrupt function
MOVSI T2,DETINT-INTVEC ;Where the vector block is
MOVSI T3,DETLEV ;Set detach level
MOVX S1,PS.FAC+T1 ;Add address of arg. block to function
PISYS. S1, ;Enable interrupts on detach
JFCL ;Don't really care if it fails
> ;End of TOPS10
$CALL I%ION ;TURN ON INTERRUPTS
TXZE FLAG,O.CCL ;CCL ENTRY?
$CALL CCLOOK ;YES, LOOKUP ATO FILE
JRST MAIN ;START PROCESSING AT MAIN
SUBTTL CCLOOK CCL entry file lookup (TOPS10)
TOPS10 <
CCLOOK: STKVAR <<CCLFD,.FDPPN+1>> ;GET SOME SPACE FOR AN FD
MOVSI T1,.FDPPN+1 ;INIT THE FD HEADER
MOVEM T1,CCLFD
MOVSI T1,'SYS' ;LOAD INPUT DEVICE
GETLIN T2, ;LOAD TTY NAME
MOVX T3,%CNOPR ;GET THE NAME OF OPR
GETTAB T3, ; FROM THE MONITOR
JRST LOCAL ;SHOULD NEVER HAPPEN
CAMN T2,T3 ;ARE WE DEVOPR?
MOVSI T2,'OPR' ;YES--USE OPR.CMD
MOVE T3,T2 ;COPY TTY NAME
WHERE T3, ;GET OUR STATION NUMBER
JRST LOCAL ;DO NOT KNOW
MOVE T4,[SIXBIT /OPR0/] ;GET THE STATION NUMBER
WHERE T4, ; OF THE CENTRAL SITE
JRST LOCAL ;ONLY REMOTE STATIONS
CAMN T3,T4 ;ARE WE AT LOCAL STATION?
JRST LOCAL ;YES--USE OPR OR TTY
LSHC T3,-6 ;SHIFT I OCTIT INTO T4
LSH T3,3 ;SHIFT IN 3 ZEROS
LSHC T3,3 ;GENERATE SIXBIT
LSH T3,3
LSHC T3,3
ADDI T3,202020 ; ..
TRNN T3,570000 ;TRIM OFF LEADING ZEROS
LSH T3,6
TRNN T3,570000 ;LEADING ZERO
LSH T3,6 ;YES--TRIM IT OFF
HRLI T3,'OPR' ;PREFIX WITH OPR
MOVE T4,T3 ;COPY NAME OF OPR
DEVNAM T4, ;GET NAME OF OPR'S TTY
JRST LOCAL ;SO CLOSE
CAMN T2,T4 ;ARE WE OPRNN?
JRST [MOVE T2,T3 ;YES, USE OPRNN NOT TTY115
JRST LOCAL] ;AND GO FIND THE ATO FILE
MOVE T3,T2 ;COPY "TTYXXX"
GTNTN. T3, ;CONVERT TO NODE AND LINE NUMBERS
JRST LOCAL ;WHOOPS
MOVEI T4,2 ;DO THIS TWICE
ROT T3,^D9 ;GET RID OF HIGH BITS
MOVEI S1,3 ;DO THIS THRICE
LSH T2,3 ;MAKE SOME ROOM
LSHC T2,3 ;BRING IN A DIGIT
SOJG S1,.-2 ;FOR THREE DIGITS
SOJG T4,.-5 ;FOR BOTH HALVES
TDO T2,[SIXBIT/000000/] ;MAKE SIXBIT OUT OF IT
LOCAL: MOVSI T3,'CMD' ;LOAD EXTENSION
MOVEM T1,.FDSTR+CCLFD ;SAVE THE STRUCTURE
MOVEM T2,.FDNAM+CCLFD ;SAVE THE NAME
MOVEM T3,.FDEXT+CCLFD ;SAVE THE EXTENTION
SETZB T4,.FDPPN+CCLFD ;NO PPN
MOVEI S1,CCLFD ;POINT TO THE FD
SETZM S2 ;NO LOGGING FD
$CALL P$TAKE## ;SETUP TO TAKE FILE
$RETIF ;IGNORE FAILURES
SETOM S2 ;GET EXACT FD
$CALL F%FD
$TEXT (,<[Processing ^F/(S1)/]>)
$RETT
> ;End TOPS10
TOPS20 <
CCLOOK: $RETT ;NO CCL ENTRY ON TOPS20
> ;End TOPS20
SUBTTL MAIN Main processing loop
MAIN: $CALL PRCMSG ;PROCESS ANY MESSAGES
TOPS20 <
SKIPE FRKRUN ;FORK RUNNING WITH EXEC
JRST MAIN.7 ;YES GO TO SLEEP
SKIPN REMACC ;REMOTE OPR?
JRST MAIN.1 ;NO..IGNORE REMOTE CHECKS
SKIPE OUTCON ;OUTPUT CONNECTED?
$CALL CONNEC ;CHECK OUT CONNECT
SKIPN INPDON ;INPUT DONE...READ THE DATA
JRST MAIN.7 ;GO TO SLEEP
$CALL INPDAT ;INPUT THE DATA
JUMPF MAIN.7 ;FAIL..GO TO SLEEP
> ;End TOPS20
MAIN.1: $CALL TABSET ;SETUP THE PARSER BLOCK
MAIN.2: DMOVE S1,P1 ;GET THE PARSER ARGUMENTS
$CALL PARSER## ;CALL THE PARSER
MOVE P3,S2 ;SAVE THE ADDRESS OF BLOCK
JUMPF MAIN.5 ;COMMAND ERROR ON PARSER
$CALL DSPCMD ;DISPLAY COMMAND IF NEEDED
MOVE T1,PRT.CM(P3) ;ADDRESS OF COMMAND MESSAGE
MOVE T2,MYNODE ;GET MYNODE FOR MESSAGE
MOVEM T2,COM.SN(T1) ;SAVE IN THE MESSAGE
SKIPE T2,TABCOD ;WAS THERE A TABLE CODE
MOVEM T2,COM.TY(T1) ;SAVE AS TYPE FOR APPLICATION
MAIN.3: MOVE S1,T1 ;MESSAGE TO SEND
MAIN.S: $CALL I%SOPR ;SEND TO ORION
JUMPT MAIN ;O.K. JUST RESTART
$TEXT (,<Send to ORION failed>)
$CALL EXIT ;HALT THE PROGRAM
MAIN.4: MOVE S1,T1 ;PUT PAGE ADDRESS IN S1
$CALL M%RPAG ;RETURN THE PAGE
JRST MAIN ;CHECK MESSAGES AND COMND
MAIN.5: MOVE T1,PRT.FL(P3) ;GET RETURNED FLAGS
TXNE T1,P.INTE ;INTERRUPT BREAK OUT
JRST [AOS INTDSP ;SET FLAG FOR DISPLAY
JRST MAIN] ;AND CHECK FOR MESSAGES
TXNE T1,P.ENDT ;END OF TAKE FILE
JRST [$CALL TAKEND ;END THE TAKE COMMAND
JRST MAIN.S] ;SEND THE MESSAGE AND CONTINUE
$CALL CHKDSP ;CHECK TO DISPLAY
JUMPF MAIN.6 ;NO..DON'T
$CALL SETOUT ;SETUP FOR OUTPUT
$TEXT (,<^I/CMDPMT/^T/@PRT.MS(P3)/^A>)
SKIPA ;ALREADY SETUP
MAIN.6: $CALL SETOUT ;SETUP THE OUTPUT
MOVX S1,CM%ESC ;GET THE ESCAPE FLAG
SKIPN REMACC ;REMOTE OPR?? ALWAYS CR,LF
TDNE S1,PRT.CF(P3) ;WAS LAST CHARACTER AN ESCAPE?
$TEXT (,<>) ;CR,LF OUTPUT
MOVE S1,ERRSTG## ;GET THE ERROR STRING
CAME S1,[-1] ;OUTPUT IT ???
$TEXT (,<? ^T/@PRT.EM(P3)/>) ;YES, OUTPUT ERROR MESSAGE..NOT TAKE
$CALL SNDOUT ;SEND THE OUTPUT
JRST MAIN ;TRY AGAIN
MAIN.7: SETZ S1, ;CLEAR S1 FOR SLEEP
$CALL I%SLP ;GO TO SLEEP
SETOM INTDSP ;SET DISPLAY FLAG FORCE .CMINI
JRST MAIN ;GET DATA
CMDPMT: ITEXT (<^M^J^T/@PARBLK+PAR.PM/>)
SUBTTL TAKEND Process end of TAKE command
;THIS ROUTINE WILL TELL ORION THAT THE TAKE FILE IS FINISHED SO
;THAT INCASE THERE IS A SEND ERROR TO COMPONENT THE FILE CAN
;BE ABORTED
;RETURN S1/ MESSAGE ADDRESS FOR ORION
TAKEND: SETZM TAKFLG ;CLEAR TAKE FLAG
$CALL M%GPAG ;GET A PAGE OF MEMORY
MOVX S2,.OMTKE ;GET TAKE END CODE
STORE S2,.MSTYP(S1),MS.TYP ;SAVE THE TYPE
MOVEI S2,.OHDRS ;MINIMUM SIZE BLOCK
STORE S2,.MSTYP(S1),MS.CNT ;SAVE THE LENGTH
$RETT ;RETURN
SUBTTL DSPCMD Display TAKE commands if desired
;THIS ROUTINE WILL CHECK THE DISPLAY SETTINGS FROM THE TAKE AND
;FROM THE TAKE DEFAULT DISPLAY AND DISPLAY COMMANDS IF SET
DSPCMD: $CALL CHKDSP ;CHECK IF NEED TO DISPLAY
JUMPF .RETT ;RETURN O.K.
MOVE T1,PRT.CM(P3) ;ADDRESS OF MESSAGE
$CALL SETOUT ;SETUP FOR OUTPUT
MOVE T2,COM.CM(T1) ;GET TEXT OFFSET
ADDI T2,1(T1) ;POINT TO START OF STRING
$TEXT (,<^I/CMDPMT/^T/(T2)/^A>) ;OUTPUT THE COMMAND
$CALL SNDOUT ;SEND THE OUTPUT
$RET ;RETURN
CHKDSP: MOVE T1,PRT.FL(P3) ;GET FLAG WORD
TXNE T1,P.TAKE ;TAKE COMMAND ITSELF
JRST CHKD.1 ;YES..SET FLAG AND RETURN FALSE
TXC T1,P.CTAK!P.ERRO ;FROM TAKE AND AN ERROR
TXCN T1,P.CTAK!P.ERRO ;BOTH WERE SET
$RETT ;YES..DISPLAY THE TEXT
TXNN T1,P.DSPT ;DISPLAY TAKE COMMAND
$RETF ;RETURN FALSE
$RETT ;O.K. RETURN TRUE
CHKD.1: SETOM TAKFLG ;IN TAKE COMMAND
$RETF ;RETURN FALSE
SUBTTL PRCMSG Process IPCF messages
PRCMSG: SETZM MSGCNT ;CLEAR THE COUNT
PRCM.0: $CALL C%RECV ;GO RECEIVE A MESSAGE
$RETIF ;NO MORE MESSAGES, RETURN
$CALL VALMSG ;VALIDATE THE MESSAGE
JUMPF PRCM.1 ;NO GOOD..PITCH THE MESSAGE
LOAD M,MDB.MS(S1),MD.ADR ;GET MESSAGE ADR.
$CALL DSPRTN ;FIND PROCESSING ROUTINE
;RETURN S1 WITH ADDRESS
JUMPF PRCM.1 ;FALSE RETURN..IGNORE PROCESSING
$CALL (S1) ;OTHERWISE, CALL THE ROUTINE
AOS MSGCNT ;BUMP THE MESSAGE COUNT
PRCM.1: $CALL C%REL ;FOR NOW IF WE FAIL TO FIND
JRST PRCM.0 ;LOOP BACK FOR MORE MESSAGES
DSPTAB: .OMDSP,,DSPOPD
.OMWTR,,WTRDSP
.OMACS,,SHWDSP
MT.TXT,,ACKOPR
DSPLEN==.-DSPTAB
DSPRTN: LOAD S2,.MSTYP(M),MS.TYP ;GET MESSAGE TYPE
MOVSI T1,-DSPLEN ;LENGTH OF DISPATCH TABLE
DSPR.1: HLRZ S1,DSPTAB(T1) ;GET TYPE FROM TABLE
CAIN S2,(S1) ;MATCH??
JRST DSPR.2 ;YES..SETUP S1 AND EXIT
AOBJN T1,DSPR.1 ;TRY NEXT ONE
$RETF ;FALSE RETURN
DSPR.2: HRRZ S1,DSPTAB(T1) ;GET PROCESSING ADDRESS
$RETT ;RETURN TRUE
SUBTTL VALMSG Validate a message from ORION
;THIS ROUTINE WILL MAKE SURE THE MESSAGE RECEIVED IS FROM ORION.
;IF NOT, THE ROUTINE WILL RETURN FALSE
VALMSG: LOAD T1,MDB.SI(S1) ;SYSTEM PID INDEX WORD
TXZN T1,SI.FLG ;FROM A SYSTEM PID
$RETF ;NO..RETURN FALSE
CAIE T1,SP.OPR ;FROM ORION
$RETF ;NO..RETURN FALSE
$RETT ;YES..O.K. SO FAR
SUBTTL ACKOPR Display a GALAXY text message
ACKOPR: LOAD S1,.MSFLG(M) ;GET THE FLAGS
TXNE S1,MF.NOM ;IS THIS A NULL ACK?
$RET ;YES, JUST RETURN NOW
SKIPG T1,.OARGC(M) ;VALID ARGUMENT COUNT
$RETF ;NO JUST RETURN
LOAD T1,ARG.HD+.OHDRS(M),AR.TYP ;GET ARGUMENT TYPE
CAIE T1,.CMTXT ;IS IT TEXT
$RETF ;NO...RETURN
LOAD T1,ARG.HD+.OHDRS(M),AR.LEN ;GET THE LENGTH CODE
ADDI T1,.OHDRS ;LENGTH OF MESSAGE
LOAD T2,.MSTYP(M),MS.CNT ;GET MESSAGE LENGTH
CAMLE T1,T2 ;MESSAGE IN BOUNDS
$RETF ;NO..IGNORE MESSAGE
MOVEI T1,ARG.DA+.OHDRS(M) ;ADDRESS OF DATA
$CALL SETOUT ;SETUP FOR OUTPUT
$TEXT (,<
^C/[-1]/ --^T/(T1)/-->) ;OUTPUT TEXT
HRRZ S1,.MSFLG(M) ;GET ERROR CODE
CAIE S1,'ONS' ;OPR NOT SETUP
PJRST SNDOUT ;SEND OUTPUT AND RETURN
TOPS20 <
SKIPE REMOPR ;REMOTE OPERATOR?
$CALL EXIT ;TERMINATE
> ;End TOPS20
$TEXT (,< ..OPR restarting..>) ;INFORM THE OPERATOR
JRST OPR ;RESTART THE WORLD
SUBTTL DSPOPD Process DISPLAY message from ORION
WTRDSP: SETOM T3 ;SET WTOR FLAG
SKIPA ;SKIP OVER DISPLAY ENTRY
DSPOPD: SETZM T3 ;NO WTOR FLAG
SKIPN T1,.OARGC(M) ;GET ARGUMENT COUNT
STOPCD (IAC,HALT,,<Argument count in T1 not valid in display message>)
MOVEI T2,.OHDRS+ARG.HD(M) ;ADDRESS OF FIRST ARGUMENT
$CALL SETOUT ;SETUP FOR OUTPUT
DSPO.1: LOAD S1,ARG.HD(T2),AR.TYP ;GET THE TYPE FIELD
CAIE S1,.ORDSP ;IS IT DISPLAY
JRST DSPO.3 ;NO CHECK FOR TEXT
$TEXT (,<^M^J^C/ARG.DA(T2)/ ^A>)
MOVEI S1,ARG.DA+1(T2) ;ADDRESS OF THE TEXT
DSPO.2: $CALL DSPMSG ;OUTPUT THE TEXT
LOAD S2,ARG.HD(T2),AR.LEN ;GET LENGTH OF BLOCK
ADD T2,S2 ;BUMP TO NEXT BLOCK
SOJG T1,DSPO.1 ;GET NEXT BLOCK
SKIPE T3 ;WAS IT A WTOR?
$TEXT(,<^A>) ;RING THE BELLS
PJRST SNDOUT ;SEND THE OUTPUT AND RETURN
DSPO.3: CAIE S1,.CMTXT ;WAS IT JUST TEXT
STOPCD (IDM,HALT,,<Message argument type in S1 not valid for display messages>)
MOVEI S1,ARG.DA(T2) ;ADDRESS OF TEXT
JRST DSPO.2 ;OUTPUT THE TEXT
DSPMSG:
TOPS20 <
SKIPE REMACC ;REMOTE OPR
PJRST DSPM.1 ;OUTPUT THE DATA
> ;End TOPS20
PJRST K%SOUT ;NO..SOUT IT
TOPS20 <
DSPM.1: $TEXT (,<^T/(S1)/^A>) ;DUMP THE DATA
$RETT ;RETURN
> ;End TOPS20
SUBTTL SHWDSP Process DISPLAY message from ORION
SHWDSP: SKIPN T1,.OARGC(M) ;GET ARGUMENT COUNT
JRST S..IAC ;INVALID COUNT
MOVEI T2,.OHDRS+ARG.HD(M) ;ADDRESS OF FIRST ARGUMENT
SHWD.1: LOAD S1,ARG.HD(T2),AR.TYP ;GET THE TYPE FIELD
CAIE S1,.ORDSP ;IS IT DISPLAY
JRST SHWD.3 ;NO CHECK FOR TEXT
$CALL SETOUT ;SETUP FOR OUTPUT
$TEXT (,<^M^J^C/ARG.DA(T2)/ --^T/ARG.DA+1(T2)/-->)
SKIPA ;GET NEXT ARGUMENT
SHWD.2: $CALL DSPMSG ;OUTPUT THE TEXT
LOAD S2,ARG.HD(T2),AR.LEN ;GET LENGTH OF BLOCK
ADD T2,S2 ;BUMP TO NEXT BLOCK
SOJG T1,SHWD.1 ;GET NEXT BLOCK
PJRST SNDOUT ;SEND THE OUTPUT
SHWD.3: CAIE S1,.CMTXT ;WAS IT JUST TEXT
JRST S..IDM ;INVALID DISPLAY MESSAGE TYPE
MOVEI S1,ARG.DA(T2) ;ADDRESS OF TEXT
JRST SHWD.2 ;OUTPUT THE TEXT
SUBTTL TABSET Setup tables for parser call
;THIS ROUTINE WILL SET UP THE DEFAULT TABLES AND THE DEFAULT
;PROMPT
;AND RETURN ARGUMENTS IN P1 AND P2
TABSET:
TOPS20 <
SKIPE REMOPR ;REMOTE OPERATOR
PJRST TABS.3 ;YES..SETUP FOR REMOTE OPERATOR
> ;End TOPS20
SKIPE HDRTAB ;USING THE HEAD TABLES(OPR TABLES)
JRST TABS.1 ;YES..SET UP PARSER ARGUMENTS
MOVE S1,ENTCOD ;APPLICATION TYPE
MOVEM S1,TABCOD ;SAVE THE VALUE FOR MESSAGES
MOVE S1,DEFTAB ;GET THE DEFAULT TABLES FOR CALL
AOS S1 ;POSITION OVER THE HEADER
STORE S1,.CMFNP+MANTAB+1,CM%LST ;SAVE AS ALTERNATE TO MAIN TABLE
PUSHJ P,P$TSBC## ;TEST FOR PREVIOUS SUB-COMMAND MODE
JUMPT TABS.A ;GOT TABLE HDR AND PROMPT IN S1 & S2
MOVEI S1,TABINI ;ADDRESS OF MAIN TABLE INIT
MOVEI S2,HDRPMT ;GET MAIN PROMPT
TABS.A: MOVEM S1,PARBLK+PAR.TB ;SAVE IN PARSER CALL BLOCK
TABS.0: MOVEM S2,PARBLK+PAR.PM ;SAVE THE PROMPT IN BLOCK
MOVEI P1,PAR.PM+1 ;SIZE OF THE BLOCK
MOVEI P2,PARBLK ;PARSER BLOCK
SKIPN TAKFLG ;IN A TAKE FILE
SKIPG INTDSP ;ANY MESSAGES DISPLAYED
$RETT ;RETURN
SKIPG MSGCNT ;ANY MESSGES PROCESSED
$RETT ;NO.. FORCE OUT THE PROMPT
MOVE S1,PARBLK+PAR.TB ;GET TABLE ADDRESS
$CALL P$PNXT## ;GET THE NEXT PDB
MOVEM S1,PARBLK+PAR.TB ;SAVE TABLE ADDRESS
SETZM INTDSP ;CLEAR THE FLAG
$RETT ;RETURN
TABS.1: SETZM TABCOD ;CLEAR FIELD FOR MAIN TABLES
MOVE S1,SYNTAB ;ADDRESS OF MAIN TABLES
MOVE T1,TAB.IN(S1) ;ADDRESS OF .CMINI FOR TABLES
STORE T1,PARBLK+PAR.TB ;SAVE THE TABLE ADDRESS
HLRZ T2,KEYAP1 ;APPLICATION KEYWORD TABLE
SKIPN T2 ;ANY ENTRIES IN TABLE
JRST TABS.2 ;NO..DON'T SET UP ALTERNATE
MOVE T3,TAB.KY(S1) ;GET MAIN KEYWORD TABLE
MOVEI T2,APLTAB ;ADDRESS OF THE TABLE PDB
AOS T2 ;POSITION TO THE DATA
STORE T2,.CMFNP+1(T3),CM%LST ;SAVE AS ALTERNATE TABLE
TABS.2: MOVE S2,OPRPMT ;ADDRESS OF THE PROMPT
JRST TABS.0 ;FINISH AND RETURN
TOPS20 <
TABS.3: MOVE S1,SYNTAB ;ADDRESS OF MAIN TABLES
MOVE T1,TAB.IN(S1) ;ADDRESS OF .CMINI FOR TABLES
STORE T1,PARBLK+PAR.TB ;SAVE THE TABLE ADDRESS
MOVE S1,OPRPMT ;GET THE OPR PROMPT
MOVEM S1,PARBLK+PAR.PM ;SAVE THE PROMPT
MOVSI S1,(POINT NETBSZ,) ;NETBSZ BIT BYTES
HRR S1,NETBUF ;GET DATA ADDRESS
MOVEM S1,PARBLK+PAR.SR ;SAVE SOURCE POINTER
MOVEI P1,PAR.SZ ;SIZE OF THE BLOCK
SKIPN REMACC ;REMOTE ACCESS LINK?
MOVEI P1,PAR.PM+1 ;NO..USE MINIMUM SIZE BLOCK
MOVEI P2,PARBLK ;ADDRESS OF PARSER BLOCK
$RETT ;RETURN
> ;End TOPS20
SUBTTL Software interrupt system routines
;ROUTINE CALLED ON AN INTERRUPT
INT: $BGINT IPCLEV ;BEGIN AN INTERRUPT
MOVEI S1,PRCMSG ;INTERRUPT ROUTINE TO EXECUTE
PUSHJ P,P$INTR## ;PARSER INTERRUPT SUPPORT
$CALL C%INTR ; FLAG RECEIPT OF IPCF INTERRUPT
$DEBRK ; EITHER RETURN TO SEQUENCE
; OR CHANGE PC AND HANDLE THE INTERRUPT
TOPS10<
DET: $BGINT DETLEV ;Begin processing attach/det interrupts
MOVE S1,DETINT+.PSVIS ;Get status word
CAME S1,[-1] ;Attach?
$DEBRK ;Yes, dismiss the interrupt
JRST EXTACT ;Finish all at interrupt level
> ; End of TOPS10
SUBTTL Command and application action routines
;THESE ROUTINES WILL BE GIVEN CONTROL ON A KEYWORD
;FROM THE MAIN COMMAND TABLES (CMDACT) AS WELL AS FROM AN
;APPLICATION KEYWORD TYPED WHILE USING THE MAIN TABLES.
CMDACT:: SETZM TABCOD ;CLEAR THE CODE TYPE FOR THESE
;ENTRIES
MOVE T1,CR.SAV(S2) ;GET THE ADDRESS OF SAVED ELEMENT
MOVE T1,ARG.DA(T1) ;GET THE VALUE
MOVEM T1,CMDCOD## ;SAVE THE COMMAND CODE
CAXN T1,.KYCTZ ;Control-Z exit ?
PJRST EXTACT ;Yes - say good-bye to ORION
$RETT ;RETURN TRUE
APLACT: MOVE T1,CR.SAV(S2) ;GET THE ADDRESS OF SAVED ELEMENT
MOVE T1,ARG.DA(T1) ;GET THE VALUE
MOVEM T1,TABCOD ;SAVE THE CODE
MOVE T2,ARGFRE## ;GET LAST ARGUMENT POINTER ADDRESS
SUBI T2,2 ;BACK OVER APPLICATION NAME..REMOVE
MOVEM T2,ARGFRE## ;RESTORE POINTER
$RETT ;RETURN
SUBTTL ENTER and RETURN command tables
INTERNAL ENTFDB
ENTFDB: $NOISE(ENT010,<command subset>,<$PREFILL(ENTCHK)>)
ENT010: $KEYDSP(ENTTAB,<$ACTION(ENTRTN)>)
DEFINE X(A,B,C,D),<ORNDSP(ENT020,<A>,<B>)>
;TABLE MUST BE IN DSPTAB FORMAT ****
ENTTAB: $STAB
TABAPL ;EXPAND APPLICATION TABLES
$ETAB
ENT020: $CRLF(<$ACTION(ENTER)>)
ENTCHK: SKIPN REMOPR ;IS IT A REMOTE OPERATOR
$RETT ;NO..ASSUME O.K.
MOVEI S2,[ASCIZ/ENTER command not allowed for remote operators/]
$RETF ;RETURN FALSE
ENTRTN: MOVE T1,CR.RES(S2) ;GET THE RESULT
MOVEM T1,CMDDAT ;SAVE THE DATA
$RETT ;RETURN TRUE
ENTER: MOVE T1,CMDDAT ;GET THE DATA WORD
HLRZ T2,(T1) ;GET POINTER TO THE STRING
$TEXT (<-1,,HDRPMT>,<^T/(T2)/^7/[76]/^0>)
SETZM HDRTAB ;IN APPLICATION MODE
HRRZ T2,(T1) ;GET ADDRESS OF CODE WORD
HLRZ T2,(T2) ;GET THE SYMBOL VALUE
MOVEM T2,ENTCOD ;SAVE THE CODE
MOVE T3,T2 ;PLACE IN T3
ANDI T3,77 ;GET THE TABLE INDEX FROM CODE
MOVE T3,SYNTAB(T3) ;ADDRESS OF THE TABLES
MOVE T4,TAB.KY(T3) ;GET MAIN KEYWORD TABLE
MOVEM T4,DEFTAB ;SAVE AS DEFAULT TABLES
PJRST P$NPRO## ;NO PROCESSING REQUIRED
RETFDB: $NOISE(RET010,<to operator command level>)
RET010: $CRLF(<$ACTION(RETURN)>)
RETURN: SKIPE HDRTAB ;SHOULD BE IN APPLICATION TABLES
$RETF ;ERROR..RETURN FALSE TO ABORT
SETOM HDRTAB ;SET FOR MAIN TABLES
SETZM TABCOD ;CLEAR CODE FOR APPLICATION
PJRST P$NPRO## ;NO PROCESSING REQUIRED
SUBTTL Control-Z and EXIT command tables and action routines
EXTFDB:: $NOISE(EXT010,<to monitor level>)
EXT010: $CRLF(<$ACTION(EXTACT)>)
; Action routine called by CMDACT on a ^Z command and by the parser
; on an EXIT command.
;
EXTACT: MOVX S1,E.EXIT ;EXIT COMMAND ISSUED
MOVEM S1,ERRCOD ;SAVE THE CODE
$CALL SETFAL ;SEND THE SHUTDOWN MESSAGE AND HALT
JRST OPR ;RESTART THE JOB
SUBTTL TAKOPR Process a take command
;THIS ROUTINE WILL CHECK TAKE AUTHORIZATION BEFORE
;PROCEEDING WITH THE PARSE
TAKOPR:: $CRLF(<$PREFILL(TAKO.1),$ALTERNATE(TAKFDB##)>)
TAKO.1: SKIPN REMOPR ;REMOTE OPR?
JRST TAKO.2 ;NO..MODIFY THE PDB
MOVEI S2,[ASCIZ/TAKE command not allowed for remote operators/]
$RETF ;RETURN FALSE
TAKO.2: MOVEI S1,TAKFDB## ;GET THE TAKE ADDRESS
AOS S1 ;BUMP OVER THE HEADER
STORE S1,CR.PDB(S2),RHMASK ;SAVE NEW PDB TO USE
$RETT ;RETURN
SUBTTL WAIOPR Process a wait command
;THIS ROUTINE WILL CHECK WAIT AUTHORIZATION BEFORE
;PROCEEDING WITH THE PARSE
WAIOPR:: $CRLF(<$PREFILL(WAIO.1),$ALTERNATE(WAIFDB##)>)
WAIO.1: SKIPN REMOPR ;REMOTE OPR?
JRST WAIO.2 ;NO..MODIFY THE PDB
MOVEI S2,[ASCIZ/WAIT command not allowed for remote operators/]
$RETF ;RETURN FALSE
WAIO.2: MOVEI S1,WAIFDB## ;GET THE WAIT ADDRESS
AOS S1 ;BUMP TO PDB
STORE S1,CR.PDB(S2),RHMASK ;SAVE NEW PDB TO USE
$RETT ;RETURN
SUBTTL SETRTN and SETTRM Process SET TERMINAL command
;THESE ROUTINES WILL SETUP THE TERMINAL DATA AND
;ON THE CONFIRM SETTRM WILL PROCESS THE DATA
SETRTN:: MOVE T1,CR.SAV(S2) ;GET THE ADDRESS OF SAVED ELEMENT
MOVE T1,ARG.DA(T1) ;GET THE VALUE
MOVEM T1,CMDDAT ;SAVE THE COMMAND DATA
$RETT ;RETURN TRUE
SETTRM:: MOVE S1,CMDDAT ;GET THE DATA WORD
CAIN S1,.KYKPD ;WAS IT TO SET KEYPAD
PJRST SETKPD ;YES..SETUP KEYPAD MODE
CAIN S1,.KYNKP ;WAS IT NOKEYPAD
PJRST SETNKP ;YES..SETUP NOKEYPAD MODE
$CALL K%STYP ;SET THE TERMINAL TYPE
JUMPF SETT.3 ;GIVE ERROR IF BAD TTY TYPE
SETRET: PJRST P$NPRO## ;NO PROCESSING REQUIRED
SETT.3: MOVEI S2,[ASCIZ/Terminal type setup failed/]
$RETF ;RETURN FALSE TO ABORT
SETT.4: MOVEI S2,[ASCIZ/Terminal keypad function setup failure/]
$RETF ;RETURN FALSE TO ABORT
;HERE ON SET TERMINAL KEYPAD
SETKPD: MOVEI S1,ESCTAB ;GET ADDRESS OF ESCAPE TABLE
$CALL K%SUET ;SET TABLE ADDRESS
JUMPF SETT.4 ;COULD NOT DO..ERROR
PJRST SETRET ;SET RETURN
;HERE ON SET TERMINAL NOKEYPAD
SETNKP:: MOVEI S1,0 ;CLEAR TABLE ADDRESS
$CALL K%SUET ;DO IT
JUMPF SETT.4 ;COULD NOT DO..ERROR
PJRST SETRET ;SET RETURN
SUBTTL ESCAPE Sequence Table for Operator Terminals
TOPS10 <
ESCTAB: EXP EF.TBL!2 ;Only two possible second characters
[EXP "O","?"]
[EXP ANSAC1,V52AC1] ;Point to real tables
ANSAC1: EXP EF.TBL!ANSLTH ;Lenght of real table
EXP ANSTBL ;Address of character table
EXP ANSACT ;Address of action routine
V52AC1: EXP EF.TBL!V52LTH ;Same for VT52s
EXP V52TBL
EXP V52ACT
DEFINE KEYGEN(CHAR,SEQ)<
XX q,ANSFN1,ANSFN1
XX r,ANSFN2,ANSFN2
XX s,ANSFN3,ANSFN3
XX t,ANSFN4,ANSFN4
XX u,ANSFN5,ANSFN5
XX w,ANSFN7,V52FN7
XX x,ANSFN8,ANSFN8
XX y,ANSFN9,ANSFN9
>;;End of KEYGEN
DEFINE XX(A,B,C)<EXP "'A">
V52TBL:
ANSTBL: KEYGEN
DEFINE XX(A,B,C)<EXP B>
ANSACT: KEYGEN
ANSLTH==.-ANSACT
DEFINE XX(A,B,C)<EXP C>
V52ACT: KEYGEN
V52LTH==.-V52ACT
ANSFN1: EXP EF.IST!<7,,[ASCIZ /SHOW STATUS
/]>
ANSFN2: EXP EF.IST!<7,,[ASCIZ/SHOW QUEUES
/]>
ANSFN3: EXP EF.IST!<7,,[ASCIZ/SHOW PARAMETERS
/]>
ANSFN4: EXP EF.IST!<7,,[ASCIZ/SHOW MESSAGES
/]>
ANSFN5: EXP EF.IST!<7,,[ASCIZ/SHOW ROUTE-TABLE
/]>
ANSFN7: EXP EF.LST!ANSBLK
ANSFN8: EXP EF.IST!<7,,[ASCIZ/SHOW OPERATORS
/]>
ANSFN9: EXP EF.IST!<7,,[ASCIZ/SHOW QUEUE MOUNT-REQUESTS
/]>
V52FN7: EXP EF.LST!V52BLK ;Point to the erase screen sequence
V52BLK: EXP B52LTH ;Lenght of the table
EXP EF.OST!<7,,[BYTE (7).CHESC,"H",.CHESC,"J",.CHNUL]>
EXP EF.IST!<7,,[BYTE (7).CHCNR,.CHNUL]>
B52LTH==.-V52BLK
ANSBLK: EXP B10LTH
EXP EF.OST!<7,,[BYTE (7).CHESC(14)"[H"(7).CHESC,"[","J",.CHNUL]>
EXP EF.IST!<7,,[BYTE (7).CHCNR,.CHNUL]>
B10LTH==.-ANSBLK
> ;End TOPS10
TOPS20 <
$DATA ESCTAB,1 ;NULL ESCAPE TABLE
> ;End TOPS20
SUBTTL SHWDAY Process SHOW DAYTIME command
SHWDAY:: $CALL SETOUT ;SETUP THE OUTPUT
$TEXT (,<^H/[-1]/>)
$CALL SNDOUT ;SEND THE OUTPUT
PJRST P$NPRO## ;NO PROCESSING REQUIRED
SUBTTL OPRRMT Entry and initialization for REMOTE OPR
TOPS10 <
OPRRMT: JRST OPR ;ASSUME START
> ;End TOPS10
TOPS20 <
OPRRMT: RESET ;RESET THE UNIVERSE
MOVEM T1,INPJFN ;INPUT JFN FOR LINK
MOVEM T2,MYNODE ;MY NODE
MOVE P,[IOWD PDLEN,PDL] ;SET UP STACK
MOVX S1,IB.SZ ;GET THE LENGTH
MOVEI S2,IPBRMT ;AND THE ADDRESS OF THE ARGS
$CALL I%INIT ;INITIALIZE THE WORLD
SETOM HDRTAB ;INIT TO USE MAIN TABLES AND PROMPT
SETZB S1,S2 ;CLEAR S1 AND S2.. NO ARGUMENTS
$CALL P$INIT## ;CALL THE PARSER
$CALL I%HOST ;GET HOST NAME
MOVEM S1,HOSTNM ;SAVE HOST NAME
$CALL TABCHK ;CHECK THE TABLES
SETOM REMOPR ;REMOTE OPERATOR FLAG
$CALL OPRSON ;OPR SIGNON TO ORION
MOVE S1,[IPCLEV,,IPCRMT] ;REMOTE IPCF INTERRUPT ROUTINE
MOVEM S1,CHNTAB+1 ;SAVE IN CHANNEL TABLE
$CALL I%ION ;TURN ON INTERRUPTS
$CALL REMSET ;SETUP OPR LINKS
$CALL WAITCN ;WAIT FOR THE CONNECT
PJRST MAIN ;PROCESS NORMALLY
;DELETE ENTRY IN TABLES ***
> ;End TOPS20
SUBTTL WAITCN Wait for output link connect
;THIS ROUTINE WILL WAIT FOR THE CONNECT ON THE OUTPUT LINK
;BEFORE INITIALIZING THE PROCESS
TOPS20 <
WAITCN: SKIPE OUTCON ;OUTPUT CONNECTED
JRST WAIT.1 ;PROCESS CONNECT AND RETURN
MOVEI S1,5 ;WAIT FOR 5 SECONDS
$CALL I%SLP ;SLEEP FOR A BIT
JRST WAITCN ;WAIT FOR THE CONNECTION
WAIT.1: PJRST CONNEC ;DO CONNECT AND RETURN
> ;End TOPS20
SUBTTL REMSET Setup OPR links
;THIS ROUTINE WILL SETUP ALL LINKS AND INTERRUPTS FOR THE REMOTE
;OPERATOR
TOPS20 <
REMSET: SETOM REMACC ;SET AS REMOTE ACCESS
$TEXT (<-1,,DCNDAT>,<DCN:^N/MYNODE/-^D/[DCNTSK]/^0>)
MOVX S1,GJ%SHT ;SHOT JFN
HRROI S2,DCNDAT ;GET DATA
GTJFN ;OPEN THE FILE
PJRST REMS.1 ;OPEN FAILED
MOVEM S1,OUTJFN ;SAVE OUTPUT JFN
MOVE S2,[FLD(NETBSZ,OF%BSZ)+OF%RD+OF%WR]
OPENF ;OPEN THE LINK
PJRST REMS.1 ;OPEN FAILED
MOVE S1,OUTJFN ;GET THE JFN
MOVEI S2,.MOACN ;ACTIVATE CHANNEL
MOVX T2,OUTCHN ;OUTPUT CHANNEL
SETZM T1 ;CLEAR T1
STORE T2,T1,MO%CDN ;CONNECT INTERRUPTS
MTOPR ;DO THE FUNCTION
ERJMP REMS.2 ;HALT IF FAILS
MOVE S1,[IPCLEV,,OUTINT] ;INTERRUPT ENTRY IN CHNTAB
MOVEM S1,CHNTAB+OUTCHN ;SAVE IN CHANNEL TABLE
;edit 73
; MOVE S1,INPJFN ;GET THE INPUT CHANNEL JFN
; MOVEI S2,.MOACN ;ACTIVATE CHANNEL
; MOVX T2,INPCHN ;OUTPUT CHANNEL NUMBER
; SETZM T1 ;CLEAR T1
; STORE T2,T1,MO%DAV ;SAVE FOR DATA INTERRUPTS
; MTOPR ;ACTIVATE THE CHANNEL
; ERJMP [HALTF] ;FAIL ..ABORT
MOVE S1,[IPCLEV,,INPINT] ;INPUT DATA INTERRUPT
MOVEM S1,CHNTAB+INPCHN ;SAVE IN CHANNEL TABLE
MOVE S1,INPJFN ;GET THE INPUT JFN
MOVX S2,.MOCC ;ACCEPT THE CONNECT
SETZM T1 ;CLEAR OTHER FLAGS
MTOPR ;CONFIRM THE CONNECT
ERJMP REMS.3 ;ERROR..ABORT
MOVX S1,.FHSLF ;GET MY HANDLE
MOVX S2,<1B<OUTCHN>!1B<INPCHN>>;ACTIVATE THE CHANNELS
AIC ;TURN ON CHANNELS
MOVEI S1,<<OUTSIZ/<^D36/NETBSZ>>+1>;NUMBER OF WORDS NEEDED
MOVE T1,S1 ;SAVE THE VALUE
$CALL M%GMEM ;GET THE MEMORY
MOVEM S2,BUFADR ;SAVE THE BUFFER ADDRESS
MOVE S1,T1 ;GET SIZE OF BUFFER
$CALL M%GMEM ;GET INPUT BUFFER
MOVEM S2,NETBUF ;NETWORK BUFFER
;***WAIT FOR CONNECT ON OUTPUT LINK
$RET ;RETURN
REMS.1: MOVX S1,E.OPNF ;OPEN FAILURE
MOVEM S1,ERRCOD ;SAVE THE CODE
PJRST SETFAL ;SETUP FAILURE RETURN WITH ERROR
REMS.2: MOVX S1,E.CONF ;CONNECT FAILURE
MOVEM S1,ERRCOD ;SAVE THE CODE
PJRST SETFAL ;SETUP FAILURE ABORT
REMS.3: MOVX S1,E.ACFL ;ACCEPT CONNECT FAILED
MOVEM S1,ERRCOD ;SAVE THE CODE
PJRST SETFAL ;ABORT AND SEND FAILURE
> ;End TOPS20
SUBTTL SETOUT Setup output of data
; This routine is called (it appears) before every output. For local
;operators it clears the output suppress bit if on. For remote nodes
;it will set up the appropriate headers.
TOPS20 <
SETOUT:: SKIPN REMACC ;REMOTE OPERATOR?
JRST SETO.1 ;No, go do the suppress check
$CALL SETPTR ;SETUP THE POINTER
MOVX S2,1 ;COMPLETE RESPONSE CODE
IDPB S2,S1 ;SAVE THE BYTE
MOVEM S1,OUTPTR ;SAVE THE POINTER
$TEXT (,<^M^J^N/HOSTNM/::^A>) ;OPR HEADER LINE
$RET ;RETURN
SETO.1: MOVX S1,.PRIOU ;Local so lets clear ^O
DOBE ;Wait till done with previous
RFMOD ;Get mode word
TXZE S2,TT%OSP ;Turn echo back on (if off)
SFMOD ;Set mode word if needed
$RET ;Return
> ;End TOPS20
TOPS10 <
SETOUT:: $RET ;RETURN
> ;End TOPS10
SUBTTL SNDOUT Send output over the link
;THIS ROUTINE WILL OUTPUT THE DATA IN THE BUFFER
TOPS20 <
SNDOUT:: SETZM INTDSP ;CLEAR OUTPUT DISPLAY FLAG
SKIPN REMACC ;REMOTE OPR?
$RETT ;NO..RETURN
MOVX S1,0 ;GET A NULL
IDPB S1,OUTPTR ;END WITH A NULL
MOVE S1,OUTJFN ;OUTPUT JFN
MOVSI S2,(POINT NETBSZ,) ;NETBSZ BIT BYTES
HRR S2,BUFADR ;BUFFER ADDRESS
SETZ T1, ;OUTPUT TILL A NULL
SOUTR ;SEND THE DATA
ERJMP SNDO.1 ;ERROR...
$RET ;RETURN
SNDO.1: MOVX S1,E.OUTF ;OUTPUT FAILED
MOVEM S1,ERRCOD ;SAVE THE CODE
PJRST SETFAL ;SETUP FAILURE..ABORT WITH ERROR
;STOP THE PROCESS
> ;End TOPS20
TOPS10 <
SNDOUT:: SETZM INTDSP ;CLEAR OUTPUT DISPLAY FLAG
$RETT ;RETURN
> ;End TOPS10
SUBTTL OUTRTN Output routine for links
;THIS IS THE TEXT DEFAULT OUTPUT ROUTINE AND WILL SETUP DATA FOR THE
;LINKS
TOPS20 <
OUTRTN: SOSG OUTCNT ;ROOM LEFT
JRST OUTR.1 ;NO..SEND AND MAKE ROOM
IDPB S1,OUTPTR ;SAVE THE BYTE
$RETT ;RETURN TRUE
OUTR.1: PUSH P,S1 ;SAVE THE BYTE
$CALL SETPTR ;SETUP THE POINTER
MOVX S2,2 ;RESERVE THE CTY..LONG MESSAGE
IDPB S2,S1 ;SAVE BYTE AS FIRST ONE
$CALL SNDOUT ;SEND THE OUTPUT
$CALL SETPTR ;RESET THE POINTERS
MOVX S2,3 ;RELEASE AFTER THIS MESSAGE
IDPB S2,S1 ;SAVE THE BYTE
MOVEM S1,OUTPTR ;SAVE THE POINTER
POP P,S1 ;RESTORE THE VALUE
JRST OUTRTN ;SAVE THE CHARACTER NOW
SUBTTL SETPTR Setup pointers for output
;THIS ROUTINE WILL SETUP THE POINTERS AND RETURN WITH S1 CONTAINING
;THE NEW BYTE POINTER
SETPTR: MOVEI S1,OUTSIZ-1 ;GET OUTPUT SIZE AND LEAVE ROOM FOR NULL
MOVEM S1,OUTCNT ;SAVE THE COUNT
MOVSI S1,(POINT NETBSZ,) ;SETUP FOR NETBSZ BIT BYTES
HRR S1,BUFADR ;GET BUFFER ADDRESS
$RET ;RETURN S1 BYTE POINTER
> ;End TOPS20
SUBTTL INPINT Input over link interrupt
;THIS ROUTINE WILL FLAG THAT INPUT IS READY OVER THE LINK
TOPS20 <
INPINT: $BGINT IPCLEV ;SETUP AT SAME LEVEL
SETOM INPDON ;SET INPUT DONE
$DEBRK ;RETURN
SUBTTL OUTINT Output link connected
;THIS ROUTINE WILL FLAG A CONNECT INTERRUPT ON OUTPUT LINK
OUTINT: $BGINT IPCLEV ;SETUP THE LEVEL
SETOM OUTCON ;OUTPUT CONNECTED
$DEBRK ;RETURN
SUBTTL IPCRMT IPCF interrupt routine for remote OPR
;THIS ROUTINE WILL FLAG IPCF INTERRUPTS ON THE -20 WHEN RUNNING
;AS A REMOTE OPR
IPCRMT: $BGINT IPCLEV ;SETUP THE LEVEL
$CALL C%INTR ;FLAG THE INTERRUPT
$DEBRK ;RETURN
SUBTTL INPDAT Input the data from link
;THIS ROUTINE WILL READ DATA FROM THE LINK
INPDAT: SKIPN INPDON ;GET DATA
$RETF ;RETURN FALSE
SETZ S1, ;CLEAR VALUE
EXCH S1,INPDON ;RESET THE FLAG
MOVE S1,INPJFN ;GET THE INPUT JFN
MOVSI S2,(POINT NETBSZ,) ;NETBSZ BIT BYTES
HRR S2,NETBUF ;NETWORK DATA
MOVNI T1,OUTSIZ ;GET THE OUTPUT SIZE
SINR ;READ THE DATA
ERJMP INPD.1 ;ERROR..EXIT
HRRZ T3,T1 ;SAVE THE NEW COUNT
SETZ S1, ;CLEAR S1
IDPB S1,S2 ;SAVE A NULL ON THE END
MOVE S1,INPJFN ;GET THE JFN
MOVEI S2,.MORLS ;READ THE LINK STATUS
SETZ T1, ;CLEAR FOR STATUS
MTOPR ;GET THE STATUS
ERJMP INPD.1 ;ERROR..ABORT
TXNN T1,MO%CON ;CHECK IF STILL CONNECTED?
PJRST INPD.1 ;NO.. ABORT THE PROCESS
TXNE T1,MO%EOM ;DATA AVAILABLE
SETOM INPDON ;SET THE FLAG
SUBI T3,-OUTSIZ ;GET NUMBER OF CHARACTERS READ
CAIG T3,2 ;GREATER THAN MINIMUM MESSAGE
$RETF ;NO..RETURN FALSE
$RETT ;RETURN TRUE
INPD.1: MOVX S1,E.INPF ;INPUT FAILED
MOVEM S1,ERRCOD ;SAVE THE CODE
PJRST SETFAL ;SEND SETUP FAILURE
SUBTTL CONNEC Process connect message
;THIS ROUTINE WILL PROCESS THE CONNECT MESSAGE FOR THE OUTPUT
;LINK
CONNEC: SKIPN OUTCON ;OUTPUT CONNECT
$RETT ;NO..RETURN
SETZ S1, ;CLEAR FLAG
EXCH S1,OUTCON ;CLEAR FLAG
MOVE S1,OUTJFN ;GET OUTPUT JFN
MOVEI S2,.MORLS ;READ LINK STATUS
MTOPR ;GET THE STATUS
ERJMP CONN.1 ;ERROR..HALT
TXNN T1,MO%WCC!MO%CON ;CONNECT MADE
JRST CONN.2 ;BAD CONNECT DATA
SETOM OUTACT ;SET FLAG
$RETT ;RETURN
CONN.1: MOVX S1,E.STSF ;STATUS OF SERVER FAILED
MOVEM S1,ERRCOD ;SAVE THE CODE
PJRST SETFAL ;SETUP FAILURE..ABORT WITH ERROR
CONN.2: MOVEM T1,ARG1 ;SAVE THE ARGUMENT
MOVX S1,E.INVC ;INVALID CONNECT DATA
MOVEM S1,ERRCOD ;SAVE THE CODE
PJRST SETFAL ;SETUP FAILURE..ABORT WITH ERROR
> ;End TOPS20
SUBTTL TXTLIN Check if multiple line input allowed
;THIS ROUTINE WILL CHECK IF USER IS REMOTE OPERATOR ON THE -20
;AND IF SO NOT ALLOW MULTIPLE LINE INPUT
TXTLIN:: SKIPN REMOPR ;ARE WE A REMOTE OPERATOR
PJRST TXTINP## ;NO..GO GET THE TEXT
TOPS20 <
MOVEI S2,[ASCIZ/Multiple line text not allowed for remote operators/]
$RETF
> ;End TOPS20
TOPS10 <
$RETT ;RETURN O.K.
> ;End TOPS10
SUBTTL SETFAL Send a setup failure for OPR errors
;THIS ROUTINE WILL SEND A SETUP FAILURE TO SHUTDOWN AN OPR
;ON AN ERROR
SETFAL: $CALL SETMES ;SETUP MESSAGE
MOVX S1,.ORFAL ;SETUP FAILURE
STORE S1,ARG.HD+.OHDRS(M),AR.TYP ;SAVE IN MESSAGE
MOVEI T1,.OHDRS+ARG.DA(M) ;POINT TO NEXT ARGUMENT
MOVX S1,.CMTXT ;TEXT ARGUMENT
STORE S1,ARG.HD(T1),AR.TYP ;SAVE THE TYPE
MOVEI S1,ARG.DA(T1) ;ADDRESS TO STORE DATA
HRLI S1,(POINT 7,0) ;MAKE BYTE POINTER
MOVEM S1,TEMPTR ;SAVE THE POINTER
MOVE S1,ERRCOD ;GET ERROR CODE
CAILE S1,E.MAXE ;WITHIN BOUNDS
STOPCD (IEC,HALT,,<Invalid error code for failure>)
$TEXT (SETTXT,<^I/@OPRTXT(S1)/>^0);SAVE THE TEXT
HRRZ S1,TEMPTR ;GET THE POINTER
AOS S1 ;BUMP THE LENGTH
ANDI S1,777 ;GET LENGTH OF BLOCK
STORE S1,.MSTYP(M),MS.CNT ;SAVE MESSAGE SIZE
SUBI S1,.OHDRS+1 ;GET LENGTH OF TEXT
STORE S1,ARG.HD(T1),AR.LEN ;SAVE THE LENGTH
AOS .OARGC(M) ;BUMP ARGUMENT COUNT
MOVE S1,M ;ADDRESS OF MESSAGE
$CALL I%SOPR ;SEND THE MESSAGE
$HALT ;HALT THE OPR
$RETT ;RETURN
SETTXT: IDPB S1,TEMPTR ;SAVE THE DATA
$RETT ;RETURN
DEFINE X(A,B),<
EXP [ITEXT B]
> ;End X
OPRTXT: ERROPR ;ERROR CODES FOR OPR
SUBTTL PUSHRT Process the PUSH command
TOPS10 <
PUSHRT::$CALL P$NPRO## ;NO PROCESSING REQUIRED
MOVEI S1,CTXARG ;POINT TO ARGUMENT BLOCK
CTX. S1, ;PUSH
SKIPA ;FAILED
$RETT ;AND RETURN
MOVEI S2,CTXER1 ;DEFAULT TO GENERIC MESSAGE
CAIN S1,CTXARG ;IMPLEMENTED?
MOVEI S2,CTXER0 ;NO
TXNE S1,CT.ETX ;ERROR TEXT RETURNED IN BUFFER?
MOVEI S2,CTXER2 ;YES
TXNE S1,CT.RUN ;RUN UUO ERROR?
MOVEI S2,CTXER3 ;YES
$TEXT (,<? Cannot save context; ^I/(S2)/>)
$RETT ;RETURN
CTXARG: $BUILD (.CTMAX) ;BLOCK LENGTH
$SET (.CTFNC,CT.LEN,.CTMAX) ;SET LENGTH
$SET (.CTDBL,,12) ;SET DATA BLOCK LENGTH
$SET (.CTDBA,,CTXDAT) ;SET DATA BLOCK ADDRESS
$EOB ;END OF BLOCK
CTXER0: ITEXT (<CTX. UUO not implemented>)
CTXER1: ITEXT (<CTX. UUO error ^O/S1,CT.ERR/>)
CTXER2: ITEXT (<^T/CTXDAT/>)
CTXER3: ITEXT (<RUN UUO error ^O/S1,CT.ERR/>)
> ;END TOPS-10 CONDITIONAL
TOPS20 <
PUSHRT:: SKIPE REMOPR ;REMOTE OPERATOR?
JRST NOREMT ;NO REMOTE PUSHS ALLOWED
$CALL P$NPRO## ;NO PROCESSING REQUIRED
SKIPE S1,FRKHND ;ALREADY HAVE A FORK WITH EXEC
JRST PUSH.1 ;GO TO PUSH RETURN
MOVX S1,GJ%SHT!GJ%OLD ;SHORT FORM, OLD FILE
HRROI S2,[ASCIZ/SYSTEM:EXEC.EXE/]
GTJFN
JRST NOEXEC ;NO EXEC
MOVEM S1,FRKJFN ;SAVE FORK JFN
MOVX S1,CR%CAP ;GIVE FORK CAPABILITIES
CFORK ;CREATE THE FORK
JRST NOFORK
MOVEM S1,FRKHND ;SAVE FORK HANDLE
HRLZS S1 ;PLACE IN LEFT HALF
HRR S1,FRKJFN ;JFN IN THE FIGHT HALF
GET ;NOW GET THE EXEC INTO THE LOWER FORK
MOVEI S1,.FHSLF ;DONT ALLOW LOWER FORK TO LOG OUT
RPCAP ;GET CAPABILITIES OF INFERIOR
TXZ S2,SC%LOG ;DO NOT ALLOW LOGOUT
SETZ T1, ;NO PRIVILEGES ENABLED
MOVE S1,FRKHND ;GET THE FORK HANDLE
EPCAP ;SET ITS CAPABILITIES
ERJMP NOCAP ;TRAP THE ERROR
MOVEI S1,.FHJOB ;GET THE JOB HANDLE
TXO S1,RT%DIM ;GET DEFERRED ALSO
RTIW ;READ TERMINAL INTERRUPT CHARACTERS
DMOVEM S2,SAVTWD ;SAVE TERMINAL WORDS
MOVEI S1,.PRIIN ;PRIMARY INPUT JFN
RFMOD ;GET THE MODE
MOVEM S2,SAVMOD ;SAVE THE MODE
MOVE S1,FRKHND ;GET THE FORK HANDLE
PUSH.1: SETZ S2, ;USE PRIMARY START ADDRESS
SFRKV ;START THE EXEC
SETOM FRKRUN ;SETOM FORK RUN
$RETT ;RETURN
NOEXEC: MOVEI S2,[ASCIZ/Unable to find SYSTEM:EXEC.EXE for PUSH command/]
$RETF ;RETURN FALSE
NOFORK: MOVEI S2,[ASCIZ/Unable to create fork for PUSH command/]
$RETF ;RETURN FALSE
NOREMT: MOVEI S2,[ASCIZ/PUSH command not allowed for remote operators/]
$RETF ;RETURN FALSE
NOCAP: MOVE S1,FRKHND ;GET THE FORK HANDLE
KFORK ;KILL THE PROCESS
ERJMP .+1 ;IGNORE THE ERROR
SETZM FRKHND ;CLEAR THE FORK HANDLE
MOVEI S2,[ASCIZ/Unable to enable forks capabilities for PUSH command/]
$RETF ;RETURN FALSE
> ;End TOPS20
SUBTTL TERMFK Process fork termination interrupt
TOPS20 <
TERMFK: $BGINT 1 ;INIT INTERRUPT LEVEL
SKIPN FRKRUN ;WERE WE RUNNING
$DEBRK ;IGNORE IT
SETZM FRKRUN ;CLEAR THE RUNNING FORK FLAG
MOVX S1,.PRIIN ;GET PRIMARY INPUT
MOVE S2,SAVMOD ;GET THE MODE
SFMOD ;SET OLD MODE BACK
MOVX S1,ST%DIM ;SET ALL WORDS
HRRI S1,.FHJOB ;FOR THE JOB
DMOVE S2,SAVTWD ;GET TERMINAL WORDS
STIW ;SET THE WORDS
ERJMP .+1 ;IGNORE THE ERROR..
$DEBRK ;DEBRK THE INTERRUPT
> ;End TOPS20
SUBTTL OPRSON OPR signon to ORION
;THIS ROUTINE WILL SEND THE OPR HELLO MESSAGE TO ORION AND
;THEN WAIT FOR THE ORION SETUP. THE ORION SETUP WILL BE FOLLOWED
;BY A SETUP REPLY AND THE OPR WILL BE READY FOR COMMANDS.
OPRSON: $CALL M%GPAG ;GET A PAGE FOR THE HELLO
MOVE M,S1 ;SAVE ADDRESS IN M
MOVX S1,.OMOHL ;OPR HELLO MESSAGE
STORE S1,.MSTYP(M),MS.TYP ;SAVE THE TYPE
MOVX S1,OPH.SZ+.OHDRS ;SIZE OF THE MESSAGE
STORE S1,.MSTYP(M),MS.CNT ;SAVE THE SIZE
AOS .OARGC(M) ;BUMP COUNT TO 1
MOVX S1,.OPHEL ;OPR HELLO BLOCK
STORE S1,ARG.HD+.OHDRS(M),AR.TYP ;SAVE THE TYPE
MOVX S1,OPH.SZ ;SIZE OF ARGUMENT BLOCK
STORE S1,ARG.HD+.OHDRS(M),AR.LEN ;SAVE THE LENGTH
MOVE S1,MYNODE ;GET CURRENT LOCATION
STORE S1,OPH.ND+.OHDRS(M) ;SAVE THE NODE
MOVX S1,%%.OPR ;ORNMAC VERSION NUMBER
STORE S1,OPH.OV+.OHDRS(M) ;SAVE IN BLOCK
MOVX S1,OPRVRS ;OPRS VERSION NUMBER
STORE S1,OPH.VN+.OHDRS(M) ;SAVE IN BLOCK
TOPS20 <
MOVX S1,OP.RMT ;GET REMOTE OPERATOR FLAG
SKIPE REMOPR ;ARE WE A REMOTE OPERATOR
IORM S1,.OFLAG(M) ;YES..TURN ON THE FLAG
> ;End TOPS20
MOVE S1,M ;PLACE MESSAGE ADDRESS IN S1
$CALL I%SOPR ;SEND THE MESSAGE TO ORION
SKIPT ;CONTINUE IF SEND O.K.
STOPCD (OSF,HALT,,<ORION send failed>) ;CAN'T INITIATE DIALOG
OPRS.1: $CALL C%BRCV ;BLOCKING RECEIVE THE MESSAGE
$CALL VALMSG ;VALIDATE THE MESSAGE
JUMPT OPRS.3 ;O.K. CONTINUE ON
OPRS.2: $CALL C%REL ;NO GOOD..TRY AGAIN
JRST OPRS.1 ;WAIT FOR ANOTHER MESSAGE
OPRS.3: LOAD M,MDB.MS(S1),MD.ADR ;ADDRESS OF RECEIVED MESSAGE
LOAD T1,.MSTYP(M),MS.TYP ;GET THE MESSAGE TYPE
CAIE T1,.OMOST ;OPERATOR SETUP MESSAGE
JRST OPRS.4 ;NO..TRY TEXT COULD BE ERROR
$CALL OPRRST ;OPR REPLY TO SETUP
SKIPT ;O.K...PROCEED
STOPCD (SFO,HALT,,<Setup failure by OPR>)
PJRST C%REL ;RELEASE THE PAGE AND RETURN
OPRS.4: CAIE T1,MT.TXT ;ERROR TEXT MESSAGE
JRST OPRS.2 ;NO..TRY AGAIN
$CALL ACKOPR ;PROCESS AS ACK OPR
$CALL EXIT ;EXIT TO COMMAND LEVEL
SUBTTL OPRRST OPR reply to setup
;THIS ROUTINE WILL PROCESS THE SETUP AND SEND THE
;APPROPRIATE REPLY TO ORION.
OPRRST: SKIPE .OARGC(M) ;ANY ARGUMENTS SPECIFIED
JRST OPRR.1 ;YES PROCESS THE MESSAGE
PJRST SETREP ;SEND SETUP REPLY AND RETURN
OPRR.1: $RETF ;****NOT SUPPORTED YET
SUBTTL SETREP Setup reply message
;THIS ROUTINE WILL SEND A SETUP REPLY TO ORION SAYING THAT ALL
;IS O.K.
SETREP: $CALL SETMES ;SETUP THE MESSAGE
MOVE S1,M ;ADDRESS OF THE MESSAGE
$CALL I%SOPR ;SEND TO ORION
$RETIT ;ALL O.K.
STOPCD (SDF,HALT,,<Setup dialog failed>)
SUBTTL SETMES Setup message reply
SETMES: $CALL M%GPAG ;GET A PAGE OF MEMORY
MOVE M,S1 ;SAVE THE ADDRESS IN M
MOVX S1,.OMOSR ;SETUP REPLY CODE
STORE S1,.MSTYP(M),MS.TYP ;SAVE THE TYPE
MOVX S1,1 ;LENGTH OF THE ARGUMENT
STORE S1,ARG.HD+.OHDRS(M),AR.LEN ;SAVE LENGTH
MOVX S1,.ORSUC ;GET SUCCESS CODE
STORE S1,ARG.HD+.OHDRS(M),AR.TYP ;SAVE THE TYPE
MOVX S1,.OHDRS+1 ;SIZE OF THE MESSAGE
STORE S1,.MSTYP(M),MS.CNT ;SAVE THE COUNT
MOVE S1,M ;PUT ADDRESS IN S1
AOS .OARGC(M) ;BUMP ARGUMENT COUNT
$RET ;RETURN
SUBTTL TABCHK Routine to check out syntax tables
;THIS ROUTINE WILL CHECK OUT THE ENTRY BLOCK SETUP BY
;EACH TABLE FOR THE PROPER LENGTH AND NON-ZERO ENTRIES
TABCHK: MOVEI T3,SYNTAB ;ADDRESS OF TABLE OF TABLES
MOVE T1,(T3) ;GET THE FIRST TABLE
SKIPN T2,TABNUM ;NON-ZERO NUMBER OF ENTRIES
STOPCD (ZTS,HALT,,<Zero tables setup for OPR>)
JRST TABC.1 ;SKIP BUMPING TO NEXT TABLE
TABC.0: ADDI T3,1 ;BUMP TO NEXT ENTRY
SKIPN T1,(T3) ;BUMP TO NEXT TABLE ADDRESS
STOPCD (MST,HALT,,<Missing syntax table>)
TABC.1: LOAD S1,TAB.HD(T1),TB.LEN ;LENGTH OF BLOCK
CAIGE S1,TAB.SZ-1 ;GREATER OR EQUAL TO LENGTH
STOPCD (WLT,HALT,,<Wrong length table entry block>)
SKIPE TAB.IN(T1) ;ZERO INIT TABLE
SKIPN TAB.KY(T1) ;OR ZERO KEYWORD TABLE
STOPCD (ZTE,HALT,,<Zero entry in syntax table entry block>)
SOJG T2,TABC.0 ;CHECK OUT ALL TABLES
MOVE S1,SYNTAB ;ADDRESS OF MAIN OPR TABLES
MOVE S2,TAB.KY(S1) ;ADDRESS OF MAIN KEYWORD TABLE
MOVEM S2,DEFTAB ;SAVE AS DEFAULT TABLES
TABC.2: MOVSI S2,-<NUMAPL> ;GET NUMBER OF ENTRIES
TABC.3: SKIPN T1,SYNTAB+1(S2) ;GET THE TABLE ENTRY
JRST TABC.4 ;SKIP IT TRY NEXT
MOVE T2,TAB.KY(T1) ;GET THE KEYWORD TABLE
HRRZ T3,KEYAP1+1(S2) ;ADDRESS OF SYMBOL AND NEXT
HRRM T2,(T3) ;SETUP TABLE POINTER
TABC.4: AOBJN S2,TABC.3 ;CHECK FOR MORE
$RET ;RETURN
SUBTTL GETLOC Get OPR location
;THIS ROUTINE WILL DETERMINE THE JOBS LOCATION AND STORE THE
;VALUE IN MYNODE.
GETLOC: SETOM S1 ;GET MY LOCATION
MOVX S2,JI.LOC ;GET THE JOBS LOCATION
$CALL I%JINF ;GET THE LOCATION
SKIPT ;SKIP IF O.K.
SETZ S2, ;MAKE 0 FOR NOW
MOVEM S2,MYNODE ;SAVE AS MYNODE
$RETT ;RETURN
SUBTTL EXIT Temp routine to perform exit
; The purpose of this routine is to avoid the problem of exiting
; while output is pending on the 20. The problem is I%EXIT performs
; a RESET immediately. This causes any pending output to the terminal
; to be flushed. As a result, an error message that tells the user
; why he can't run OPR gets clobbered.
EXIT:
TOPS20<
MOVEI S1,.PRIOU ;Get the TTY output designator
DOBE ;Wait till done
JFCL ;Don't care about errors
> ; End of TOPS20
$CALL I%EXIT ;Now go and exit
;And never return
TOPS10 <END OPR> ;ALLOW FOR CCL START AT OPR
TOPS20 <END <3,,ENTVEC>> ;USE ENTRY VECTOR FOR TOPS20