Trailing-Edge
-
PDP-10 Archives
-
bb-h138e-bm_tops20_v6_1_distr
-
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 Preliminaries
;
ASCIZ /
COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION
1975,1976,1977,1978,1979,1980,1981,1982,1983,1984,1985
/
;
; 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
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==:145 ;Maintenance edit number
OPRDEV==:170 ;Development edit number
VERSIN (OPR) ;Generate edit number
OPRWHO==0
OPRVER==5
OPRMIN==0
EXTERNAL CMDEDT,PAREDT
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. Preliminaries. . . . . . . . . . . . . . . . . . . . . 1
; 2. Edit vector and Version numbers. . . . . . . . . . . . 2
; 3. Table of Contents. . . . . . . . . . . . . . . . . . . 3
; 4. Revision history . . . . . . . . . . . . . . . . . . . 4
; 5. Special accumulator assignments. . . . . . . . . . . . 5
; 6. OPR impure data. . . . . . . . . . . . . . . . . . . . 6
; 7. Interrupt vector definitions . . . . . . . . . . . . . 7
; 8. Initialization blocks. . . . . . . . . . . . . . . . . 8
; 9. Table building data base . . . . . . . . . . . . . . . 9
; 10. OPR Initialization
; 10.1. Main Entry. . . . . . . . . . . . . . . . . . 10
; 10.2. TBLINI - Initialize command tables. . . . . . 11
; 11. CCLOOK . . . . . . . . . . . . . . . . . . . . . . . . 12
; 12. MAIN . . . . . . . . . . . . . . . . . . . . . . . . . 13
; 13. SETIME . . . . . . . . . . . . . . . . . . . . . . . . 15
; 14. TAKEND . . . . . . . . . . . . . . . . . . . . . . . . 16
; 15. DSPCMD . . . . . . . . . . . . . . . . . . . . . . . . 17
; 16. PRCMSG . . . . . . . . . . . . . . . . . . . . . . . . 18
; 17. VALMSG . . . . . . . . . . . . . . . . . . . . . . . . 18
; 18. ACKOPR . . . . . . . . . . . . . . . . . . . . . . . . 19
; 19. DSPOPD . . . . . . . . . . . . . . . . . . . . . . . . 20
; 20. SHWDSP . . . . . . . . . . . . . . . . . . . . . . . . 21
; 21. TABSET . . . . . . . . . . . . . . . . . . . . . . . . 22
; 22. Software interrupt system routines . . . . . . . . . . 23
; 23. Command and application action routines. . . . . . . . 24
; 24. ENTER and RETURN command tables. . . . . . . . . . . . 25
; 25. Control-Z and EXIT command tables and action routines. 26
; 26. TAKOPR . . . . . . . . . . . . . . . . . . . . . . . . 27
; 27. WAIOPR . . . . . . . . . . . . . . . . . . . . . . . . 28
; 28. SETRTN and SETTRM. . . . . . . . . . . . . . . . . . . 29
; 29. ESCAPE Sequence Table for Operator Terminals . . . . . 30
; 30. SHWDAY . . . . . . . . . . . . . . . . . . . . . . . . 33
; 31. OPRRMT . . . . . . . . . . . . . . . . . . . . . . . . 34
; 32. WAITCN . . . . . . . . . . . . . . . . . . . . . . . . 35
; 33. REMSET . . . . . . . . . . . . . . . . . . . . . . . . 36
; 34. SETOUT . . . . . . . . . . . . . . . . . . . . . . . . 37
; 35. SNDOUT . . . . . . . . . . . . . . . . . . . . . . . . 37
; 36. OUTRTN . . . . . . . . . . . . . . . . . . . . . . . . 37
; 37. SETPTR . . . . . . . . . . . . . . . . . . . . . . . . 37
; 38. INPINT . . . . . . . . . . . . . . . . . . . . . . . . 38
; 39. OUTINT . . . . . . . . . . . . . . . . . . . . . . . . 38
; 40. IPCRMT . . . . . . . . . . . . . . . . . . . . . . . . 38
; 41. INPDAT . . . . . . . . . . . . . . . . . . . . . . . . 39
; 42. CONNEC . . . . . . . . . . . . . . . . . . . . . . . . 40
; 43. TXTLIN . . . . . . . . . . . . . . . . . . . . . . . . 41
; 44. SETFAL . . . . . . . . . . . . . . . . . . . . . . . . 42
; 45. PUSHRT . . . . . . . . . . . . . . . . . . . . . . . . 43
; 46. TERMFK . . . . . . . . . . . . . . . . . . . . . . . . 44
; 47. OPRSON . . . . . . . . . . . . . . . . . . . . . . . . 45
; 48. OPRRST . . . . . . . . . . . . . . . . . . . . . . . . 46
; 49. SETREP . . . . . . . . . . . . . . . . . . . . . . . . 47
; 50. SETMES . . . . . . . . . . . . . . . . . . . . . . . . 48
; 51. TABCHK . . . . . . . . . . . . . . . . . . . . . . . . 49
; 52. GETLOC . . . . . . . . . . . . . . . . . . . . . . . . 50
; 53. EXIT . . . . . . . . . . . . . . . . . . . . . . . . . 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.
\ ;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
;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,D),<EXP C ;SET UP ADDRESS OF EACH ENTRY
EXTERNAL C ;SET UP AS EXTERNAL
.REQUIRE C>
SYNTAB: EXP OPRCMD## ;MAIN OPR TABLES
TABAPL ;ADDRESS OF APPLICATION TABLES
TABINI: $INIT(MANTAB) ;INIT FUNCTION FOR TABLES
MANTAB: $KEYDSP(APLALT,<$ACTION(CMDACT)>) ;KEYWORD TABLE BLOCK
APLALT: $STAB
TOPS10< ORNDSP(,\"32,CTZ,CM%INV) > ;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
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,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
$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
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
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
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,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,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/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
MOVX S1,OPREDT ;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