Trailing-Edge
-
PDP-10 Archives
-
BB-H138D-BM
-
galaxy-sources/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 1-Jan-82
;
ASCIZ /
COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION
1975,1976,1977,1978,1979,1980,1981,1982
/
;
; 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
EXTERNAL PAREDT,CMDEDT
OPRWHO==0
OPRVER==4
OPRMIN==0
OPREDT==145
%%.OPV==<VRSN.(OPR)>+CMDEDT+PAREDT
.JBVER==137
LOC .JBVER
EXP %%.OPV
RELOC
ENTVEC: JRST OPR ;MAIN ENTRY POINT
JRST OPRRMT ;REMOTE OPR ENTRY
EXP %%.OPV ;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 Revision History
COMMENT \
Edit Module When Change
1 OPR 31-May-77 First Development version on SYS (TOPS20)
2 OPR 1-Jun-77 Add code to handle WRITE-TO-OPR messages.
3 OPR 5-Jun-77 Add code to handle JFN's properly and
to fill in defaults.
4 OPR 7-Jun-77 Convert to new initialization to use
new GLXLIB.
5 OPR 14-Jun-77 Change .CMNUM and .CMNUX to save full words
rather than half words
6 OPR 17-Jun-77 Implement TAKE Command.
7 OPR 24-Jun-77 Change to use GALAXY TEXT message for acknowledgement
10 OPR 27-Jun-77 Fix SAVFIL to correctly save an FD.
11 OPR 30-Jun-77 Add PR.INF to save radix on number type fields
12 OPR 12-July-77 Clean up error handling
13 OPR 12-July-77 Make WTO with no object type work
14 OPR 26-Aug-77 Don't include generation number in filespec
for output
15 OPR 20-Sept-77 Make this be version 2
16 OPR 22-July-77 Add interrupt system for TOPS10
17 OPR 8-August-77 Convert to use GLXSCN on both TOPS10 and
TOPS20
20 OPR 19-August-77 Make SAVTOK work correctly
21 OPR 19-August-77 Make all negative numbers illegal
22 OPR 19-August-77 Remove Edit 15 which was a Release 3 only hack
23 OPR 19-August-77 Fix ill mem ref as a result of undefined
results in S2 from COMND
24 OPR 21-September-77 Complete changes to usd GLXSCN
25 OPR 22-September-77 Make TAKE command work on TOPS10
26 OPR 26-Sep-77 Don't reset INCMIN until entire command has
been processed.
27 OPR 11-Oct-77 Add SET TERMINAL command. Also add global
flag NOSND to indicate no message should be
sent to ORION for this command
30 OPR 19-Oct-77 Add SET TERMINAL MESSAGES and
SET TERMINAL NODE commands.
31 OPR 21-Oct-77 Fix race in message processing- don't
change pc if we are already processing messages
32 OPR 10-Nov-77 Add file spec defaults for TOPS-10
33 OPR 11-Nov-77 Add neww terminal types Keypad VT52 and VT50
34 OPR 11-Nov-77 Add new Operator Display Message to allow
multiple WTO's in one display message
35 OPR 13-Nov-77 Make DSPOPR routine process
multiple WTO's in one display message
36 OPR 18-Nov-77 Add code for multiple line RESPOND
37 OPR 18-Nov-77 Add code for SHOW DAYTIME
40 OPR 23-Nov-77 Change BLDCOM to use symbols for COMMAND message
41 OPR 2-Dec-77 Add code for multiple line SEND and multiple
line explanation for CANCEL
42 OPR 6-Dec-77 Add code to include text of command in COMMAND
message.
43 OPR 4-Jan-78 Support switch delete code in OPRTAB
44 OPR 17-Jan-78 Make sure all text is passed in message
45 OPR 2-Feb-78 Add new Display,WTO,WTOR,Ack message
processing
46 OPR 10-Feb-78 Add FLAG AC and fix up WTO,WTOR,ACK
47 OPR 18-April-78 Remove the Parser from OPR and make OPRPAR
50 OPR 12-June-78 Remove the display routines and use K%SOUT
51 OPR 20-June-78 Fix OPR Interrupt code with K%TPOS and
S%EXIT
52 OPR 28-Jun-78 Move DSPTAK, OPRTAK, and PRMTSZ to
OPRPAR
53 OPR 15-Jul-78 Remove all .REQUIRE Statements so they
may be moved to OPR.CMD
54 OPR 20-July-78 Fix OPRSON to display errors and exit
55 OPR 1-Aug-78 Add Counter to cleanup Core in OPR since
Page Fault Handler might take to long
56 OPR 2-Aug-78 Remove the "CURRENT DATE AND TIME"
text from SHWDAY.
57 OPR 3-Aug-78 Eliminate the text "ERROR:" from all
error messages and replace it with
"<CRLF>?". The effected label is MAIN.6.
60 OPR 16-Aug-78 Add support for NCP and correct ADJBP
61 OPR 31-Aug-78 Add SHOW Message display for QUASAR
62 OPR 5-Sept-78 Add EXIT command
63 OPR 8-Sept-78 Add P.ENDT for end of Take File
Also have PARSER CLOSE UNUSED JFNS ON -20
64 OPR 12-Sept-78 Move TXTINP and GETTXT to OPRPAR
65 OPR 29-Sept-78 Remove MSGCNT for releasing up Memory since
Library will take care of it.
66 OPR 23-Oct-78 Add TABAPL macro to get Application names
and symbols
67 OPR 9-Nov-78 Have EXIT use I%EXIT to terminate
70 OPR 30-Nov-78 Add new form of OPR hello message to ORION
71 OPR 4-Dec-78 Have EXIT use $HALT to enable Continue to work
72 OPR 19-Dec-78 Add DN200 code and OPRRMT as reenter address
73 OPR 21-Dec-78 Change to let superior IIC on Data Interrupts
for DN200
74 OPR 2-Jan-79 Add Link Status Checks for DN200 Input
to check for more data
75 OPR 5-Jan-79 Convert KEYTAB to ORNDSP Macro to be compatible
with standard PARUNV
76 OPR 5-Jan-79 Add TXTLIN to OPR to check if Multiple Line
Input allowed before calling TXTINP
77 OPR 8-Jan-79 Convert to new GLXLIB and $STOP taking ITEXT
100 OPR 10-Jan-79 Add OP.RMT to flags word for Remote Operator
on the -20.
AND GET CURRENT LOCATION ON THE -20 BEFORE HELLO
101 OPR 18-Jan-79 Add OPR HELP Command Action Support and create
NOPROC to mark no processing in the message
102 OPR 24-Jan-79 Add null to text from Network after SINR
103 OPR 26-JAN-79 CONVERT TO .REQUIRE FOR APPLICATION TABLES
104 OPR 23-Feb-79 Add Timer Trap for OPR wakeup as well as
P$INIT support. Use P$INTR at INT:
105 OPR 27-Feb-79 Support to output Prompt if displayed something
on interrupt breakout
Also Send Message to ORION on Take End
106 OPR 5-Mar-79 Add P$NPRO to set no Processing in Parser Return
Flags
Add PUSH Command Support
107 OPR 15-Mar-79 Clear Interrupt System on -20 to Remove IPCF
Interrupt from SIGNON Dialog
110 OPR 6-Apr-79 Add TAKOPR routine to check if TAKE commands
are allowed, also clear OPRs Data base on start
111 OPR 8-Apr-79 Check ENTER Command for Remote Operators
Pitch Short NSP Messages (less than or equal to
2)
These were just cr,lf
112 OPR 19-Apr-79 Remove terminal type keys. Parse directly into
ORNMAC .TTxxx codes suitable for K%STYP.
OPRCMD
113 OPR 15-May-79 Add MSGCNT to keep track if there were any
messages received
114 OPR 30-May-79 Add WAIT command to Application alternate Tables
115 OPR 4-Jun-79 Change SETFAL to add a null to the end of the
message instead of ^A.
116 OPR 21-Jun-79 Remove the CMDBLK as External reference and use
PRT.CF for the field.
117 OPR 6-Jul-79 Make the WAIT command invisible
120 OPR 11-Jul-79 Trap Error on EPCAP for the PUSH command incase
ACJ won't allow it.
121 OPR 25-Jul-79 Fix the -20 DN200 OPR to check for MO%CON to
insure that the link is still around
122 OPR 30-Aug-79 Add new KEYTAB entries for the -10
123 OPR 28-Oct-79 Add code to do an Auto take of
SYS:OPRnn.CMD or TTYnnn.CMD on CCL
entry
124 OPRCMD 17-MAR-80 Change ROUTE command tables for DEVICE routing.
125 OPR 14-May-80 Edit to change mixed messages to first word
mixed case and the rest lower
126 OPR 15-May-80 Change BLOCK assignments to $DATA
127 OPR 1-Aug-80 Add support for Control-Z (TOPS-10 style
exits.
130 OPR 7-Oct-80 QAR # 10-04645 Fix OPR to wake up for
IPCF message typeout. Added routines
SETIME, CLTIME and ROUTIM.
131 OPR 17-Dec-80 Increase size of PDL to avoid stopcodes
in P$HELP.
132 OPR 10-Jan-81 Fix bug in PRCMSG which caused ILM stopcodes
133 OPR 26-Jan-81 Add another escape table (VT1TAB) to handle
VT100 escape sequences.
134 4/2/81 Add detached job trapping. Tell ORION to forget about
the operator. Add routine DET.
135 4/7/81 Make detached job trapping under TOPS10 conditionals.
136 5/5/81 Add routine EXIT to temporarily solve the problem with
routine I%EXIT smashing output buffers. Make all calls to I%EXIT
call EXIT instead.
Make ROUTIM save and restore AC's
137 9/21/81 Make the wait command in the application tables visible.
140 9/23/81 Clear output suppress before next output @SETOUT.
141 9/28/81 Allow ^Z exit when application code is turned on.
142 11/11/81 Fix a Typo in an AOS S1,1 instruction.
143 12/14/81 Reset core limits on exit.
144 1/ 8/82 Remove call to I%RLIM. Don't need it anymore.
145 11/9/82 Fix copyright. GCO 4.2.1528
\
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
;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
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
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),<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
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
APLTAB: $KEYDSP(KEYAP1,<$ACTION(APLACT)>) ;MAIN APPL. TABLE
DEFINE X(A,B,C),<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
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
TOPS10<
MOVEI S1,[ASCIZ//] ;Get a control R
MOVEM S1,TRMBLK+2 ;Save it
> ;End of TOPS10
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
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
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
$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
CMDPMT: ITEXT (<^M^J^T/@PARBLK+PAR.PM/>)
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
$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
$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
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
$STOP(IDM,Message argument type ^O/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
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
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 S1,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
$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),<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,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
$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/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
; $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,%%.OPR ;ORNMAC VERSION NUMBER
STORE S1,OPH.OV+.OHDRS(M) ;SAVE IN BLOCK
MOVX S1,%%.OPV ;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.
$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
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.
$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
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,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