Trailing-Edge
-
PDP-10 Archives
-
BB-L014Z-BM_1990
-
galsrc/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 Preliminaries
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 1988.
; 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 THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH GLXMAC
.directive flblst
PROLOG (OPR)
SEARCH ORNMAC
SUBTTL Edit vector and Version numbers
OPRVEC: BLDVEC (GLXMAC,GMC,L)
BLDVEC (ORNMAC,OMC,L)
BLDVEC (OPR,OPR,L)
BLDVEC (OPRPAR,PAR)
BLDVEC (OPRCMD,CMD)
DEFINE X(A,B,C,D),<BLDVEC (C,A)> ;Want application versions
TABAPL ; added to vector
;Version numbers
OPRMAN==:6012 ;Maintenance edit number
OPRDEV==:6010 ;Development edit number
VERSIN (OPR) ;Generate edit number
OPRWHO==0
OPRVER==6
OPRMIN==0
EXTERNAL CMDEDT,PAREDT
;**;[6012]At EXTERNAL CMDEDT:+1L add 2 lines PMM 6/3/90
MAXAKA==500 ;[6012]Maximum number of alias names
EXTERNAL AKATBL,AKASIX,AKAASC ;[6012]Alias keyword table addresses
OPRVRS==<VRSN.(OPR)>+GMCEDT+OMCEDT+CMDEDT+PAREDT
.JBVER==137
LOC .JBVER
EXP OPRVRS
RELOC
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. Edit vector and Version numbers . . . . . . . . . . . 2
; 2. Revision history . . . . . . . . . . . . . . . . . . . 4
; 3. Special accumulator assignments . . . . . . . . . . . 5
; 4. OPR impure data . . . . . . . . . . . . . . . . . . . 6
; 5. Interrupt vector definitions . . . . . . . . . . . . . 7
; 6. Table building data base . . . . . . . . . . . . . . . 9
; 7. OPR Initialization
; 7.1 Main Entry . . . . . . . . . . . . . . . . . . 10
; 7.2 TBLINI - Initialize command tables . . . . . . 11
; 8. CCLOOK CCL entry file lookup (TOPS10) . . . . . . . . 12
; 9. MAIN Main processing loop . . . . . . . . . . . . . . 13
; 10. ROUTIM Routine called by timer . . . . . . . . . . . . 14
; 11. SETIME Routine to set timer intervals . . . . . . . . 15
; 12. TAKEND Process end of TAKE command . . . . . . . . . . 16
; 13. DSPCMD Display TAKE commands if desired . . . . . . . 17
; 14. PRCMSG Process IPCF messages . . . . . . . . . . . . . 18
; 15. ACKOPR Display a GALAXY text message . . . . . . . . . 19
; 16. DSPOPD Process DISPLAY message from ORION . . . . . . 20
; 17. SHWDSP Process DISPLAY message from ORION . . . . . . 21
; 18. TABSET Setup tables for parser call . . . . . . . . . 22
; 19. Software interrupt system routines . . . . . . . . . . 23
; 20. Command and application action routines . . . . . . . 24
; 21. ENTER and RETURN command tables . . . . . . . . . . . 25
; 22. Control-Z and EXIT command tables and action routines 26
; 23. TAKOPR Process a take command . . . . . . . . . . . . 27
; 24. WAIOPR Process a wait command . . . . . . . . . . . . 28
; 25. SETRTN and SETTRM Process SET TERMINAL command . . . . 29
; 26. ESCAPE Sequence Table for Operator Terminals . . . . . 30
; 27. SHWDAY Process SHOW DAYTIME command . . . . . . . . . 33
; 28. OPRRMT Entry and initialization for REMOTE OPR . . . . 34
; 29. WAITCN Wait for output link connect . . . . . . . . . 35
; 30. REMSET Setup OPR links . . . . . . . . . . . . . . . . 36
; 31. SETOUT Setup output of data . . . . . . . . . . . . . 37
; 32. INPINT Input over link interrupt . . . . . . . . . . . 38
; 33. INPDAT Input the data from link . . . . . . . . . . . 39
; 34. CONNEC Process connect message . . . . . . . . . . . . 40
; 35. TXTLIN Check if multiple line input allowed . . . . . 41
; 36. SETFAL Send a setup failure for OPR errors . . . . . . 42
; 37. PUSHRT Process the PUSH command (TOPS20) . . . . . . . 43
; 38. TERMFK Process fork termination interrupt . . . . . . 44
; 39. OPRSON OPR signon to ORION . . . . . . . . . . . . . . 45
; 40. OPRRST OPR reply to setup . . . . . . . . . . . . . . 46
; 41. SETREP Setup reply message . . . . . . . . . . . . . . 47
; 42. SETMES Setup message reply . . . . . . . . . . . . . . 48
; 43. TABCHK Routine to check out syntax tables . . . . . . 49
; 44. GETLOC Get OPR location . . . . . . . . . . . . . . . 50
SUBTTL Revision history
COMMENT \
145 4.2.1528 9-Nov-82
Fix copyright.
***** Release 4.2 -- begin maintenance edits *****
***** Release 5.0 -- begin development edits *****
160 5.1003 4-Jan-83
Move to new development area. Add version vector. Clean up
edit organization. Update TOC.
161 5.1006 13-Jan-83
MACRO has a problem with resolving polish expressions in certain
orders. Move definition of ENTVEC until after definition of OPRVRS to
resolve conflict.
162 5.1007 14-Jan-83
On a PUSH, get the EXEC from "DEFAULT-EXEC:".
163 5.1009 1-Feb-83
Only set up the command tables once, in TBLINI.
164 5.1041 3-Oct-83
Really only set up command tables once. Remove TBLINF flag out of the
area that gets reinitialized on an EXIT/CONTINUE combination.
165 5.1046 21-Oct-83
Change version from 4 to 5.
166 5.1053 7-Nov-83
Add application edit numbers to edit vector. Also requires a
change to NCPTAB.
167 5.1184 3-Dec-84
Change the definition of the macro "X" to include four arguments -
used in conjunction with LCPTAB support.
170 5.1214 7-May-85 QAR 838246
In routine OPR, clear TAKFLG in case we are restarting due to a TAKE
command failure.
***** Release 5.0 -- begin maintenance edits *****
175 Increment maintenance edit level for GALAXY 5.
***** Release 6.0 -- begin development edits *****
6000 6.1015 13-Oct-87
Change the local node name holder HOSTNM to global G$NODE in support
of ensuring that the node specified in remote printing commands is not the
local node. (The name must be changed since it is used in OPRCMD and OPRCMD
is also linked with ORION.)
6001 6.1034 23-Oct-87
Add a new prompt for SEMI-OPR>. Create a new routine, OPRCHK, to
see whether the user is SEMI-OPR or OPR. This routine doesn't care if the
user has no privileges because ORION will catch this case. OPRCHK will
set OPRTYP based on the OPR. OPRTYP=1 means OPR. OPRTYP=-1 means SEMI-OPR.
Initialize the command paser and command tables based on OPRTYP.
6002 6.1113 2-Dec-87
In routine TBLINI:, don't add application table if it is a SEMI-OPR.
6003 6.1134 8-Dec-87
Change OPR's major version number from 5 to 6.
6004 6.1138 13-Dec-87
Fix several bugs in the display of messages that originated remotely.
6005 6.1183 16-Feb-88
Include the Cluster GALAXY option value in the HELLO message to ORION.
6006 6.1196 27-Feb-88
Include block type .ORRFG to be a valid block type for .OMDSP and
.OMACS messages.
6007 6.1212 3-Mar-88
Include the complete OPR version number in the HELLO message to ORION.
6010 6.1225 8-Mar-88
Update copyright notice.
***** Release 6.0 -- begin maintenance edits *****
6011 6.1292 16-Dec-89
Change routine ACKOPR to handle MT.TXT with more than one text
block.
6012 6.1318 3-Jun-90
Add support for alias printing.
\ ;End of Revision History
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
TOPS10 <
CNFTBL==11 ;CONFIGURATION TABLE
DEVOPR==13 ;NAME OF CURRENT OPERATOR
> ;End TOPS10
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
$DATA SAVACS,^D20 ;Where save regs during ROUTIM
$DATA REMMSG,1 ;[6004]REMOTE MESSAGE FLAG
;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
$GDATA G$NODE,1 ;[6000]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
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 OPRTYP,1 ;[6001]OPR TYPE
$DATA LEV1PC,1
$DATA LEV2PC,1
$DATA LEV3PC,1
;**;[6012]At $DATA LEV3PC:+1L add 2 lines PMM 6/3/90
$GDATA G$PID ;[6012]OPR's PID
$DATA REMUPD ;[6012]UPDAKA remote/local flag
> ;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
TIMBLK: $BUILD .TIDAT
$SET(.TIMPC,,ROUTIM) ;Routine called by timer
$EOB
TRMBLK: $BUILD 3 ;TRMOP block
$SET (0,,.TOTYP) ;Type to the terminal
$SET (1,,-1) ;Myself
$EOB
ND WAKSEC,^D93 ;Set magical default sleep time
> ;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>
SEMTAB: EXP OPRSCM## ;[6001]SEMI-OPR TABLES
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) > ;Control Z exit
ORNDSP(ENTFDB,ENTER,ENT) ;ENTER COMMAND FDB
ORNDSP(EXTFDB,EXIT,EXT) ;EXIT COMMAND
TOPS20< 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
SEMPMT: [ASCIZ /SEMI-OPR>/] ;[6001]PROMPT FOR SEMI-OPR
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 Initialization -- Main Entry
OPR: SETZM TAKFLG ;Clear TAKE command flag
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
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,G$NODE ;[6000]SAVE HOST NAME
$CALL OPRCHK ;[6001]SEMI OR FULL OPR
$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
TOPS10<
MOVEI S1,[ASCIZ//] ;Get a control R
MOVEM S1,TRMBLK+2 ;Save it
> ;End of TOPS10
$CALL TBLINI ;Set up command tables
JRST MAIN ;START PROCESSING AT MAIN
SUBTTL OPR Initialization -- TBLINI - Initialize command tables
; This routine links in the application tables if needed.
TBLINI: SKIPE TBLINF ;Have we done this before?
$RET ;Yes, quit now
HLRZ S2,KEYAP1 ;Get application keyword table
JUMPE S2,TBLIN3 ;No alternatives, skip the rest
SKIPG OPRTYP ;[6002]Skip if SEMI-OPR?
JRST TBLIN3 ;[6002]SEMI-OPR has no application
MOVE S1,SYNTAB ;Get address of main tables
MOVE S2,TAB.KY(S1) ;Get main keyword table address
AOS S2 ;Position to FDB
TBLIN1: LOAD S1,.CMFNP(S2),CM%LST ;Get address
JUMPE S1,TBLIN2 ;Finished the search
MOVE S2,S1 ;Remember this address
JRST TBLIN1 ;Go try again
; S2 contains the address of the place to store the application keyword table
TBLIN2: MOVEI S1,APLTAB+1 ;Get address of application FDB
STORE S1,.CMFNP(S2),CM%LST ;Save as alternate
; Here to set the flag to not do this again. Either have linked in table
; or don't need to.
TBLIN3: SETOM TBLINF ;Don't do this again
$RET ;Done
TBLINF: DEC 0 ;Table initialization flag
;Initialize to zero
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
MOVE T3,[DEVOPR,,CNFTBL] ;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:
TOPS10< $CALL SETIME> ;Set up pseudo timer interrupt
DMOVE S1,P1 ;GET THE PARSER ARGUMENTS
$CALL PARSER## ;CALL THE PARSER
MOVE P3,S2 ;SAVE THE ADDRESS OF BLOCK
TOPS10< JUMPF [$CALL CLTIME ;Clear timer
JRST MAIN.5] ;COMMAND ERROR ON PARSER
$CALL CLTIME ;Clear timer
> ; End of TOPS10
TOPS20< 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
;**;[6012]At MAIN.3:+1L replace 1 line with 20 lines PMM 6/3/90
;[6012]Check to see if the message is an OPR>DEFINE ALIAS message (.OMRDA).
;[6012]If it is, it must be handled specially to avoid race conditions.
MAIN.S: MOVE T1,.OHDRS+ARG.SZ*2+ARG.DA(S1) ;[6012]Point at first keyword
CAIE T1,.KYDEF ;[6012]Is it the define keyword?
JRST MAIN.G ;[6012]No, process as usual
MOVE T1,.OHDRS+ARG.SZ*3+ARG.DA(S1) ;[6012]Point at next keyword
CAIE T1,.KYAKA ;[6012]Is it the alias keyword?
JRST MAIN.G ;[6012]No, proceed as usual
MOVE T1,S1 ;[6012]Save page address
$CALL I%IOFF ;[6012]Shutoff interrupts
MOVE S1,T1 ;[6012]Restore message address
$CALL I%SOPR ;[6012]Send to ORION
MAI.S1: $CALL C%BRCV ;[6012]Set up blocking IPCF receive
JUMPF MAI.S1 ;[6012]Shouldn't happen
$CALL CHKMSG ;[6012]Process UPDAKA if .OMRDA
;[6012]message with this OPR's PID
JUMPF MAI.S2 ;[6012]No, process message
$CALL I%ION ;[6012]Yes, turn on interrupts
$CALL C%REL ;[6012]Release the message
JRST MAIN ;[6012]Go back to MAIN processing loop
MAI.S2: $CALL PRCDSP ;[6012]Process the message
JRST MAI.S1 ;[6012]Set up a block receive
MAIN.G: $CALL I%SOPR ;[6012]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
$TEXT (,<? ^T/@PRT.EM(P3)/>) ;OUTPUT THE 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
;**;[6012]At MAIN.7:+3L add routine CHKMSG PMM 6/3/90
SUBTTL CHKMSG Check For Response to the DEFINE ALIAS Command
;[6012]Routine CHKMSG determines if an incoming message is a response to
;[6012]its DEFINE ALIAS command. If it is a reponse, it processes the response.
;[6012]
;[6012]Call is: S1/Message Descriptor Block address
;[6012]Returns true: The received IPCF message is in response to its DEFINE
;[6012] ALIAS command.
;[6012]Returns false: The IPCF message is not in response to its DEFINE ALIAS
;[6012] command.
CHKMSG: LOAD M,MDB.MS(S1),MD.ADR ;[6012]Get message address
LOAD S2,.MSTYP(M),MS.TYP ;[6012]Get message type
CAIE S2,.OMRDA ;[6012]RESPONSE TO DEFINE ALIAS message?
JRST CHKM.1 ;[6012]No, check for text messages
MOVE S2,.MSCOD(M) ;[6012]Get PID of OPR it is ACKing
CAME S2,G$PID ;[6012]Is it my PID?
$RETF ;[6012]No, return false
$CALL UPDAKA ;[6012]Update alias keyword table
$RETT ;[6012]Indicate success
CHKM.1: CAIE S2,MT.TXT ;[6012]Is it a text message?
$RETF ;[6012]No, return false
LOAD S2,.MSFLG(M),MS.TYP ;[6012]Get message flag
CAIE S2,'AKI' ;[6012]Is it the E$AKI response?
CAIN S2,'AKM' ;[6012]...or the E$AKM response?
SKIPA ;[6012]Yes to either...
$RETF ;[6012]No, return false
$CALL ACKOPR ;[6012]Process the response
$RETT ;[6012]Indicate success
CMDPMT: ITEXT (<^M^J^T/@PARBLK+PAR.PM/>) ;[6012]
TOPS10< SUBTTL ROUTIM Routine called by timer
; This routine has one purpose in life. When called by timer, it
; attempts to output any existing IPCF messages, resets the timer,
; and forces a ^R into the terminal's input buffer. This should
; hopefully return the line to the state where it was interrupted.
ROUTIM: MOVEM 0,SAVACS ;Save AC0
MOVEI 0,SAVACS+1 ;Place to put AC1
HRLI 0,1 ;Setup BLT pointer
BLT 0,SAVACS+17 ;Save the AC's
$CALL PRCMSG ;Go process any IPCF messages
$CALL SETIME ;Reset the timer
SKIPN MSGCNT ;Any messages?
JRST ROUT.1 ;No - don't need ^R
;Now want to force ^R into the input buffer
MOVE S1,[XWD 3,TRMBLK] ;Set up for uuo
TRMOP. S1, ;Force the ^R
JFCL ;User can still run, just isn't pretty
ROUT.1: MOVSI 16,SAVACS ;Setup pointer
BLT 16,16 ;Don't need to restore PDL
$RET ;Return to wherever
SUBTTL SETIME Routine to set timer intervals
SETIME: $CALL I%NOW ;Get current time
ADDI S1,WAKSEC*3 ;Add # of wakeup seconds
STORE S1,TIMBLK+.TITIM ;Save time to wakeup
MOVEI S1,.TIMDT ;Timer function
STORE S1,TIMBLK+.TIFNC,TI.FNC ;Set it
MOVEI S1,.TIDAT ;Length of argument block
MOVEI S2,TIMBLK ;Address of argument block
$CALL I%TIMR ;Set it
$RETIT
$STOP (CST,<Can't set timer for parsing>)
;The purpose of CLTIME is to clear the timer interrupt set
;previously by SETIME
CLTIME: MOVEI S1,.TIMDD ;Removal timer function
STORE S1,TIMBLK+.TIFNC,TI.FNC ;Set it
MOVEI S1,.TIDAT ;Length of argument block
MOVEI S2,TIMBLK ;Address of argument block
$CALL I%TIMR ;Set it
$RETIT
$STOP (CUT,<Can't unset timer after parsing>)
> ; End of TOPS10
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
;**;[6012]At PRCM.0:+1L replace 2 lines with 4 lines PMM 6/3/90
$CALL PRCDSP ;[6012]Validate, process and release
JRST PRCM.0 ;[6012]Loop back for more messages
PRCDSP: $CALL VALMSG ;[6012]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
;**;[6012]At PRCM.1:+1L change 1 line PMM 6/3/90
$RET ;[6012]Return
DSPTAB: .OMDSP,,DSPOPD
.OMWTR,,WTRDSP
.OMACS,,SHWDSP
;**;[6012]At DSPTAB:+2L add 1 line PMM 6/3/90
.OMRDA,,UPDAKB ;[6012]Update alias keyword table
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 T3,.MSFLG(M),MF.NEB ;[6004]REMOTE MESSAGE FLAG
LOAD T1,ARG.HD+.OHDRS(M),AR.TYP ;[6004]GET ARGUMENT TYPE
CAIN T1,.CMTXT ;[6004]IS IT TEXT?
JRST ACKO.1 ;[6004]YES, PICK UP THE MESSAGE
SKIPN T3 ;[6004]FROM A REMOTE ORION?
$RETF ;[6004]NO, RETURN
CAIE T1,.ORDSP ;[6004]IS IT A DISPLAY BLOCK?
$RETF ;[6004]NO, RETURN NOW
MOVEI S1,.OHDRS(M) ;[6004]POINT TO THE DISPLAY BLOCK
LOAD S2,ARG.HD(S1),AR.LEN ;[6004]PICK UP ITS LENGTH
ADD S1,S2 ;[6004]POINT TO THE NEXT BLOCK
LOAD T1,ARG.HD(S1),AR.TYP ;[6004]PICK UP ITS TYPE
CAIE T1,.ORDSP ;[6004]IS IT A TEXT BLOCK?
$RETF ;[6004]NO, RETURN NOW
LOAD T1,ARG.HD(S1),AR.LEN ;[6004]PICK UP ITS LENGTH
ADDI T1,.OHDRS(S2) ;[6004]ADD IN THE HEADER AND DISPLAY BLK
LOAD T2,.MSTYP(M),MS.CNT ;[6004]GET THE MESSAGE LENGTH
CAMLE T1,T2 ;[6004]MESSAGE IN BOUNDS?
$RETF ;[6004]NO, RETURN NOW
PUSH P,S1 ;[6004]SAVE THE TEXT BLOCK ADDRESS
$CALL SETOUT ;[6004]SETUP FOR OUTPUT
POP P,S1 ;[6004]RESTORE THE TEXT BLOCK ADDRESS
MOVEI T1,.OHDRS(M) ;[6004]PICK UP ADDRESS OF DISPLAY BLOCK
$TEXT (,<
^C/ARG.DA(T1)/ ^T/ARG.DA+1(T1)/>) ;[6004]OUTPUT TEXT
$TEXT (,<^C/ARG.DA(S1)/ --^T/ARG.DA+1(S1)/-->) ;[6004]
PJRST SNDOUT ;[6004]SEND OUTPUT AND RETURN
;**;[6011]At ACKO.1:+0L replace 10 lines with 14 lines JCR 12/16/89
ACKO.1: $CALL SETOUT ;[6011]Setup for output
MOVEI T1,.OHDRS(M) ;[6011]Address of current block
$TEXT (,<
^C/[-1]/ --^T/ARG.DA(T1)/-->) ;[6011]Output the text
ACKO.2: SOSG .OARGC(M) ;[6011]Any more text blocks?
JRST ACKO.3 ;[6011]No, check for OPR not set up
LOAD S1,ARG.HD(T1),AR.LEN ;[6011]Pick up the current block length
ADD T1,S1 ;[6011]Address of the next block
LOAD S1,ARG.HD(T1),AR.TYP ;[6011]Pick up the next block type
CAIE S1,.CMTXT ;[6011]Is it A text block?
JRST ACKO.2 ;[6011]No, check for another block
$TEXT (,< ^T/ARG.DA(T1)/>) ;[6011]Output the text
JRST ACKO.2 ;[6011]Check for another block
ACKO.3: HRRZ S1,.MSFLG(M) ;[6011]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
$STOP(IAC,Argument count ^O/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
DSPO2A: LOAD S2,ARG.HD(T2),AR.LEN ;[6006]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
JRST DSPO.4 ;[6006]CHECK FOR A REMOTE FLAGS BLOCK
MOVEI S1,ARG.DA(T2) ;ADDRESS OF TEXT
JRST DSPO.2 ;OUTPUT THE TEXT
DSPO.4: CAIN S1,.ORRFG ;[6006]A REMOTE FLAGS BLOCK?
JRST DSPO2A ;[6006]YES, GET THE NEXT BLOCK
$STOP(IDM,Message argument type ^O/S1/ not valid for display messages)
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
SETOM REMMSG ;[6004]ASSUME FROM A REMOTE NODE
LOAD S1,.MSFLG(M),MF.NEB ;[6004]PICK NEBULA BIT
SKIPN S1 ;[6004]IS THE MSG FROM A REMOTE NODE?
SETZM REMMSG ;[6004]NO, INDICATE SO
SHWD.1: LOAD S1,ARG.HD(T2),AR.TYP ;GET THE TYPE FIELD
CAIE S1,.ORDSP ;IS IT DISPLAY?
JRST SHWD.5 ;[6004]NO, CHECK FOR TEXT
$CALL SETOUT ;SETUP FOR OUTPUT
AOSE REMMSG ;[6004]FIRST DISPLAY BLOCK?
JRST SHWD.2 ;[6004]NO, INCLUDE TAB AND DASHES
$TEXT (,<^M^J^C/ARG.DA(T2)/^T/ARG.DA+1(T2)/^A>) ;[6004]
JRST SHWD.4 ;[6004]GO GET THE NEXT BLOCK
SHWD.2: $TEXT (,<^M^J^C/ARG.DA(T2)/ --^T/ARG.DA+1(T2)/-->)
SKIPA ;GET NEXT ARGUMENT
SHWD.3: $CALL DSPMSG ;[6004]OUTPUT THE TEXT
SHWD.4: LOAD S2,ARG.HD(T2),AR.LEN ;[6004]GET LENGTH OF BLOCK
ADD T2,S2 ;BUMP TO NEXT BLOCK
SOJG T1,SHWD.1 ;GET NEXT BLOCK
PJRST SNDOUT ;SEND THE OUTPUT
SHWD.5: CAIE S1,.CMTXT ;[6004]WAS IT JUST TEXT?
JRST SHWD.6 ;[6006]NO, CHECK FOR REMOTE FLAGS BLOCK
MOVEI S1,ARG.DA(T2) ;ADDRESS OF TEXT
JRST SHWD.3 ;[6004]OUTPUT THE TEXT
SHWD.6: CAIN S1,.ORRFG ;[6006]A REMOTE FLAGS BLOCK?
JRST SHWD.4 ;[6006]YES, IGNORE THIS BLOCK
JRST S..IDM ;[6006]INVALID DISPLAY MESSAGE TYPE
;**;[6012]At SHWD.6:+2L add routines UPDAKA and SIXSEV PMM 6/3/90
SUBTTL UPDAKA Update the Alias Keyword Table
;[6012]UPDAKA replaces the Alias keyword table with the alias names contained
;[6012]]in the .AKBLK alias list block.
;[6012]Call is: M/Contains the address of the RESPONSE to DEFINE ALIAS
;[6012]message.
;[6012]
;[6012]Returns true: Always
UPDAKA: SETZM REMUPD ;[6012]Indicate local node
SKIPA ;[6012]Don't reset the flag
UPDAKB: SETOM REMUPD ;[6012]Indicate remote node
$SAVE <P1,P2,P3> ;[6012]SAVE these ACs
MOVE S1,.OARGC(M) ;[6012]Get argument count
SKIPN S1 ;[6012]Is this a Null response?
$RETT ;[6012]Yes, indicate so
MOVEI P1,.OHDRS+ARG.HD(M) ;[6012]Address of first argument block
HLRZ S2,(P1) ;[6012]Get alias block length
MOVE P2,S2 ;[6012]Preserve it
MOVE T1,AKATBL ;[6012]Get alias keyword table header
MOVEI T1,MAXAKA ;[6012]Get maximum # of aliases
MOVEM T1,AKATBL ;[6012]Place back in table header
SOS P2 ;[6012]Get actual # of aliases
SKIPN P2 ;[6012]Any aliases in block?
$RET ;[6012]No, finished
;[6012]Add SIXBIT alias names to table AKASIX
AOS P1 ;[6012]Point at first alias
MOVEI S2,AKASIX ;[6012]Get destination address
HRLI S1,(P1) ;[6012]Source address
HRRI S1,(S2) ;[6012]Source,,destination
ADD S2,P2 ;[6012]Calculate last...
SOS S2 ;[6012]...destination address
BLT S1,(S2) ;[6012]Move the object block
;[6012]Change SIXBIT alias names to ASCIZ, store in table AKAASC and add
;[6012]TBLUK% style entry to AKATBL
SETZB P3,P4 ;[6012]Initialize counters
UPDA.2: MOVEI T1,AKASIX(P4) ;[6012]Get address of SIXBIT alias
HRLI T2,(POINT 7,) ;[6012]Get pointer to ASCIZ address
HRRI T2,AKAASC(P3) ;[6012]Get ASCIZ address
$CALL SIXSEV ;[6012]Convert SIXBIT alias to ASCIZ
MOVEI S1,AKATBL ;[6012]Get address of header word
HRLI S2,AKAASC(P3) ;[6012]Get address of ASCIZ entry
HRRI S2,AKASIX(P4) ;[6012]ASCIZ address,,SIXBIT address
TBADD% ;[6012]Add to alias keyword table
ERJMP .+1 ;[6012]Ignore errors, should not occur
AOS P4 ;[6012]Increment alias counter
ADDI P3,2 ;[6012]Increment ASCIZ index by two
SOJG P2,UPDA.2 ;[6012]Loop back if more aliases
SKIPN REMUPD ;[6012]From a remote node?
$RETT ;[6012]No, return now
$CALL SETOUT ;[6012]Setup the terminal
LOAD P3,.OHDRS(M),AR.LEN ;[6012]Get length of alias block
ADDI P3,.OHDRS(M) ;[6012]Get address of node name block
SETZM INTDSP ;[6012]Indicate a msg has been displayed
GTAD% ;[6012]Get system time
LOAD S2,.MSFLG(M),MF.NEB ;[6012]Pick up the remote origin bit
JUMPE S2,UPDA.3 ;[6012]Don't include header if local
$TEXT (,<^M^J^C/S1/ Processed request in behalf of ^W/ARG.DA(11)/::>) ;[6012]
$TEXT (,<^C/S1/ -- Alias Keyword Table updated -->) ;[6012]
$RETT ;[6012]No more aliases, return
UPDA.3: $TEXT (,<^M^J^C/S1/ -- Alias Keyword Table updated -->) ;[6012]
$RETT
SUBTTL SIXSEV - Convert SIXBIT to ASCIZ
;[6012]Call is: T1/Address of word containing SIXBIT characters
;[6012] T2/Pointer to words for storing ASCIZ string (2 words)
;[6012]
;[6012]Returns true: Always
SIXSEV: $CALL .SAVET ;[6012]Save T ACs
HRLI T1,(POINT 6) ;[6012]Set up byte pointer for sixbit word
MOVEI T4,6 ;[6012]Maximum of 6 characters
;[6012]Loop over characters
SIXS.1: ILDB T3,T1 ;[6012]Get character
JUMPE T3,SIXS.2 ;[6012]If zero, then end of string
ADDI T3,40 ;[6012]Make 7-bit
IDPB T3,T2 ;[6012]Store word
SOJG T4,SIXS.1 ;[6012]Jump if more characters
SIXS.2: ADDI T4,4 ;[6012]Zero out rest of word(s)
SETZ T3, ;[6012]Clear AC
IDPB T3,T2 ;[6012]Deposit zero
SOJG T4,.-1 ;[6012]Jump back if more characters
$RETT
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
MOVEI S1,TABINI ;ADDRESS OF MAIN TABLE INIT
MOVEM S1,PARBLK+PAR.TB ;SAVE IN PARSER CALL BLOCK
MOVEI S1,HDRPMT ;GET DEFAULT PROMPT
TABS.0: MOVEM S1,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
SKIPG OPRTYP ;[6001]SEMI-OPR?
MOVE S1,SEMTAB ;[6001]YES
MOVE T1,TAB.IN(S1) ;ADDRESS OF .CMINI FOR TABLES
STORE T1,PARBLK+PAR.TB ;SAVE THE TABLE ADDRESS
TABS.2: MOVE S1,OPRPMT ;[6001]GET OPR PROMPT
SKIPG OPRTYP ;[6001]WHEEL OR OPERATOR?
MOVE S1,SEMPMT ;[6001]NO, USE SEMI-OPR PROMPT
JRST TABS.0 ;[6001]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
$CALL 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:
REPEAT 33,< ;CODES 0 THRU 32
XLIST
EXP 0
LIST
> ;END REPEAT 33
POINT 7,[BYTE (7) .CHESC,0] ;MAKE ESC, ESC = ESC
REPEAT 43,< ;CODES 34 THRU 76
XLIST
EXP 0
LIST
> ;END REPEAT 43
EXP ESCTAB ;? TAKES US TO NEXT TABLE (THIS ONE)
EXP 0 ;CODE 100
EXP 0 ;A
EXP 0 ;B
POINT 7,[BYTE (7) .CHCNU,0] ;C IS CONTROL U
POINT 7,[BYTE (7) "P","R","I","N","T","E","R",.CHESC]
REPEAT 10,< ;E THRU L
XLIST
EXP 0
LIST
> ;END REPEAT 10
POINT 7,[ASCIZ/?/] ;M
EXP 0 ;N
EXP VT1TAB ;O
REPEAT 13,< ;P THRU Z
XLIST
EXP 0
LIST
> ;END REPEAT 13
REPEAT 6,< ;CODES 133 THRU 140
XLIST
EXP 0
LIST
> ;END REPEAT 6
REPEAT 15,< ;LCA THRU LCM
XLIST
EXP 0
LIST
> ;END REPEAT 15
EXP 0 ;LCN
EXP 0 ;LCO
POINT 7,[BYTE (7) .CHESC,0] ;LCP IS RECOGNIZE CHARACTER
POINT 7,[ASCIZ /SHOW STATUS
/] ;LCQ
POINT 7,[ASCIZ/SHOW QUEUES
/] ;
POINT 7,[ASCIZ/SHOW PARAMETERS
/] ;
POINT 7,[ASCIZ/SHOW MESSAGES
/] ;
POINT 7,[ASCIZ/SHOW ROUTE-TABLE
/] ;LCU
POINT 7,[BYTE (7) .CHCNW,0] ;LCV IS DELETE FIELD
POINT 8,[BYTE (8) 233,310,233,312,.CHCNR,0] ;HOME ERASE EOS CONTL-R
POINT 7,[ASCIZ/SHOW OPERATORS
/] ;LCX
POINT 7,[ASCIZ/SHOW QUEUE MOUNT-REQUESTS
/]; ;LCY
EXP 0 ;LCZ
REPEAT 5,< ;CODES 173 THRU 177
XLIST
EXP 0
LIST
> ;END REPEAT 5
VT1TAB:
REPEAT 33,< ;CODES 0 THRU 32
XLIST
EXP 0
LIST
> ;END REPEAT 33
POINT 7,[BYTE (7) .CHESC,0] ;MAKE ESC, ESC = ESC
REPEAT 43,< ;CODES 34 THRU 76
XLIST
EXP 0
LIST
> ;END REPEAT 43
EXP ESCTAB ;? TAKES US TO NEXT TABLE (THIS ONE)
EXP 0 ;CODE 100
EXP 0 ;A
EXP 0 ;B
POINT 7,[BYTE (7) .CHCNU,0] ;C IS CONTROL U
POINT 7,[BYTE (7) "P","R","I","N","T","E","R",.CHESC]
REPEAT 10,< ;E THRU L
XLIST
EXP 0
LIST
> ;END REPEAT 10
POINT 7,[ASCIZ/?/] ;M
EXP 0 ;N
EXP VT1TAB ;O
REPEAT 13,< ;P THRU Z
XLIST
EXP 0
LIST
> ;END REPEAT 13
REPEAT 6,< ;CODES 133 THRU 140
XLIST
EXP 0
LIST
> ;END REPEAT 6
REPEAT 15,< ;LCA THRU LCM
XLIST
EXP 0
LIST
> ;END REPEAT 15
EXP 0 ;LCN
EXP 0 ;LCO
POINT 7,[BYTE (7) .CHESC,0] ;LCP IS RECOGNIZE CHARACTER
POINT 7,[ASCIZ /SHOW STATUS
/] ;LCQ
POINT 7,[ASCIZ/SHOW QUEUES
/] ;
POINT 7,[ASCIZ/SHOW PARAMETERS
/] ;
POINT 7,[ASCIZ/SHOW MESSAGES
/] ;
POINT 7,[ASCIZ/SHOW ROUTE-TABLE
/] ;LCU
POINT 7,[BYTE (7) .CHCNW,0] ;LCV IS DELETE FIELD
POINT 8,[BYTE (8) 233,333,310,233,333,260,312,.CHCNR,0 ]
;LCW IS HOME ERASE EOS CTL-R
POINT 7,[ASCIZ/SHOW OPERATORS
/] ;LCX
POINT 7,[ASCIZ/SHOW QUEUE MOUNT-REQUESTS
/]; ;LCY
EXP 0 ;LCZ
REPEAT 5,< ;CODES 173 THRU 177
XLIST
EXP 0
LIST
> ;END REPEAT 5
> ;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,G$NODE ;[6000]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/G$NODE/::^A>) ;[6000]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
$STOP(IEC,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 (TOPS20)
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/DEFAULT-EXEC:/]
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 DEFAULT-EXEC: 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
; $STOP(FTE,Fork termination error .. fork was not running)
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,OMCEDT ;ORNMAC VERSION NUMBER
STORE S1,OPH.OV+.OHDRS(M) ;SAVE IN BLOCK
MOVE S1,[BYTE (3)OPRWHO(9)OPRVER(6)OPRMIN(18)OPREDT] ;[6007]
STORE S1,OPH.VN+.OHDRS(M) ;SAVE IN BLOCK
MOVEI S1,C.GALA ;[6005]PICK UP CLUSTER GALAXY OPTION VALUE
STORE S1,OPH.CG+.OHDRS(M) ;[6005]PLACE IN THE MESSAGE
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.
$STOP(OSF,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
$STOP(SFO,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
;**;[6012]Replace 2 lines with 7 lines at OPRRST:+2L PMM 6/3/90
$STOP(IVO,Inconsistent versions of OPR and ORION) ;[6012]Old ORION
OPRR.1: MOVE S2,.IPCFR(S1) ;[6012]Get OPR's PID
MOVEM S2,G$PID ;[6012]Save in global storage
$CALL UPDAKA ;[6012]Update the alias keyword table
$CALL SETREP ;[6012]Send SETUP REPLY to ORION
$RETT ;[6012]Everything is okay
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.
$STOP(SDF,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
SKIPG OPRTYP ;[6001]SEMI-OPR?
MOVEI T3,SEMTAB ;[6001]YES
MOVE T4,T3 ;[6001]SAVE ADDRESS OF TABLE
MOVE T1,(T3) ;GET THE FIRST TABLE
SKIPN T2,TABNUM ;NON-ZERO NUMBER OF ENTRIES
$STOP(ZTS,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
$STOP(MST,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
$STOP(WLT,Wrong length table entry block)
SKIPE TAB.IN(T1) ;ZERO INIT TABLE
SKIPN TAB.KY(T1) ;OR ZERO KEYWORD TABLE
$STOP(ZTE,Zero entry in syntax table entry block)
SOJG T2,TABC.0 ;CHECK OUT ALL TABLES
MOVE S1,T4 ;[6002]GET ADDRESS OF OPR TABLE BACK
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
;[6001]
;OPRCHK - SETS OPRTYP TO SEMI-OPR OR OPR. CALL AT STARTUP ONLY.
;ACCEPTS NOTHING
;RETURNS OPRTYP SET.
;0=NO OPR 1=OPR -1=SEMI-OPR
OPRCHK: SETZM OPRTYP ;0=NO OPR TYPE YET
MOVEI S1,.FHSLF ;SELF
RPCAP ;READ CAPS
ERJMP .+1 ;SHOULD NOT FAILED
TXNN T1,SC%WHL!SC%OPR ;WHEEL OR OPERATOR?
JRST OPRCH1 ;NO, ARE WE SEMI-OPR?
AOS OPRTYP ;1=WHEEL
$RETT
OPRCH1: TXNE T1,SC%SEM ;SEMI-OPR?
SETOM OPRTYP ;-1=SEMI-OPR
$RETT ;
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