Trailing-Edge
-
PDP-10 Archives
-
bb-l014t-bm_tops20_v7_0_atpch20
-
autopatch/batcon.x20
There is 1 other file named batcon.x20 in the archive. Click here to see a list.
TITLE BATCON -- GALAXY Batch Job Controller
SUBTTL Preliminaries
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
LSTING==0 ;NORMAL MODE IS LISTING ON
SEARCH GLXMAC ;SEARCH FOR GALAXY PARAMETERS
PROLOG(BATCON) ;SET UP BATCON WITH GLXLIB
SEARCH QSRMAC ;QUASAR DATA BASE SYMBOLS
SEARCH BATMAC ;BATCONS PARAMETER FILE
SEARCH ORNMAC ;GET ORIONS SYMBOLS
;THE FOLLOWING ARE DEFINED EXTERNAL
EXTERNAL L$OUT1 ;LOG OUTPUT ROUTINE
EXTERNAL LOGERR ;LOG FILE ERROR MESSAGE
BATVEC: BLDVEC (BATMAC,BMC,L)
BLDVEC (BATCON,BTN,L)
BLDVEC (GLXMAC,GMC,L)
BLDVEC (ORNMAC,OMC,L)
BLDVEC (QSRMAC,QMC,L)
BLDVEC (BATLOG,BML)
BTNMAN==:6003 ;MAINTENACE EDIT NUMBER
BTNDEV==:6002 ;DEVELOPMENT EDIT NUMBER
VERSIN (BTN) ;GENERATE EDIT NUMBER
BTNWHO==0
BTNVER==6 ;MAJOR VERSION NUMBER
BTNMIN==0 ;MINOR VERSION NUMBER
EXTERN BMLEDT
BTNVRS==<VRSN.(BTN)>+BMCEDT+GMCEDT+OMCEDT+QMCEDT+BMLEDT
LOC 41
PUSHJ P,UUOCON
.JBVER==137
LOC .JBVER
EXP BTNVRS
RELOC
Subttl Table of Contents
; Table of Contents for BATCON
;
; Section Page
;
;
; 1. Assembly Parameters . . . . . . . . . . . . . . . . . 5
; 2. Revision History . . . . . . . . . . . . . . . . . . . 6
; 3. BATCON Data Base . . . . . . . . . . . . . . . . . . . 7
; 4. PREDEFINED STORAGE BLOCKS FOR BATCON . . . . . . . . . 8
; 5. BATCON Entry Section . . . . . . . . . . . . . . . . . 9
; 6. Dispatch and Time slice Routines . . . . . . . . . . . 10
; 7. PROIPC - PROCESS IPCF MESSAGES . . . . . . . . . . . . 11
; 8. WTOMSG - SEND A WTO MESSAGE FROM MAIN LEVEL . . . . . 12
; 9. CHKCHK Set for any checkpoints needed . . . . . . . . 13
; 10. CHECKPOINT MESSAGE FROM QUASAR . . . . . . . . . . . . 14
; 11. MSGQSR - SETUP MESSAGE TO QUASAR . . . . . . . . . . . 15
; 12. SNDCHK - SETUP AND SEND STATUS MESSAGE TO QUASAR . . . 16
; 13. OPERATOR ACTION MESSAGE FROM QUASAR . . . . . . . . . 17
; 14. SETUPJ - ROUTINE TO PROCESS SETUP MESSAGE . . . . . . 18
; 15. ABORTJ - ABORT JOB BY USER REQUEST . . . . . . . . . . 19
; 16. WTORMS - RESPONSE TO WTOR MESSAGE . . . . . . . . . . 20
; 17. PROMES - PROCESS ACTION MESSAGE FROM USER OR OPERATOR 21
; 18. SENDJB - SEND TEXT TO JOB . . . . . . . . . . . . . . 22
; 19. EXAMIN - SHOW CONTROL FILE TO OPERATOR . . . . . . . . 23
; 20. CLRSTR - CLEAN UP STREAM WHEN INACTIVE . . . . . . . . 24
; 21. NEXTJB - PROCESS NEXTJOB MESSAGE . . . . . . . . . . . 25
; 22. TOPS10 PTY STARTUP CODE . . . . . . . . . . . . . . . 27
; 23. TOPS20 PTY SETUP CODE . . . . . . . . . . . . . . . . 28
; 24. SET HALF DUPLEX FOR PTY . . . . . . . . . . . . . . . 29
; 25. Job Processor - Start the Stream . . . . . . . . . . . 30
; 26. LOGINJ - LOGIN A JOB ON PTY . . . . . . . . . . . . . 31
; 27. LOGSET - SETUP JOB AFTER LOGIN . . . . . . . . . . . . 32
; 28. JOBSTA - JOB STARTUP AFTER LOGIN COMPLETED . . . . . . 33
; 29. Job Processor - Honor Job's Input Request . . . . . . 34
; 30. Job Processor - Execute Batch Commands . . . . . . . . 40
; 31. Job Processor - Perform Auto KJOB and Dismiss the Job 48
; 32. QSRUPD - UPDATE DEVICE STATUS TO QUASAR . . . . . . . 49
; 33. IDNOPR - IDENTIFY LINE TO OPERATOR . . . . . . . . . . 50
; 34. CANCJB - CANCEL A JOB ROUTINE . . . . . . . . . . . . 51
; 35. STOPJB AND CONTJB ROUTINES . . . . . . . . . . . . . . 52
; 36. CONTJB - CONTINUE JOB BY OPERATOR . . . . . . . . . . 53
; 37. CANUSR - CANCEL FROMA USER REQUEST . . . . . . . . . . 54
; 38. ATOKJB - LOGOUT FOR THE -10 . . . . . . . . . . . . . 55
; 39. ATOKJB - LOGOUT FOR THE -20 . . . . . . . . . . . . . 56
; 40. IOWAIT - Routine for Output/Input Waiting . . . . . . 57
; 41. WAITOU - WAIT FOR OUTPUT BEFORE PROCEEDING . . . . . . 58
; 42. Job Processor - Error Analysis, Processing, and Report 61
; 43. Job Processor - Random Little Routines . . . . . . . . 62
; 44. SETLOC - SET JOB LOCATION FOR THE -20 . . . . . . . . 63
; 45. CHANNEL RELEASE ROUTINES FOR PTYS . . . . . . . . . . 66
; 46. CONTROL FILE MANIPULATION ROUTINES . . . . . . . . . . 69
; 47. TOPS-20 POSITIONING ROUTINES . . . . . . . . . . . . . 70
Subttl Table of Contents (page 2)
; Table of Contents for BATCON
;
; Section Page
;
;
; 48. FNDCTL - OPEN CONTROL FILE ROUTINE . . . . . . . . . . 71
; 49. INPPTY - PTY INPUT ROUTINES . . . . . . . . . . . . . 72
; 50. SEND PTY OUTPUT TO JOB . . . . . . . . . . . . . . . . 73
; 51. GETPTY - GET A CHARACTER FROM PTY INPUT BUFFER . . . . 74
; 52. PUTPTY - PUT CHARACTERS INTO PTY OUTPUT BUFFER . . . . 75
; 53. UUOCON - BATCON LUUO HANDLER . . . . . . . . . . . . . 77
; 54. TABSRC - TABLE LOOKUP ROUTINE . . . . . . . . . . . . 80
; 55. System Dependent Subroutines . . . . . . . . . . . . . 81
; 56. TOPS10 Subroutines . . . . . . . . . . . . . . . . . . 82
; 57. TOPS20 Subroutines . . . . . . . . . . . . . . . . . . 84
; 58. JOBSTS - JOB STATUS ON STREAM . . . . . . . . . . . . 86
; 59. TSLEEP - SLEEP ROUTINE FOR DISPATCH LOOP . . . . . . . 87
; 60. BATPSI - BATCON PSI ENABLE CODE . . . . . . . . . . . 88
; 61. BATIPC - BATCON IPCF INTERRUPT HANDLER . . . . . . . . 89
; 62. INTERRUPT PROCESSING ROUTINES . . . . . . . . . . . . 90
; 63. PTY AND LOG OUTPUT ROUTINES . . . . . . . . . . . . . 91
; 64. ERRTAB - EXPAND ERROR TABLE VALUES . . . . . . . . . . 92
SUBTTL Assembly Parameters
IFN FTUUOS,< ;DEFINITIONS FOR TOPS10
IF1,<PRINTX ASSEMBLING GALAXY-10 BATCON>
DEFINE KJSTR,<[ASCIZ\KJOB/BATCH\]>
DEFINE TIMSTR,<[ASCIZ/SET TIME /]>
> ;END OF IFN FTUUOS
IFN FTJSYS,< ;DEFINITIONS FOR TOPS20
IF1,<PRINTX ASSEMBLING GALAXY-20 BATCON>
DEFINE KJSTR,<[ASCIZ\LOGOUT\]>
DEFINE TIMSTR,<[ASCIZ/SET TIME-LIMIT /]>
> ;END OF IFN FTJSYS
SUBTTL Revision History
COMMENT \
***** Release 4.2 -- begin maintenance edits *****
4206 4.2.1545
In routines ISCMNT and CPYXCC check for "=" so that FL.SUP can be set
if appropriate.
4207 4.2.1550
In routine INMO.2, BATCON no longer prints the Monitor Level Error
message.
4210 4.2.1560
In routine INMONM at INMO.3, change the fatal error message to one
indicating the job can not return to monitor level and may be hung.
4211 4.2.1563
In routines HONORJ and COMTRM no longer consider ESC characters to be
line terminators when processing a control file.
NOTE: This edit changes one of the lines of edit 4164
4212 4.2.1570
Modify edit 4164 so that FL.SUP is set only if the first character in
user mode is an equal sign. Reset it after the line is processed.
Note: This edit changes edit 4164 and gets rid of edit 4206. Also, a line of
of edit 4211 is deleted and two lines of edit 4152 are deleted.
4213 4.2.1572 26-Apr-84
If a batch job login fails due to a failure of CRJOB, give
the operator the message associated with the error code.
Note: This edit requires edit 4160.
4215 4.2.1581 18-Jul-84
Include the account information in the display of the job parameters
in the log file.
4216 4.2.1586 13-Aug-84
Before closing the log file, update its .FBBK0 word in its FDB so it
will be saved in subsequent incremental saves.
4217 In routine WAITOU: add a counter for output wait.
If counter is exceeded and still no output and PTY line is detached, or job is
no longer under BATCON's control, BATCON will flush the stream.
GCO 4.2.1609 SPR# 20-20515
EDIT 4220 In routine STOPJB: check JL.UML to determine whether control Cs
should be sent to the job.
GCO 4.2.1618 SPR# 20-20752
***** Release 5.0 -- begin development edits *****
4250 5.1073 27-Jan-84
Move to new development area. Add version vector. Clean up
edit organization. Update TOC. Change version number to 5.
4251 5.1092 13-Feb-84
Make BATCON a system process by setting IB.SYS in IB.
4252 5.1095 13-Feb-84
Restore PUSHJ UUOCON and correct the printing of the GALAXY version
number.
4253 5.1167 15-Oct-84
Correct the way the ACCOUNT: field is positioned in the log file
herald.
4254 5.1197 5-Feb-85
Set BATCON as a system process or not according to the value BAT.JP
as determined by GALGEN.
4255 5.1200 6-Feb-85
Do GTJFNs with the restricted access bit, GJ%ACC, turned on
***** Release 5.0 -- begin maintenance edits *****
4300 Increment maintenance edit level for version 5 of GALAXY.
4301 5.1225 15-Oct-85
Allow user data line feeds and carriage returns to be passed down
the PTY: when the first character of the control line is an "=". Suppress
only the final CR-LF pair.
4302 5.1232 3-Mar-86
In LOGS.4 add three new SETJB% calls to set the batch job name,
sequence number and request ID in th JSB. This is for USAGE session record.
***This edit requires edits:
MONSYM(7258), MONITOR(7259), ACTSYM(36), CHKPNT(129).***
4303 5.1241 11-Jun-86
After a system crash, for batch jobs submitted with /RESTART:NO
and no CHKPNTs, check first for reserved label %RERR. If found, continue
processing from that point; otherwise process as before, i.e., search
for the first occurence of %FIN::.
4304 5.1242 18-Jul-86
Correct the call to CHFDB when zeroing out word .FBBK0 of the log
file's FDB. Use the log file's JFN, not its IFN.
4306 5.1246 13-Feb-87
When getting a PTY for a batch job, in addition to checking if bit
DV%AV is lit in the device characteristics word, also check if the device
is assigned or not.
***** Release 6.0 -- begin development edits *****
6000 6.1037 26-Oct-87
Move sources from G5: to G6:
6001 6.1057 4-Nov-87
Change PS: to BS: and PS:[SPOOL] to SPOOL: for Non PS: login feature.
6002 6.1225 8-Mar-88
Update copyright notice.
6003 6.1269 18-Oct-88
Define G$REM,G$NEBF,G$REMN,G$DEFL. Change all $WTO to $QWTO and $ACK
to $QACK so that any messages relating to a CLuster event will be sent back to
the local and remote node.
\ ;End of Revision History
SUBTTL BATCON Data Base
SYSPRM IODISP,IOWAIT,IOW.02 ;DISPATCH ENTRY FOR -10 AND -20
LOWDAT:
LIBVER: BLOCK 1 ;GLXLIB VERSION NUMBER
BASTBL:: BLOCK DEFMJB ;STREAM DATA BASE POINTERS (ALSO STREAM AC R)
STREAM:: BLOCK DEFMJB ;STREAM INDEX BLOCK FOR BATCH STREAMS
TOPPDL: BLOCK TPSIZE ;TOP LEVEL PUSH DOWN LIST
HIACTV: BLOCK 1 ;HIGHEST STREAM NUMBER ACTIVE
STACTV: BLOCK 1 ;NUMBER OF ACTIVE STREAMS
CURTIM:: BLOCK 2 ;UNIVERSAL DATE TIME FOR $TEXT OUTPUT
MINMAX: BLOCK 1 ;CORE VALUE FOR MIN AND MAX
TEMP2: BLOCK 1 ;TEMP CELL USED DURING '.ERROR' AND '.OPERATOR'
WTOCNT: BLOCK 1 ;COUNT UNUSED IN WTO MESSAGE PAGE
;POINTER MUST FOLLOW ***
WTOPTR: BLOCK 1 ;BYTE POINTER WITHIN WTO MESSAGE
JOBTOT:: BLOCK 1 ;NUMBER OF JOBS PROCESSED
JOBSCT: BLOCK 1 ;TOTAL NUMBER OF JOBSTS DONE
JOBWCT: BLOCK 1 ;COUNT OF WAITS DURING LOGIN AND LOGOUT
STIME: BLOCK 1 ;START UNIV. DATE AND TIME
FLAGS: BLOCK 1 ;GLOBAL FLAGS FOR BATCON
B.REMT==1B0 ;REMOTE PROCESSING IS AVAILABLE
;**;[6003]At FLAGS: BLOCK 1 +1L add 4 lines JYCW Oct-18-88
G$REM:: BLOCK 1 ;[6003]RELEASE MESSAGE TO BE SENT REMOTELY
G$NEBF:: BLOCK 1 ;[6003]REMOTE MESSAGE FLAG
G$REMN:: BLOCK 1 ;[6003]REMOTE NODE NAME WHERE MSG CAME FROM
G$DEFL:: BLOCK 1 ;[6003]LOCAL NAME USED AS DEFAULT NAME
IFN FTJSYS,<
DEVNAM: BLOCK 2 ;DEVICE NAME
FIRPTY: BLOCK 1 ;PTY OFFSET FOR PTY NUMBER
NUMPTY: BLOCK 1 ;NUMBER OF PTYS IN THE SYSTEM
INTRP1: BLOCK 1 ;INTERRUPT LEVEL PC
INTRP2: BLOCK 1 ;INTERRUPT PC LEVEL 2
INTRP3: BLOCK 1 ;INTERRUPT PC LEVEL 3
EE: BLOCK 1 ;TEMPORARY STORAGE FOR INPPTY
SPLNUM: BLOCK 1 ;DIRECTORY NUMBER OF <SPOOL>
INTERR: BLOCK 1 ;PTY ERRORS ENCOUNTERED
UDIERR: BLOCK 1 ;USER INPUT ERRORS
MYNODE: BLOCK 1 ;SAVE MY NODE VALUE
CRJBLK: BLOCK 15 ;CRJOB STORAGE FOR LOGINJ
> ;END OF IFN FTJSYS
MAX <RSU.SZ!REL.BL!STU.SZ!REQ.SZ!CHE.SZ>
MSGADR: BLOCK MAXSIZ ;MESSAGE DATA AREA
IFN FTUUOS,<
SFDPAT: BLOCK 11 ;SFD BLOCK - WORDS 0,1, AND 10 ARE ALWAYS ZERO
> ;END OF IFN FTUUOS
INMONE: BLOCK 1 ;IN MONITOR MODE ERROR COUNT
LASLOW:
CORCHK: EXP INPCOR ;FLAG WORD FOR CORE CHECKING
IFN FTJSYS,<
STRCHN:
ZZ==0
REPEAT 3,<EXP ZZ
ZZ=ZZ+2>
ZZ=^D23
REPEAT PTYNCH,<EXP ZZ
ZZ=ZZ+2>
LEVTAB: EXP INTRP1 ;INTERRUPT LEVEL PC
EXP INTRP2 ;LEVEL 2 INTERRUPTS
EXP INTRP3 ;LEVEL 3 INTERRUPTS
DEFINE CHNBLD(XX,YY),<
XWD INT.IN,PTYC'XX ;PTY HAS OUTPUT
XWD INT.OU,PTYC'YY ;PTY WANTS INPUT (HUNGRY)
>
CHNTAB: ZZ==0
ZZ1==1
REPEAT 3,<CHNBLD(\ZZ,\ZZ1)
ZZ==ZZ+2
ZZ1=ZZ+1>
BLOCK ^D17 ;INTERRUPT SYSTEM CHANNEL TABLE
REPEAT PTYNCH,<CHNBLD(\ZZ,\ZZ1)
ZZ==ZZ+2
ZZ1=ZZ+1>
XWD INT.AL,BATIPC ;BATCON IPCF INTERRUPT CHANNEL 35
> ;END OF IFN FTJSYS
IFN FTUUOS,<
VECTOR: BLOCK 0 ;BEGINNING OF INTERRUPT VECTOR
VECIPC: BLOCK 4 ;IPCF INTERRUPT BLOCK
ENDVEC==.-1 ;END OF INTERRUPT VECTOR
> ;END IFN FTUUOS
SUBTTL PREDEFINED STORAGE BLOCKS FOR BATCON
;HELLO MESSAGE TO QUASAR BLOCK
HELLOM: $BUILD HEL.SZ ;HELLO MESSAGE TO QUASAR
$SET(.MSTYP,MS.TYP,.QOHEL) ;HELLO MESSAGE
$SET(.MSTYP,MS.CNT,HEL.SZ) ;MESSAGE SIZE
$SET(HEL.NM,,<'BATCON'>) ;PROGRAM NAME
$SET(HEL.FL,HEFVER,%%.QSR) ;QUASAR VERSION NUMBER
$SET(HEL.NO,HENNOT,1) ;NUMBER OF OBJECTS
$SET(HEL.NO,HENMAX,DEFMJB) ;MAXIMUM NUMBER OF STREAMS
$SET(HEL.OB,,.OTBAT) ;OBJECT TYPE BATCH
$EOB
;ORION IPCF SEND BLOCK
;QUASAR IPCF SEND BLOCK
SABBLK: $BUILD SAB.SZ ;BUILD SEND ARGUMENT BLOCK
$SET(SAB.PD,,<0>) ;PID TO SEND TO ...0
$SET(SAB.LN,,<PAGSIZ>) ;SIZE OF MESSAGE PAGE=1000
$SET(SAB.SI,SI.FLG,<1>) ;SYSTEM PID FLAG
$SET(SAB.SI,SI.IDX,<SP.QSR>) ;SPECIAL PID INDEX
$EOB
;GLXLIB INITIALIZATION BLOCK
IPBBLK: $BUILD IB.SZ ;BUILD IB BLOCK FOR INIT
$SET(IB.PRG,,%%.MOD) ;PROGRAM NAME
$SET(IB.OUT,,OUTDAT) ;DEFAULT OUTPUT ROUTINE
$SET(IB.FLG,IP.STP,1) ;STOPCODES TO ORIONS
$SET(IB.FLG,IB.SYS,BAT.JP) ;Define system process bit
$SET(IB.FLG,IB.NAC,1) ;Restricted JFN access
IFN FTJSYS,<
$SET(IB.INT,,<LEVTAB,,CHNTAB>) ;SIR OF INTERRUPT SYSTEM
>;END FTJSYS
IFN FTUUOS,<
$SET(IB.INT,,VECTOR) ;TOPS-10 INTERRUPT VECTOR
>;END FTUUOS
$SET(IB.PIB,,PIBBLK) ;ADDRESS OF PID BLOCK
$EOB
PIBBLK: $BUILD PB.MNS
$SET(PB.HDR,PB.LEN,PB.MNS) ;MINIMUM SIZE PID BLOCK
$SET(PB.FLG,IP.PSI,1) ;ATTACH TO PSI
IFN FTJSYS,<
$SET(PB.INT,IP.CHN,^D35) ;CHANNEL TO ATTACH TO
>;END FTJSYS
IFN FTUUOS,<
$SET(PB.INT,IP.CHN,<VECIPC-VECTOR>) ;OFFSET FOR IPCF
>;END FTUUOS
$SET(PB.SYS,IP.SQT,20) ;SET SEND QUOTA
$SET(PB.SYS,IP.RQT,20) ;SET RECIEVE QUOTA
$EOB
ITIME: ITEXT (<^D/T1/:^D2R0/T2/:^D2R0/T3/>)
JIBTXT:: ITEXT (<^R/.JQJBB(R)/
>) ;JOB INFO BLOCK EXPANSION
SUBTTL BATCON Entry Section
BATCON: JFCL ;NO CCL ENTRY POINT
RESET
MOVE P,[IOWD TPSIZE,TOPPDL]
SETZM LOWDAT ;PREPARE TO CLEAR THE LOW SEG
MOVE T1,[LOWDAT,,LOWDAT+1]
BLT T1,LASLOW-1 ;CLEAR ALL THE LOW SEGMENT
MOVEI S2,IPBBLK ;IPB BLOCK FOR I%INIT
MOVEI S1,IB.SZ ;SIZE OF THE BLOCK
PUSHJ P,I%INIT## ;INITIALIZE GLXLIB SYSTEM
MOVEM S1,LIBVER ;SAVE GLXLIB VERSION NUMBER
$CALL I%NOW ;GET CURRENT TIME
MOVEM S1,STIME ;SAVE TIME FOR START
PUSHJ P,ONCECN ;SET UP ONCE ONLY CONSTANTS
MOVSI S1,-DEFMJB ;NUMBER OF JOBS
BATC.1: SETOM STREAM(S1) ;INIT TO -1
AOBJN S1,BATC.1 ;GET THEM ALL
PUSHJ P,BATPSI ;SET UP INTERRUPT SYSTEM
MOVEI S1,HELLOM ;MESSAGE ADDRESS IN S
MOVEM S1,SABBLK+SAB.MS ;SAVE MESSAGE ADDRESS
PUSHJ P,SNDQSR ;SEND TO QUASAR
PUSHJ P,WAKEME ;SET WAKE CONDITIONS FOR FIRST TIME
$CALL I%NOW ;Get the current time
ADDI S1,100*3 ;Add about a minute
MOVEM S1,NTIME ;And remember for checkpointing
SUBTTL Dispatch and Time slice Routines
TOPLVL: $CALL C%RECV ;ATTEMPT TO RECEIVE A MESSAGE
JUMPF TOPL.0 ;NO,,CONTINUE ON
PUSHJ P,PROIPC ;PROCESS IPCF MESSAGES
JRST TOPLVL ;FINISH OFF ALL MESSAGES
TOPL.0: SKIPN STACTV ;ANY STREAMS ACTIVE
JRST DISP.3 ;NO, SEE IF SCHEDULING HAS HAPPENED
$CALL CHKCHK ;Check on checkpoints
TOPDIS: SETZM CURTIM+1 ;CLEAR SECOND WORD
$TEXT (<-1,,CURTIM>,<^C/[-1]/^A>)
MOVEI S,0 ;START AT THE BEGINNING
DISP.1: SKIPL R,BASTBL(S) ;GET DATA BASE WORD
JRST DISP.2 ;CANNOT PROCESS THIS STREAM
TLNE R,RL.MES!RL.CKP ;ANY MESSAGE LIST SET UP OR CHECKPOINT NEEDED
PUSHJ P,CHKMES ;YES,,CHECK FOR MESSAGES
TLZE R,RL.MSP ;MESSAGE TO PROCESS???
JRST DISP.C ;YES .. PROCESS
TLNE R,RL.STP!RL.OPR ;IS IT STOPPED OR OPR WAIT
JRST DISP.2 ;CANNOT PROCESS THIS STREAM
DISP.C: HRLZI 0,.JREGS+1(R) ;set up register(lh) for blt
HRRI 0,1 ;set up register(rh) for blt
BLT 0,13 ;restore 1-13
MOVE 0,.JREGS(R) ;restore 0
MOVE 17,.JREGS+14(R) ;AND RESTORE P
POPJ P, ;RETURN TO INTERUPTED PROCESS
;RETURN FROM PROCESS IS BY PUSHJ P,QTS. WHICH SAVES THE REGS AND
;PROCEEDS TO NEXT PROCESS.
QTS: MOVEM R,BASTBL(S) ;SAVE R FLAGS
MOVEM 17,.JREGS+14(R) ;SAVE P
MOVEM 0,.JREGS(R) ;save 0
HRLZI 0,1 ;set up register(lh) for blt
HRRI 0,.JREGS+1(R) ;set upr register(rh) for blt
BLT 0,.JREGS+13(R) ;save 1-13
MOVE P,[IOWD TPSIZE,TOPPDL] ;RESTORE TOP LEVEL PDL
STEXIT: ;EXIT FROM STREAM
DISP.2: CAMGE S,HIACTV ;PASSED ALL ACTIVE JOBS
AOJA S,DISP.1 ;NO, SKIP TO NEXT
DISP.3: PUSHJ P,TSLEEP ;JOB SLEEP,HIBER ROUTINE
JRST TOPLVL ;REENTER TOP LEVEL LOOP
CHKMES: TLZE R,RL.CKP ;CHECKPOINT NEEDED
JRST CHKM.1 ;DO THE CHECKPOINT
CHKM.0: SKIPG .JMESC(R) ;ANY MESSAGES LEFT
POPJ P, ;NO..RETURN
PUSHJ P,PROMES ;PROCESS MESSAGES
JUMPF .POPJ ;MESSAGE IN PROGRESS,,,RETURN
JRST CHKMES ;SEE IF ANY MORE
CHKM.1: MOVE F,.JREGS+F(R) ;RESTORE THE F VALUES
PUSHJ P,SNDCHK ;SEND THE STATUS AND CHECKPOINT LOG FILE
TLNN R,RL.KJB ;IS JOB LOGGING OUT IGNORE CLOSJB
JUMPF CHKM.3 ;ERROR..SETUP TO ABORT JOB
CHKM.2: MOVEM F,.JREGS+F(R) ;SAVE F AGAIN
MOVEM R,BASTBL(S) ;UPDATE R IN BASTBL
JRST CHKM.0 ;CHECK FOR MESSAGES NOW
CHKM.3: MOVE S1,.JREGS+14(R) ;GET STREAMS STACK
PUSH S1,[CLOSJB] ;PUT CLOSE ON STACK
MOVEM S1,.JREGS+14(R) ;RESTORE THE STACK
TLZ R,RL.OPR!RL.STP!RL.JIE!RL.DIA ;CLEAR R FLAGS
TLZ F,FL.NER!FL.PLS ;CLEAR F FLAGS
TLO R,RL.MSP ;SET MESSAGE TO PROCESS
JRST CHKM.2 ;SETUP TO RETURN
SUBTTL PROIPC - PROCESS IPCF MESSAGES
PROIPC: LOAD S2,MDB.SI(S1) ;GET SYSTEM PID INFO
TXZN S2,<SI.FLG> ;FROM SYSTEM PID
POPJ P, ;NOT FROM SYSTEM PID...IGNORE
LOAD T1,S2,SI.IDX ;GET SYSTEM PID INDEX
CAIE T1,SP.QSR ;IS IT FROM QUASAR
CAIN T1,SP.OPR ;IS IT FROM ORION
SKIPA ;YES..
POPJ P, ;NOT FROM QUASAR OR ORION..IGNORE
LOAD G,MDB.MS(S1),MD.ADR ;GET MESSAGE ADDRESS
;**;[6003]At PROIPC:+10L add 2 lines JYCW Oct-18-88
LOAD S1,.MSFLG(G),MF.NEB ;[6003]GET THE REMOTE MESSAGE BIT
MOVEM S1,G$NEBF ;[6003]AND SAVE IT
LOAD T2,.MSTYP(G),MS.TYP ;GET MESSAGE TYPE
MOVSI S1,-NUMMSG ;NUMBER OF MESSAGES
PROP.1: HRRZ T1,MSGTAB(S1) ;GET TABLE ENTRY
CAMN T2,T1 ;CHECK IFMATCH
JRST PROP.2 ;YES...GO PROCESS
AOBJN S1,PROP.1 ;NO....TRY NEXT ENTRY
CAIL T1,.OMOFF ;FIRST ORION MESSAGE
PJRST PROP.3 ;CHECK OPERATOR ACTION MESSAGE
MOVEI S2,[ITEXT (<Invalid Message Type ^O/T2/ From QUASAR or ORION>)]
PUSHJ P,WTOMSG ;SEND WTO WITH ERROR
PJRST C%REL ;RELEASE THE MESSAGE
PROP.2: HLRZ T1,MSGTAB(S1) ;GET ROUTINE ADDRESS
PUSHJ P,0(T1) ;PROCESS MESSAGE
PJRST C%REL ;RELEASE MESSAGE AND RETURN
PROP.3: PUSHJ P,OPRACT ;PROCESS THE MESSAGE
PJRST C%REL ;RELEASE MESSAGE AND RETURN
;MESSAGE TABLE FOR DISPATCHING IPCF'S
MSGTAB: XWD NEXTJB,.QONEX ;NEXTJOB MESSAGE
XWD WTORMS,.OMRSP ;RESPONSE TO WTOR
XWD ABORTJ,.QOABO ;ABORT MESSAGE
XWD SETUPJ,.QOSUP ;SETUP JOB MESSAGE
XWD TEXTMS,MT.TXT ;TEXT MESSAGE FROM QUASAR OR ORION
NUMMSG==.-MSGTAB ;NUMBER OF ENTRIES IN TABLE
SUBTTL WTOMSG - SEND A WTO MESSAGE FROM MAIN LEVEL
;THIS ROUTINE IS CALLED WITH S2 ADDRESS OF ITEXT
;**;[6003]At WTOMSG:+0L change 1 line JYCW Oct-18-88
WTOMSG: $QWTO (<BATCON Error>,<^I/(S2)/>) ;[6003]Use $QWTO instead of $WTO
POPJ P, ;RETURN
SUBTTL TEXTMS - TEXT MESSAGE FROM QUASAR OR ORION
TEXTMS: $RET ;No longer want to complain
; MOVEI S2,[ITEXT (<BATCON IPCF Message Error
;^T/.OHDRS+ARG.DA(G)/>)]
;*** TEXT MESSAGE HAS ARGUMENT BLOCK WITH TEXT
; PJRST WTOMSG ;SEND THE WTO MESSAGE
SUBTTL CHKCHK Set for any checkpoints needed
; This routine requests a checkpoint for all of the streams
; if it is time.
CHKCHK: $CALL I%NOW ;Get the current time
CAMGE S1,NTIME ;Time to checkpoint?
$RET ;No.
ADDI S1,100*3 ;Want to wait 100 O sec. (jiffies)
MOVEM S1,NTIME ;Remember the next time
MOVSI S2,-DEFMJB ;GET MAX NUMBER OF JOBS
LOOP.1: SKIPL S1,BASTBL(S2) ;Get data base word
JRST LOOP.2 ;Not active, do nothing else
TLO S1,RL.CKP ;We want a checkpoint
MOVEM S1,BASTBL(S2) ;Remember
LOOP.2: AOBJN S2,LOOP.1 ;Try next entry
$RET ;And return
NTIME: BLOCK 1 ;Where to remember time
SUBTTL CHECKPOINT MESSAGE FROM QUASAR
CHKPNT: MOVE T3,RCK.TY(G) ;GET OBJECT TYPE
CAIE T3,.OTBAT ;IS IT BATCH
PUSHJ P,ERROR ;NOT BATCH JOB,,,STOPCODE
;QUASAR ERROR
LOAD S1,RCK.UN(G),RO.UNI ;GET UNIT NUMBER
PUSHJ P,FSTREA ;FIND THE STREAM
JUMPF .POPJ ;CAN'T FIND...IGNORE IT
MOVE S,S1 ;PLACE STREAM INDEX IN S
SKIPL R,BASTBL(S) ;GET DATA BASE WORD
POPJ P, ;NO..STREAM INACTIVE..IGNORE
MOVE S1,RCK.IT(G) ;GET ITN FOR JOB
CAME S1,.JQITN(R) ;CHECK IF MATCH CURRENT JOB
JRST CHKE.1 ;CHECKPOINT ERROR
TLO R,RL.CKP ;SET TO CHECKPOINT THE JOB
MOVEM R,BASTBL(S) ;RESTORE R TO BASTBL
POPJ P, ;RETURN
CHKE.1: MOVEI S2,[ITEXT (<Checkpoint Message For Stream ^D/STREAM(S)/ Specified Wrong Job>)]
PUSHJ P,WTOMSG ;SEND THE MESSAGE
POPJ P, ; AND IGNORE CHECKPOINT FAILURE
SUBTTL MSGQSR - SETUP MESSAGE TO QUASAR
;THIS ROUTINE WILL GET DATA AND SETUP FOR QUASAR MESSAGE
;CALL S1/ SIZE OF AREA TO CLEAR
;
;
;RETURN S2/ MESSAGE ADDRESS
MSGQSR: MOVEI S2,MSGADR ;GET MESSAGE ADDRESS
PUSHJ P,.ZCHNK ;CLEAR THE DATA
STORE S2,SABBLK+SAB.MS ;SAVE THE MESSAGE ADDRESS
POPJ P, ;RETURN
SUBTTL SNDQSR - SEND MESSAGE TO QUASAR
SNDQSR: LOAD S1,@SABBLK+SAB.MS,MS.CNT;GET THE MESSAGE COUNT
STORE S1,SABBLK+SAB.LN ;SAVE IN SABBLK
MOVEI S1,SAB.SZ ;SIZE OF BLOCK IN S1
MOVEI S2,SABBLK ;ADDRESS OF BLOCK
$CALL C%SEND ;SEND TO QUASAR
JUMPT .POPJ ;O.K..RETURN
$STOP(SFQ,SEND FAILURE TO QUASAR)
SUBTTL SNDCHK - SETUP AND SEND STATUS MESSAGE TO QUASAR
SNDCHK:: TRNN F,FR.LFO ;CHECK IF LOG FILE OPEN
JRST SNDSTS ;AVOID CHECKPOINT
PUSHJ P,L$CHKP## ;CHECKPOINT THE LOG
JUMPF .POPJ ;ERROR..RETURN FALSE BACK TO CALLER
SNDSTS:: MOVEI S1,CHE.SZ ;SIZE OF THE MESSAGE
PUSHJ P,MSGQSR ;SETUP THE MESSAGE DATA AREA
MOVX S1,.QOCHE ;MESSAGE TYPE
STORE S1,.MSTYP(S2),MS.TYP ;SAVE TYPE IN MESSAGE
MOVE P2,S2 ;PLACE MESSAGE ADDRESS IN P2
MOVSI S1,(POINT 7,0) ;BYTE POINTER SETUP
HRRI S1,CHE.ST(P2) ;STATUS AREA IN MESSAGE
MOVEM S1,.JSPTR(R) ;SAVE IN DATA BASE
MOVX S1,<CH.FST> ;SEND STATUS
TRZE F,FR.CHK ;WANT CHECKPOINT UPDATED ON DISK
TXO S1,<CH.FCH> ;YES..UPDATE CHECKPOINT(QUASAR)
MOVEM S1,CHE.FL(P2) ;UPDATE FLAG WORD
SKIPG S1,.JJOBN(R) ;NUMBER ASSIGNED
PJRST SETM.1 ;NO..SEND MESSAGE AND EXIT
STORE S1,CHE.FL(P2),CH.JBN ;SAVE JOB NUMBER
$TEXT (STSOUT,< Job# ^D/.JJOBN(R)/^A>) ;JOB NUMBER
TLNE R,RL.OPR ;IN OPERATOR WAIT
PJRST SETM.2 ;YES..SEND MESSAGE AND EXIT
MOVE S1,.JJOBN(R) ;GET THE JOB NUMBER
MOVX S2,JI.PRG ;GET PROGRAM NAME
PUSHJ P,I%JINF ;GET JOB INFO
SKIPE S2 ;NO NAME..IGNORE THIS STATUS
$TEXT (STSOUT,< Running ^W/S2/^A>)
SKIPE S1,.JLABL(R) ;CHECK IF HAD LABEL
TLNN S1,770000 ;WAS IT A LABEL
SKIPA ;NO..IGNORE LABEL
$TEXT (STSOUT,< Last Label: ^W/S1/^A>)
MOVE S1,.JJOBN(R) ;GET JOB NUMBER
MOVX S2,JI.RTM ;GET THE RUNTIME
PUSHJ P,I%JINF ;GET THE JOB INFO
MOVE T1,S2 ;PLACE VALUE IN T1
IDIVI T1,^D1000 ;CONVERT TO SECONDS
IDIVI T1,^D3600 ;GET HOURS IN T1
IDIVI T2,^D60 ;GET MINUTES IN T2,,SEC..T3
$TEXT (STSOUT,< Runtime ^I/ITIME/^0>)
SETEND: HRRZ S1,.JSPTR(R) ;GET LAST ADDRESS
SUBI S1,-1(P2) ;COMPUTE THE LENGTH
STORE S1,.MSTYP(P2),MS.CNT ;SAVE THE MESSAGE COUNT
MOVE S1,.JQITN(R) ;THE TASK NAME
MOVEM S1,CHE.IT(P2) ;STORE
HRLI S1,.JINFO(R) ;CHECKPOINT/REQUEUE INFORMATION
HRRI S1,CHE.IN(P2) ;INTO THE MESSAGE
BLT S1,CHE.IN+<EQCKSZ-1>(P2) ;MOVE ALL THE WORDS
PJRST SNDQSR ;SEND TO QUASAR AND RETURN
STSOUT: IDPB S1,.JSPTR(R) ;SAVE BYTE IN MESSAGE
$RETT ;RETURN
SETM.1: MOVEI S1,[ASCIZ /Job Being Setup by BATCON/]
PJRST TEXSTS ;SEND STATUS TO QUASAR
SETM.2: MOVEI S1,[ASCIZ / Waiting for Operator Response/]
PJRST TEXSTS ;SEND STATUS TO QUASAR
TEXSTS: $TEXT (STSOUT,<^T/(S1)/^0>) ;PUT STATUS IN MESSAGE
PJRST SETEND ;FINISH OFF MESSAGE
SUBTTL OPERATOR ACTION MESSAGE FROM QUASAR
OPRACT: MOVEI T3,.OHDRS(G) ;GET START OF BLOCKS
LOAD S1,ARG.HD(T3),AR.TYP ;GET ARGUMENT TYPE
CAIE S1,.OROBJ ;IS IT OBJECT BLOCK
PUSHJ P,ERROR ;NO..ERROR
LOAD S1,ARG.DA+OBJ.TY(T3) ;GET OBJECT TYPE
CAIE S1,.OTBAT ;IS IT A BATCH TYPE
PUSHJ P,ERROR ;NO..ERROR
LOAD S1,ARG.DA+OBJ.UN(T3),OU.LRG ;GET THE STREAM NUMBER
PUSHJ P,FSTREA ;FIND THE STREAM
JUMPF .POPJ ;NO..IGNORE IT
MOVE S,S1 ;PLACE RELATIVE INDEX IN S
SKIPL R,BASTBL(S) ;GET BASE AC FOR STREAM
POPJ P, ;NO...IGNORE MESSAGE
SOS .OARGC(G) ;DECREMENT ARGUMENT COUNT
LOAD S2,.MSTYP(G),MS.TYP ;GET THE MESSAGE TYPE
LOAD S1,ARG.HD(T3),AR.LEN ;GET LENGTH OF OBJECT BLOCK
ADD T3,S1 ;GET ADDRESS OF NEXT ARGUMENT
MOVSI S1,-OACNUM ;NUMBER OF MESSAGES
OPRA.1: HRRZ T1,OACTAB(S1) ;GET MESSAGE TYPE
CAMN S2,T1 ;HAVE A MATCH??
JRST OPRA.2 ;YES,,,FOUND MATCH
AOBJN S1,OPRA.1 ;NO..TRY AGAIN
POPJ P, ;INVALID MESSAGE TYPE..IGNORE
OPRA.2: HLRZ T1,OACTAB(S1) ;GET ROUTINE ADDRESS
MOVE P1,OACMSG(S1) ;GET MESSAGE NAME
MOVEI T4,OACTAB(S1) ;SAVE ADDRESS OF ENTRY
MOVE R,BASTBL(S) ;SETUP R
MOVE F,.JREGS+F(R) ;AND FLAG AC
PUSHJ P,MESLST ;GET LIST AND POSITION
LOAD S2,.MSTYP(G),MS.CNT ;GET MESSAGE SIZE
ADDI S2,IPC.DA ;SIZE OF BLOCK
MOVE S1,.JMLST(R) ;LIST NUMBER FOR MESSAGE
;MEMORY OPTIMIZATION BY USING MINIMUM SIZE BLOCK
CAIGE S2,ALCSIZ-3 ;GREATER OR EQUAL TO MINIMUM SIZE
MOVEI S2,ALCSIZ-3 ;ALLOW FOR LIB OVERHEAD
$CALL L%CENT ;CREATE AN ENTRY
MOVE T2,S2 ;SAVE ADDRESS IN T2
CAIGE T4,OACCUR ;CHECK POSITION IN LIST
TLO T1,B.DEFR ;DEFER PROCESSING OF MESSAGE
;FOR PROCESS CONTEXT
CAIG T4,OACCNT ;STOP OR CONTINUE
TLO T1,B.STCN ;STOP OR CONTINUE
MOVEM T1,IPC.RT(T2) ;SAVE ROUTINE ADDR IN WORD 0
ANDI T3,777 ;GET THE OFFSET
ADDI T3,IPC.DA(T2) ;CONVERT TO PLACE IN MESSAGE
MOVEM T3,IPC.AR(T2) ;SAVE NEXT ARGUMENT ADDRESS
HRRI S1,IPC.DA(T2) ;MESSAGE LIST AREA
HRLI S1,.MSTYP(G) ;SOURCE OF MESSAGE
LOAD S2,.MSTYP(G),MS.CNT ;GET LENGTH OF MESSAGE
ADDI S2,IPC.DA(T2) ;ENDING ADDRESS OF MESSAGE
BLT S1,-1(S2) ;MOVE THE DATA
HRRM P1,IPC.TX(T2) ;SAVE MESSAGE NAME IN BLOCK
HLRM P1,IPC.CD(T2) ;SAVE THE CODE IN BLOCK
MOVEM R,BASTBL(S) ;RESTORE R WITH RL.MES SET
POPJ P, ;RETURN
;THE LINKED LIST CONTAINS THE MESSAGE PLUS A HEADER WORD
;CONTAINING FLAGS IN LEFT AND ROUTINE ADDRESS IN RIGHT HALF
;TABLE OF OPERATOR ACTION COMMANDS
;THIS TABLE HAS ENTRIES OF TWO DIFFERENT TYPES
;THOSE BEFORE OACCUR MUST BE DONE IN PROCESSES OWN CONTEXT
;WHILE OTHERS CAN BE DONE IN BATCONS WITHOUT MESSING WITH
;USER STACK OR FLAGS
OACTAB: XWD STOPJB,.OMPAU ;OPERATOR ACTION STOP
OACCNT: XWD CONTJB,.OMCON ;OPERATOR ACTION CONTINUE
XWD CANCJB,.OMCAN ;OPERATOR ACTION CANCEL
XWD REQUJB,.OMREQ ;OPERATOR ACTION REQUEUE
OACCUR: XWD EXAMIN,.OMSHC ;EXAMINE CONTROL FILE
XWD SENDJB,.OMSND ;SEND MESSAGE TO JOB
OACNUM==.-OACTAB ;COUNT OF ENTRIES
ERROR: $STOP(IMQ,INVALID MESSAGE FROM QUASAR)
;MESSAGE NAMES TO CORRESPOND WITH OACTAB
OACMSG: %STOPD,,[ASCIZ/Stopped/] ;STOP MESSAGE
%RESET,,[ASCIZ/Continued/] ;CONTINUE MESSAGE
%CNCLG,,[ASCIZ/Aborted/] ;ABORT MESSAGE
%REQUE,,[ASCIZ/Requeued/] ;REQUEUE MESSAGE
0,,[ASCIZ/Show-Control-File/] ;EXAMIN MESSAGE
0,,[ASCIZ/Send/] ;SENDJB MESSAGE
SUBTTL SETUPJ - ROUTINE TO PROCESS SETUP MESSAGE
SETUPJ: MOVE T3,SUP.TY(G) ;GET OBJECT TYPE
CAIE T3,.OTBAT ;IS IT FOR BATCH
PUSHJ P,ERROR ;NOT A BATCH JOB,,STOPCODE
LOAD S1,SUP.UN(G),RO.UNI ;GET STREAM NUMBER
MOVE S,S1 ;SAVE STREAM IN S
PUSHJ P,FSTREA ;FIND THE STREAM IN S1
JUMPT SHUTDN ;YES...CHECK IF SHUTDOWN
SETOM S1 ;-1,,IS A FREE STREAM
PUSHJ P,FSTREA ;SEE IF CAN FIND ONE
SKIPT ;YES...FOUND FREE STREAM
PJRST SETE.1 ;NO FREE STREAMS
MOVEM S,STREAM(S1) ;SAVE STREAM NUMBER IN TABLE
MOVE S,S1 ;RELATIVE INDEX IN S
MOVEI S1,.JPAGS ;NUMBER OF PAGES NEEDED FOR THE DATA BASE
$CALL M%AQNP ;GET A PAGE FOR THE DATA BASE
MOVEI R,(S1) ;PUT THE PAGE NUMBER IN R
PG2ADR R ;CONVERT PAGE TO ADDRESS
HRRZM R,BASTBL(S) ;SAVE FOR THE DISPATCHER
MOVSI S1,SUP.TY(G) ;BATCH OBJECT TYPE
HRRI S1,.JQTYP(R) ;PLACE IN DATA BASE
BLT S1,.JQNOD(R) ;MOVE THE BLOCK
MOVX T1,%RSUOK ;GOOD RETURN FOR SETUP
MOVEI T2,E.STAR ;SETUP STARTED MESSAGE
SETZM T3 ;CLEAR CODE VALUE
SETUPR: MOVEI S1,RSU.SZ ;GET THE MESSAGE SIZE
PUSHJ P,MSGQSR ;SETUP THE MESSAGE TO QUASAR
MOVEM T3,RSU.CD(S2) ;SAVE THE CODE
MOVEM T1,RSU.CO(S2) ;STORE IN MESSAGE
MOVE S1,[RSU.SZ,,.QORSU] ;GET HEADER WORD
MOVEM S1,.MSTYP(S2) ;STORE IN MESSAGE
MOVSI S1,.JQTYP(R) ;GET SOURCE TYPE FROM STREAM
HRRI S1,RSU.TY(S2) ;DESTINATION,,RESPONSE TYPE
BLT S1,RSU.NO(S2) ;MOVE TYPE,UNIT,NUMBER
CAIN T2,E.STAR ;WAS IT A START MESSAGE
JRST SETU.1 ;NO SETUP ERROR
;**;[6003]At SETUPR:+11L change 1 line JYCW Oct-18-88
$QWTO (<Setup Error>,<^I/JIBTXT/^I/@ERRTAB(T2)/>,RSU.TY(S2)) ;[6003]
PUSHJ P,SHUT.1 ;CLEAN UP STREAM
SKIPA ;SKIP OVER SETUP O.K.
;**;[6003]At SETU.1:+0L change 1 line JYCW Oct-18-88
SETU.1: $QWTO (<^I/@ERRTAB(T2)/>,,RSU.TY(S2)) ;;[6003]Use $QWTO
PJRST SNDQSR ;SEND IT TO QUASAR AND RETURN
SETE.1: MOVX T1,%RSUDE ;CAN NOT SETUP,,DO NOT TRY AGAIN
MOVEI T2,E.NSTR ;NO FREE STREAMS
SETZM T3 ;CLEAR STATUS CODE AC
PJRST SETUPR ;SEND REPLY
SETE.3: MOVX T1,%RSUNA ;NOT SETUP..TRY AGAIN
MOVEI T2,E.STRA ;STREAM ALREADY ACTIVE
SETZM T3 ;CLEAR STATUS CODE AC
PJRST SETUPR ;SEND SETUP REPLY
;SHUTDOWN MESSAGE
SHUTDN: MOVE S,S1 ;PLACE RELATIVE INDEX IN S
MOVE S2,SUP.FL(G) ;GET FLAG WORDS
TXNN S2,<SUFSHT> ;IS IT A SHUTDOWN MESSAGE
PJRST SETE.3 ;STREAM ALREAY ACTIVE..SETUP ERROR
SHUT.1: SETOM STREAM(S) ;MARK STREAM AVAILABLE
MOVE S2,BASTBL(S) ;GET BASTBL ADDRESS
SETZM BASTBL(S) ;CLEAR STREAM ENTRY
ADR2PG S2 ;CONVERT TO PAGE NUMBER
MOVEI S1,.JPAGS ;NUMBER TO RELEASE
PJRST M%RLNP ;RELEASE IT AND RETURN
;FIND A STREAM ROUTINE
;CALLED WITH S1 STREAM TO LOCATE ....-1...FREE STREAM
FSTREA: MOVSI S2,-DEFMJB ;GET MAX NUMBER OF JOBS
FSTR.1: MOVE T1,STREAM(S2) ;GET FIRST STREAM VALUE
CAMN T1,S1 ;CHECK IF MATCH
JRST FSTR.2 ;YES ,,,MATCH
AOBJN S2,FSTR.1 ;TRY NEXT ENTRY
$RETF ;CAN'T FIND ENTRY
FSTR.2: HRRZ S1,S2 ;RELATIVE STREAM INDEX
$RETT ;RETURN TRUE
SUBTTL ABORTJ - ABORT JOB BY USER REQUEST
ABORTJ: MOVE T3,ABO.TY(G) ;GET MESSAGE TYPE
CAIE T3,.OTBAT ;IS IT BATCH
PUSHJ P,ERROR ;FATAL ERROR..EXIT
LOAD S1,ABO.UN(G),RO.UNI ;GET UNIT NUMBER
PUSHJ P,FSTREA ;FIND THE STREAM
JUMPF .POPJ ;CAN'T FIND...IGNORE***
MOVE S,S1 ;PLACE RELATIVE INDEX IN S
SKIPL R,BASTBL(S) ;GET PROCESS POINTER ADDRESS
POPJ P, ;NO...IGNORE IT
MOVE S1,ABO.IT(G) ;GET ITN OF JOB
CAME S1,.JQITN(R) ;IS IT SAME JOB
POPJ P, ;NO,,IGNORE IT
PUSHJ P,MESLST ;SET UP MESSAGE LIST AND POSITION
LOAD S2,.MSTYP(G),MS.CNT ;GET SIZE OF MESSAGE
ADDI S2,IPC.DA ;ONE MORE WORD FOR FLAGS,,ADDR
MOVE S1,.JMLST(R) ;LIST ADDRESS IN S1
;MEMORY OPTIMIZATION BY USING MINIMUM SIZE BLOCK
CAIGE S2,ALCSIZ-3 ;GREATER OR EQUAL TO MINIMUM SIZE
MOVEI S2,ALCSIZ-3 ;ALLOW FOR LIB OVERHEAD
$CALL L%CENT ;CREATE AN ENTRY
MOVE T2,S2 ;PLACE ADDRESS IN T2
MOVEI S1,CANUSR ;CANCEL USER ROUTINE
MOVEM S1,IPC.RT(T2) ;STORE IN LIST
MOVSI S2,B.DEFR ;DEFER FOR PROCESS
IORM S2,IPC.RT(T2) ;PLACE IN ENTRY WORD
SETOM .MSCOD(G) ;MARK CODE AS SPECIAL
HRRI S1,IPC.DA(T2) ;MESSAGE LIST AREA
HRLI S1,.MSTYP(G) ;SOURCE OF MESSAGE
LOAD S2,.MSTYP(G),MS.CNT ;GET LENGTH OF MESSAGE
ADDI S2,IPC.DA(T2) ;ENDING ADDRESS OF MESSAGE
BLT S1,-1(S2) ;MOVE THE DATA
MOVEI S1,ABORTX ;ABORT TEXT STRING
MOVEM S1,IPC.TX(T2) ;SAVE IN MESSAGE
MOVX S1,%CNCLG ;CANCELING CODE
MOVEM S1,IPC.CD(T2) ;SAVE THE CODE
MOVEM R,BASTBL(S) ;RESTORE R
POPJ P, ;RETURN
MESLST: TLOE R,RL.MES ;IS MESSAGE LIST SETUP
JRST MESL.1 ;YES..JUST POSITION
$CALL L%CLST ;CREATE A LINKED LIST
MOVEM S1,.JMLST(R) ;SAVE LIST NUMBER
MESL.1: MOVE S1,.JMLST(R) ;GET LIST NUMBER
$CALL L%LAST ;POSITION TO THE END
AOS .JMESC(R) ;BUMP MESSAGE COUNT
POPJ P, ;RETURN
ABORTX: ASCIZ/Canusr/ ;CANCEL BY USER
SUBTTL WTORMS - RESPONSE TO WTOR MESSAGE
WTORMS: MOVE S1,.MSCOD(G) ;GET MESSAGE CODE..ITN
PUSHJ P,FNDITN ;LOCATE THE STREAM
JUMPF .POPJ ;CAN'T FIND..RETURN
TLZN R,RL.OPR!RL.DIA ;CLEAR BOTH BITS IF ON
POPJ P, ;NOT ON...EXIT
MOVEI T3,.OHDRS(G) ;START OF MESSAGE BLOCKS
LOAD S1,ARG.HD(T3),AR.TYP ;GET THE BLOCK TYPE
CAIE S1,.CMTXT ;BETTER BE TEXT
POPJ P, ;NO..IGNORE MESSAGE ***
LOAD S1,ARG.HD(T3),AR.LEN ;GET THE SIZE OF THE BLOCK
MOVE T2,S1 ;SAVE THE LENGTH
CAIGE S1,ALCSIZ ;GREATER THAN OR = TO MINIMUM SIZE
MOVEI S1,ALCSIZ ;USE MEMORY SIZE
$CALL M%GMEM ;GET SOME MEMORY
DMOVEM S1,.JOPER(R) ;SAVE S1 AND S2 IN DATA BASE
HRLZI T1,ARG.DA(T3) ;START OF THE TEXT
HRRI T1,(S2) ;DESTINATION
ADD T2,S2 ;GET LENGTH OF BLOCK
BLT T1,-1(T2) ;MOVE THE DATA
MOVEM R,BASTBL(S) ;RESTORE R
POPJ P, ;RETURN
SUBTTL FNDITN - FIND STREAM BY ITN
;THIS ROUTINE WILL LOCATE THE STREAM AND SETUP S AND R
;
;CALLED WITH S1/ ITN
;
FNDITN: MOVSI S2,-DEFMJB ;MAXIMUM NUMBER OF JOBS
FNDI.1: SKIPL R,BASTBL(S2) ;STREAM SETUP
JRST FNDI.2 ;NO..GO TO NEXT
CAMN S1,.JQITN(R) ;CHECK THE ITN
JRST FNDI.3 ;MATCH..SETUP S AND RETURN
FNDI.2: AOBJN S2,FNDI.1 ;NO..CHECK NEXT ONE
$RETF ;COULDN'T FIND..RETURN FALSE
FNDI.3: HRRZ S,S2 ;GET THE RELATIVE STREAM NUMBER
$RETT ;RETURN TRUE
SUBTTL PROMES - PROCESS ACTION MESSAGE FROM USER OR OPERATOR
PROMES: TLNE R,RL.MIP ;MESSAGE IN PROGRESS
$RETF ;YES,,GIVE FALSE RETURN
MOVE S1,.JMLST(R) ;GET LIST NAME
$CALL L%FIRS ;POSITION TO FIRST
JUMPF .POPJ ;RETURN WHEN DONE
MOVE T2,S2 ;SAVE MESSAGE ADDRESS
MOVE F,.JREGS+F(R) ;LOAD UP F
MOVE S1,IPC.RT(S2) ;CHECK IF SET
TLNE R,RL.KJB ;LOGGING IN OR OUT
$RETF ;GIVE FALSE RETURN..TO WAIT
TLNN R,RL.LGI ;WAS JOB LOGGING IN
JRST PROM.1 ;NO..PROCESS A MESSAGE
TRNN F,FR.JLI ;WAS JOB SETTING UP FOR LOGIN
$RETF ;NO..RETURN FALSE TO WAIT
PROM.1: TLNE S1,B.STCN ;STOP OR CONTINUE??
JRST PROM.4 ;YES..DO NOT CLEAR FLAGS
TLNE S1,B.DEFR ;CHECK IF DEFER FOR PROCESS
JRST PROM.3 ;SET UP FOR PROCESS
PUSHJ P,@IPC.RT(S2) ;EXECUTE THE ROUTINE
MOVEM F,.JREGS+F(R) ;RESTORE F
PROM.2: MOVE S1,.JMLST(R) ;GET LIST NAME
$CALL L%DENT ;DESTROY THE ENTRY
SOSLE .JMESC(R) ;DECREMENT COUNT
JRST PROMES ;MORE TO PROCESS
POPJ P, ;ALL DONE
PROM.3: TLZ R,RL.OPR!RL.STP!RL.JIE!RL.DIA ;CLEAR R FLAGS
TLZ F,FL.NER!FL.PLS!FL.SIL ;CLEAR F FLAGS
PROM.4: TLO R,RL.MIP!RL.MSP ;MESSAGE IN PROGRESS..PROCESS WHEN RETURN
MOVEM F,.JREGS+F(R) ;RESTORE FLAG AC
MOVEM R,BASTBL(S) ;RESTORE DATA BASE AC
MOVE S1,.JREGS+14(R) ;GET PROCESS STACK AC
PUSH S1,IPC.RT(S2) ;PLACE ROUTINE ADDR ON STACK
MOVEM S1,.JREGS+14(R) ;SAVE STACK FOR PROCESS
MOVE S1,.JMLST(R) ;GET LIST NAME
$CALL L%RENT ;REMEMBER ENTRY
SOS .JMESC(R) ;DECREMENT COUNT
$RETF ;FALSE RETURN SO WANT TRY NOW
SUBTTL SENDJB - SEND TEXT TO JOB
;CALL T2/ MESSAGE BLOCK ADDRESS
SENDJB: PUSHJ P,IDNOPR ;SETUP OPR LINE IN LOG
MOVE P1,IPC.AR(T2) ;GET LAST ARGUMENT
LOAD S1,ARG.HD(P1),AR.TYP ;GET THE ARGUMENT TYPE
CAIE S1,.CMTXT ;BETTER BE TEXT
JRST SEND.1 ;NO..SEND ERROR ACK
$TEXT (SENDJ1,<^T/ARG.DA(P1)/>) ;OUTPUT THE TEXT
;**;[6003]At SENDJB:+6L change 1 line JYCW Oct-18-88
$QACK (<Send Completed>,,<.JQOBJ(R)>,IPC.DA+.MSCOD(T2)) ;[6003]
PJRST L$BLK1## ;SEND BLANK CR,LF..NO TIME STAMP
;**;[6003]At SEND.1:+0L change 1 line JYCW Oct-18-88
SEND.1: $QACK (<Invalid Send Message>,,<.JQOBJ(R)>,IPC.DA+.MSCOD(T2)) ;[6003]
POPJ P, ;RETURN
SENDJ1: PUSHJ P,L$OUT1## ;OUTPUT THE CHARACTER
CAIE CH,CHR.LF ;HIT A LINE FEED
$RETT ;NO..RETURN
PUSHJ P,L$2TAB## ;SEND TWO TABS
MOVEI S1," " ;GET A BLANK
PUSHJ P,L$OUT1## ;DUMP IT OUT
MOVEI S1," " ;GET A BLANK
PUSHJ P,L$OUT1## ;DUMP IT OUT
$RETT ;RETURN
SUBTTL EXAMIN - SHOW CONTROL FILE TO OPERATOR
;CALL T2/ MESSAGE BLOCK ADDRESS
EXAMIN: $CALL M%GPAG ;GET A PAGE
MOVE P1,S1 ;SAVE THE PAGE ADDRESS
MOVEI S1,<PAGSIZ-^D30>*5 ;GET MESSAGE SPACE LEAVING ROOM FOR $ACK
MOVEM S1,WTOCNT ;SAVE THE COUNT
HRRI S1,(P1) ;POINT TO THE PAGE
HRLI S1,(POINT 7,) ;MAKE BYTE POINTER
MOVEM S1,WTOPTR ;SAVE THE POINTER
TRNN F,FR.CTO ;IS CTL FILE OPEN
JRST EXAME1 ;NO,,EXIT WITH ERROR
MOVE T1,IPC.AR(T2) ;GET FIRST ARGUMENT
LOAD S1,ARG.HD(T1),AR.TYP ;GET ARGUMENT TYPE
CAIE S1,.SHCLN ;CHECK IF LINES FIELD
JRST EXAME4 ;INVALID EXAMIN COMMAND
LOAD P2,ARG.DA(T1) ;GET THE VALUE
PUSHJ P,SAVPOS ;SAVE POSITION OF CTL
EXAM.1: MOVE S1,.JCJFN(R) ;GET CTL IFN
$CALL F%IBYT ;GET A BYTE
JUMPF EXAME2 ;EXIT EXAMIN ERROR
JUMPE S2,EXAM.1 ;SKIP NULLS
MOVE S1,S2 ;PLACE NUMBER IN S1
PUSHJ P,WTODAT ;OUTPUT BYTE TO MESSAGE
JUMPF EXAME3 ;ERROR ..TERMINATES MESSAGE
CAIG S2,CHR.FF ;CHECK IF GREATER THAN FF
CAIGE S2,CHR.LF ;CHECK IF LINE FEED
JRST EXAM.1 ;NO GET NEXT CHARACTER
SOJG P2,EXAM.1 ;WANT MORE...GO TO EXAM.1
EXAM.2: PUSHJ P,EXAMAC ;SEND AC AND MESSAGE TO ORION
EXAM.3: PJRST REPOSI ;REPOSITION THE CONTROL FILE
EXAME1: $TEXT (WTODAT,<Control File ^F/.JQCFD(R)/ not Open .. Show Ignored^A>)
PJRST EXAMAC ;SEND AC TO ORION
EXAME2: $TEXT (WTODAT,<^T/CRLF/ *** END OF DATA ***^A>)
JRST EXAM.2 ;FINISH OUT EXAMIN COMMAND
EXAME3: MOVEI S1,^D15*5 ;GET EXTRA ROOM
MOVEM S1,WTOCNT ;SAVE THE COUNT
$TEXT (WTODAT,< *** End of Show Data Page ***^A>)
JRST EXAM.2 ;SEND AND REPOSITION
EXAME4: $TEXT (WTODAT,<Invalid Show Control-File Command .. Command Ignored>)
JRST EXAM.2 ;FINISH OFF THE COMMAND
;**;[6003]At EXAMAC:+0L change 1 line JYCW Oct-18-88
EXAMAC: $QACK(<^T/@IPC.TX(T2)/>,<^I/JIBTXT/^T/(P1)/>,.JQOBJ(R),IPC.DA+.MSCOD(T2),<$WTJBN(.JJOBN(R))>) ;[6003]Use $QACK
MOVE S1,P1 ;GET THE PAGE
PJRST M%RPAG ;RELEASE THE PAGE AND RETURN
WTODAT: SOSG WTOCNT ;DECREMENT COUNT
$RETF ;ABORT AND RETURN
IDPB S1,WTOPTR ;DEPOSIT BYTE
$RETT ;RETURN
SUBTTL CLRSTR - CLEAN UP STREAM WHEN INACTIVE
CLRSTR: MOVE S1,[IOWD TPSIZE,TOPPDL] ;GET TOP LEVEL PDL FIRST
PUSH S1,(P) ;PLACE RETURN ADDRESS ON STACK
MOVE P,S1 ;GET NEW STACK POINTER
SOS STACTV ;DECREMENT THE STREAM COUNT
CAMN S,HIACTV ;WAS STREAM TO GO IDLE THE HIGHEST ACTIVE
PUSHJ P,FHIACT ;YES, FIND NEW HIACTV
PUSHJ P,RELREL ;RELEASE IT AND THE ASSIGNMENT
IFN FTJSYS,<
MOVE S1,.JPLSO(R) ;PTYS OUTPUT LINKED LIST
$CALL L%DLST ;DESTROY THE LIST
> ;END OF IFN FTJSYS
SKIPE S1,.JLPAG(R) ;PAGE FOR LOG FILE GONE
$CALL M%RPAG ;NO..RELEASE THE PAGE
SKIPN .JWTOF(R) ;WTO MESSAGE SETUP
JRST CLRS.1 ;NO...EVERYTHING O.K.
MOVE S1,.JWADR(R) ;GET MESSAGE PAGE ADDRESS
$CALL M%RPAG ;RELEASE THE PAGE
CLRS.1: SKIPN S1,.JOPER(R) ;ANY MESSAGES LEFT
JRST CLRS.2 ;NO..BYPASS
MOVE S2,.JOPER+1(R) ;GET MESSAGE SIZE AND ADDRESS
PUSHJ P,M%RMEM ;RELEASE THE MEMORY
CLRS.2: TLNN R,RL.MES ;MESSAGE LIST BUILT??
JRST CLRDAT ;NO,,SKIP DESTROYING LIST
CLRS.3: MOVE S1,.JMLST(R) ;GET LIST NUMBER
$CALL L%FIRS ;GET FIRST ENTRY IN QUEUE
JUMPF CLRS.4 ;DESTROY THE LIST
MOVE T2,S2 ;PUT ADDRESS IN T2
MOVEI S1,E.JLOG ;JOB LOGGED OUT
MOVEM S1,.JERRO(R) ;SAVE MESSAGE ERROR
TLO F,FL.ERR ;SEND ERROR MESSAGE
PUSHJ P,MSGOUT ;SEND THE MESSAGE
MOVE S1,.JMLST(R) ;GET LIST NAME
$CALL L%DENT ;DELETE THE ENTRY
JRST CLRS.3 ;CHECK FOR MORE
CLRS.4: MOVE S1,.JMLST(R) ;GET LIST NUMBER
$CALL L%DLST ;DESTROY THE LIST
CLRDAT: MOVE S1,.JOBST(R) ;GET THE COUNT OF JOBSTS
ADDM S1,JOBSCT ;ADD TO TOTAL FOR ALL JOBS
TLZ R,777777 ;CLEAR INITIAL SETTINGS
MOVEM R,BASTBL(S) ;UPDATE R
POPJ P, ;RETURN
SUBTTL FHIACT - FIND NEW HIACTV STREAM..INACTIVE WAS OLD HIACTV
FHIACT: PUSH P,S ;SAVE CURRENT STREAM
SKIPL BASTBL(S) ;IS THIS STREAM ACTIVE
SOJG S,.-1 ;NO, LOOK FOR ONE BELOW
MOVEM S,HIACTV ;FOUND 1 OR NONE BUT IS OK
POP P,S
POPJ P,
;SUBROUTINE TO WAKE ME UP FOR VARIOUS REASONS
IFN FTUUOS,<
WAKEME: MOVNI T1,1 ;JOB -1 IS ME
WAKE T1, ;ISSUE THE WAKE
JFCL ;REALLY CAN'T FAIL
POPJ P,
> ;END IFN FTUUOS
IFN FTJSYS,<
WAKEME: POPJ P, ;JUST RETURN
> ;END OF IFN FTJSYS
SUBTTL NEXTJB - PROCESS NEXTJOB MESSAGE
NEXTJB: MOVE T3,.EQROB+.ROBTY(G) ;GET OBJECT TYPE
CAIE T3,.OTBAT ;IS IT BATCH
PUSHJ P,ERROR ;INVALID TYPE..STOPCODE
LOAD S1,.EQROB+.ROBAT(G),RO.UNI ;GET UNIT NUMBER
PUSHJ P,FSTREA ;FIND STREAM IN S1
JUMPF ERROR ;COULD NOT FIND STREAM,,STOPCODE
MOVE S,S1 ;RELATIVE INDEX FOR STREAM
SKIPL R,BASTBL(S1) ;GET STREAM ENTRY
PJRST FIREUP ;NO..O.K.,,,FIREUP JOB AND RETURN
PJRST SETE.3 ;YES,,,ERROR
SUBTTL FIREUP - FIREUP A JOB FOR PROCESSING
;SUBROUTINE TO START UP A NEW JOB ( EXTRACT VARIABLES, SET RUNABLE)
FIREUP: MOVEI S1,.JSIZE ;GET THE SIZE OF THE DATA BASE
MOVE S2,R ;GET THE ADDRESS
MOVSI T4,.JQTYP(R) ;GET THE OBJECT BLOCK
HRRI T4,T1 ;INTO T1 - T3
BLT T4,T3 ;MOVE THE DATA
$CALL .ZCHNK ;ZERO THE DATA PAGES
MOVSI T4,T1 ;GET THE DATA
HRRI T4,.JQTYP(R) ;MOVE DATA INTO PAGE
BLT T4,.JQNOD(R) ;RESTORE THE DATA
;NOW SETUP THE INCORE DATA BASE FROM NEXTJB
;CODE FOR MOVING THE EQ
MOVE S1,.EQITN(G) ;GET THE ITN FOR THE JOB
MOVEM S1,.JQITN(R) ;PLACE IN DATA BASE
HRLI S1,.EQJBB(G) ;START OF JOB INFO BLOCK
HRRI S1,.JQJBB(R) ;END OF JOB INFO BLOCK
BLT S1,.JQJBB+JIBSIZ-1(R) ;MOVE THE BLOCK
HRLI S1,.EQLIM(G) ;GET START OF LIMIT WORDS
HRRI S1,.JQLIM(R) ;GET DESTINATION OF LIMIT WORDS
BLT S1,.JQLIM+EQLMSZ-1(R) ;MOVE THE LIMIT WORDS
GETLIM S1,.JQLIM(R),ONOD ;GET THE OUTPUT/LOCATION NODE
MOVEM S1,.JQLOC(R) ;SAVE AS THE LOCATION
HRLI S1,.EQCHK(G) ;GET ADDRESS OF CHECKPOINT WORDS
HRRI S1,.JINFO(R) ;GET DESTINATION FOR WORDS
BLT S1,.JINFO+EQCKSZ-1(R) ;SAVE THEM IN DATA BASE
HRLI S1,.EQACT(G) ;GET ADDRESS OF ACCOUNT STRING
HRRI S1,.JQACT(R) ;GET DESTINATION FOR STRING
BLT S1,.JQACT+10-1(R) ;SAVE ACCOUNT STRING
LOAD T2,.EQLEN(G),EQ.LOH ;GET LENGTH OF THE REQUEST HEADER
IFN FTJSYS,<
MOVE S1,.EQSIS(G) ;GET SPRINT SPOOL WORD
MOVEM S1,.JQSIS(R) ;SAVE WORD
HRLI S1,.EQOWN(G) ;GET USER NAME
HRRI S1,.JQNAM(R) ;DESTINATION FOR USER NAME
BLT S1,.JQNAM+10-1(R) ;MOVE THE NAME
HRLI S1,.EQCON(G) ;GET CONNECTED DIRECTORY
HRRI S1,.JQCON(R) ;DESTINATION FOR CONN. DIR
BLT S1,.JQCON+12-1(R) ;SAVE CONNECTED DIRECTORY
MOVE S1,.EQSIS(G) ;GET SPOOL INFO WORD
MOVEM S1,.JQSIS(R) ;SAVE WORD FOR SPOOLED FILES
>; END FTJSYS
IFN FTUUOS,< ;THE PATH IS OPTIONAL ON TOPS10, CHECK FOR IT
MOVE S1,.EQOID(G) ;GET PPN INFO
MOVEM S1,.JQPPN(R) ;SAVE PPN
CAIGE T2,.EQPSZ ;ENOUGH ROOM FOR THE PATH SPEC
JRST FIRE.0 ;NO, DON'T BOTHER COPYING IT
HRLI S1,.EQPAT(G) ;WHERE IT IS IF PRESENT
HRRI S1,.JQPAT(R) ;INTO INTERNAL BLOCK
BLT S1,.JQPAT+5(R) ;MOVE IT ALL
> ;END OF IFN FTUUOS
FIRE.0: ADDI T2,(G) ;FIND FILE PARAMETERS FOR THE CTL FILE
DMOVE S1,.FPINF(T2)
DMOVEM S1,.JQCFP(R) ;SAVE THE PARAMETERS AND STARTING POINT
LOAD T3,.FPLEN(T2),FP.LEN ;FIND THE FILE DESCRIPTOR
ADDI T3,(T2) ;AS MESSAGE+LENGTH OF HEADER+LENGTH OF PARMS
LOAD T4,.FDLEN(T3),FD.LEN ;SIZE OF THE DESCRIPTOR
ADDI T4,.JQCFD-1(R) ;END OF THE BLT
HRLI T1,0(T3) ;THE CTL FILE STRUCTURE
HRRI T1,.JQCFD(R) ;WHERE FNDCTL WANTS IT
BLT T1,0(T4) ;COPY ALL AND SFD'S IF THERE
LOAD T4,.FDLEN(T3),FD.LEN ;GET FD SIZE AGAIN
ADDI T3,(T4) ;C = LOG FILE PARAMETERS
MOVE S1,.FPINF(T3) ;GET INFO WORD
MOVEM S1,.JQLFP(R) ;AS THE LOG FILE MOD WORD
LOAD T4,.FPLEN(T3),FP.LEN ;SIZE OF LOG FILE PARM HEADER
ADDI T4,(T3) ;POINT TO LOG FILE DESCRIPTOR
LOAD T3,.FDLEN(T4),FD.LEN ;SIZE OF LOG FILE FD
ADDI T3,.JQLFD-1(R) ;LAST LOCATION TO MOVE TO
HRLI T1,0(T4) ;THE LOG FILE NOW
HRRI T1,.JQLFD(R) ;WHERE THE ROUTINES WANT IT
BLT T1,0(T3) ;MOVE THE FULL SPEC
HRLI S1,.EQCHK(G) ;CHECKPOINT/REQUEUE INFORMATION
HRRI S1,.JINFO(R) ;KEEP IT IN THE JOB DATA BASE
BLT S1,.JINFO+<EQCKSZ-1>(R) ;GET ALL THE WORDS
HRLI R,RL.INI ;SET THIS STREAM IS NOW ACTIVE
MOVEM R,BASTBL(S) ;STORE NEW SETTING
MOVE F,[FL.INI,,FR.INI] ;INITIALIZE THE OTHER FLAG REG
MOVEM F,.JREGS+F(R) ;STORE NEW SETTINGS
SETOM .JJOBN(R) ;INIT THE JOB NUMBER FIELD
;IN CASE CAN NOT LOG IN
SUBTTL TOPS10 PTY STARTUP CODE
IFN FTUUOS,<
FIRE.1: MOVE S1,S ;USE THE RELATIVE STREAM NUMBER FOR THE CHANNEL
LSH S1,^D23 ;SHIFT TO CHANNEL FIELD
MOVEM S1,.JPCHN(R) ;SAVE CHANNEL NUMBER
MOVSI T1,(1B0!1B2) ;WANT ASCII MODE ON A REAL PTY
MOVSI T2,'PTY' ;GET GENERIC PTY
HRLI T3,.JPOUT(R) ;XWD OUTPUT,INPUT
HRRI T3,.JPINP(R)
MOVE S1,[OPEN 0,T1] ;OPEN THE PTY
IOR S1,.JPCHN(R) ;PUT IN CHANNEL NUMBER
XCT S1 ;EXECUTE THE OPEN
JRST FIRE.N ;OPEN FAILURE,,RELEASE PTY,,EXIT
MOVSI T1,400000 ;NOT IN USE BIT
HRRI T1,.JPTYO+1(R) ;FIRST IN RING
MOVEM T1,.JPOUT(R) ;SET FOR BUFFERED OUTPUT
HRRI T1,.JPTYI+1(R) ;SAVE FOR INPUT SIDE
MOVEM T1,.JPINP(R)
MOVSI T1,(POINT 7,0) ;BYTE SIZES
MOVEM T1,.JPINP+1(R)
HRRI T1,.JPTYO+3(R) ;COUNTS ARE ZERO FROM ABOVE BLT
MOVEM T1,.JPOUT+1(R) ;FOR INPUT AND OUTPUT
MOVSI T1,PTYBLK-2 ;PLACE SIZE-2 IN THE LEFT HALF
IFE <PTYBFR-1>,< ;ONLY 1 BUFFER EACH WAY
HRRI T1,.JPTYO+1(R) ;RING LOOPS ON ITSELF
MOVEM T1,.JPTYO+1(R)
HRRI T1,.JPTYI+1(R) ;SAME FOR INPUT
MOVEM T1,.JPTYI+1(R)
>
IFG <PTYBFR-1>,< ;MULTIPLE BUFFERS
MOVEI T2,PTYBFR-1 ;LOOP COUNT
HRRI T1,.JPTYO+1+PTYBLK(R) ;POINT TO SECOND BUFFER
JRST .+2 ;SKIP FOR THE FIRST BUFFER
HRRI T1,PTYBLK(T1) ;POINT TO NEXT BUFFER
MOVEM T1,-PTYBLK(T1) ;STORE ADDR INTO PREVIOUS BUFFER
SOJG T2,.-2 ;DO FOR ALL BUFFERS
HRRI T1,.JPTYO+1(R) ;POINT BACK TO FIRST
MOVEM T1,.JPTYO+1+<<PTYBFR-1>*PTYBLK>(R) ;LAST LINKS TO FIRST
MOVEI T2,PTYBFR-1 ;NOW DO THE SAME FOR INPUT SIDE
HRRI T1,.JPTYI+1+PTYBLK(R) ;AGAIN POINT TO SECOND BUFFER
JRST .+2 ;SKIP FOR THE FIRST BUFFER
HRRI T1,PTYBLK(T1) ;BUMP TO NEXT
MOVEM T1,-PTYBLK(T1) ;STORE ADDRESS OF THIS IN PREVIOUS
SOJG T2,.-2 ;REPEAT PROCESS FOR ALL BUFFERS
HRRI T1,.JPTYI+1(R) ;FIRST BUFFER
MOVEM T1,.JPTYI+1+<<PTYBFR-1>*PTYBLK>(R) ;LINK LAST TO FIRST
>
> ;END IFN FTUUOS
SUBTTL TOPS20 PTY SETUP CODE
IFN FTJSYS,<
FIRE.1: MOVN T2,NUMPTY ;GET # OF PTYS IN SYSTEM
HRLZS T2
FIRE.2: MOVSI S1,.DVDES+.DVPTY ;GET PTY DESIGNATOR
HRRI S1,(T2) ;TRY TO GET NEXT PTY
DVCHR ;GET CHARACTERISTICS OF THIS PTY
TXNN S2,DV%AV ;IS IT AVAILABLE?
JRST FIRE.4 ;NO,TRY NEXT PTY
;**;[4306]Add 2 lines at FIRE.2:+4L JCR 2/13/87
HLRES T1 ;[4306]Pick up the job number
AOJN T1,FIRE.4 ;[4306]-1 means this PTY is unassigned
MOVE S2,S1 ;SET UP FOR DEVST
HRROI S1,DEVNAM ;TURN IT INTO AN ASCII STRING
DEVST ;GET STRING FOR DEVICE
JRST FIRE.4 ;ERROR TRY NEXT ONE
MOVEI S2,":" ;TERMINATED BY A COLON
IDPB S2,S1 ;PUT COLON ON STRING
MOVEI S2,0 ;PLACE NULL ON END
IDPB S2,S1 ;ENDED WITH A 0 BYTE
MOVX S1,GJ%SHT ;SHORT FORM OF JFN
LOAD S2,IPBBLK+IB.FLG,IB.NAC ;Get the access bit value
SKIPE DEBUGW ;Debugging?
SETZ S2, ;Yes, do not restrict
STORE S2,S1,GJ%ACC ;Store as value of JFN access
HRROI S2,DEVNAM ;NAME FOR OPEN
GTJFN
JRST FIRE.4 ;NOT AVAILABLE
MOVE S2,[7B5+OF%RD+OF%WR] ;NOW TRY TO OPEN IT
MOVEM S1,.JPCHN(R) ;PTY CHANNEL NUMBER
OPENF
ERJMP FIRE.3 ;CANNOT OPEN IT, TRY ANOTHER
ADD T2,FIRPTY ;TURN PTY UNIT # INTO TTY #
TRO T2,400000 ;MAKE IT A TTY DESIGNATOR
HRRZM T2,.JPTTY(R) ;STORE TTY DESIGNATOR
PUSHJ P,SETPTY ;SET HALF DUPLEX ON PTY
MOVE S1,.JPCHN(R) ;JFN FOR PTY
HRL S2,STRCHN(S) ;GET THE PTY CHANNEL
TXO S2,<MO%WFI+MO%OIR> ;WAIT FOR INPUT, OUTPUT READY
HRRI S2,.MOAPI ;ATTACH TO INTERRUPT SYSTEM
MTOPR ;JSYS TO ATTACH PTY
ERJMP FIRE.N ;ERROR EXIT
MOVEI S2,.MOBAT ;SET BATCH FUNCTION
MOVEI T1,.MOJCB ;A = S2 + 1 , SET THE BATCH PTY BIT
MTOPR ;AFFECTS JOBS LOGGING IN ON THIS PTY
JRST FIRE.5 ;GOT A PTY
FIRE.3: MOVE S1,.JPCHN(R) ;JFN FOR PTY
RLJFN ;RELEASE THE JFN
JFCL ;GET NEXT
FIRE.4: AOBJN T2,FIRE.2 ;TRY NEXT PTY
JRST FIRE.E ;ERROR..EXIT..CAN'T GET PTY
SUBTTL SET HALF DUPLEX FOR PTY
SETPTY: MOVEI S1,101 ;REFER TO THE TERMINAL WE'RE ON.
GTTYP ;ASK THE SYSTEM WHAT TYPE WE ARE.
MOVE S1,.JPTTY(R) ;REFERENCE THE PTY.
STTYP ;SET THE PTY TYPE TO THE SAME AS OURSELF.
HLFDUP: MOVE S1,.JPTTY(R) ;GET THE JFN FOR PTY
RFMOD ;READ THE CURRENT SETTINGS
IORI S2,FLD(.TTLDX,TT%DUM) ;LINE HALF DUPLEX
TXO S2,TT%TAB ;HARDWARE TABS
TXO S2,TT%ECM ;IMMEDIATE ECHO MODE
TXZ S2,TT%ECO!TT%LIC ;TURN ECHOING OFF AND LOWER CASE ON
TXZ S2,TT%WID ;PAGE WIDTH INFINITE
SFMOD ;SET IT UP...
STPAR ;AND DO IT...
POPJ P, ;YES...RETURN
FIRE.5: $CALL L%CLST ;CREATE LIST FOR PTY OUT
MOVEM S1,.JPLSO(R) ;SAVE LIST NAME
MOVEI S1,PTYBLK*PTYBFR*5 ;PTY BUFFER SIZE
MOVEM S1,.JPOUT+2(R) ;SAVE COUNT FOR OUTPUT TO PTY
MOVE S1,[POINT 7,.JPTYO(R)] ;BUFFER BYTE POINTER
MOVEM S1,.JPOUT+1(R) ;SAVE BUFFER POINTER
> ;END OF IFN FTJSYS
CAMLE S,HIACTV ;IS THIS NOW THE HIGHEST ACTIVE STREAM
MOVEM S,HIACTV ;YES, SET NEW VALUE
HRLI T1,-.JPSIZ ;BUILD PDL FOR THE STREAM
HRRI T1,.JPLST-1(R)
PUSH T1,[NEWJOB] ;START STREAM AT 'NEWJOB'
MOVEM T1,.JREGS+14(R) ;SAVE AS PROCESSOR REGISTER P (17)
AOS STACTV ;ADD ANOTHER JOB
POPJ P, ;RETURN TO DISPATCHER
; HERE WHEN WE CANNOT GET A PTY FOR A JOB, GIVE IT BACK TO QUASAR
;AT FIRE.N IF ALREADY ACQUIRED A PTY CHANNEL BUT NO THE PTY ITSELF
; FIRE.E IF COULDN'T GET A PTY CHANNEL (A BUG IN THE CHANNEL ALLOCATOR)
FIRE.N: PUSHJ P,RELREL ;RELEASE THE PTY ASSIGNMENT
FIRE.E: PUSHJ P,CLRDAT ;CLEAN UP DATA FROM STREAM
MOVX T1,%RSUNA ;NOT AVAILABLE,,TRY AGAIN SOON
MOVEI T2,E.NPTY ;NO PTYS AVAILABLE
MOVX T3,%NPTYS ;NO PTYS AVAILABLE CODE
PJRST SETUPR ;SEND SETUPR ..WITH NEGATIVE ACK
;WHICH WILL FORCE JOB REQ BY QSR.
SUBTTL Job Processor - Start the Stream
;ENTRY AT NEWJOB FOR FRESH START. HEADERS,LOGIN,SET COMMANDS...
NEWJOB: $WTOJ (<Begin>,<^R/.JQJBB(R)/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>)
PUSHJ P,L$INIT## ;INITIALIZE LOG FILE DATA
$TEXT (L$OUT1,< ^H/[-1]/
BATCON Version ^V/[BTNVRS]/ GLXLIB Version ^V/LIBVER/>)
$TEXT (L$OUT1,<
^R/.JQJBB(R)/ in Stream ^D/STREAM(S)/
>)
GETLIM S2,.JQLIM(R),UNIQ ;GET UNIQUE VALUE
MOVEI P1,[ASCIZ/No/] ;ASSUME NO
CAIE S2,%EQUNO ;IS IT UNIQUE
MOVEI P1,[ASCIZ/Yes/] ;YES, SAY SO
MOVEI P2,[ASCIZ/No/] ;ASSUME NOT RESTARTABLE
GETLIM S2,.JQLIM(R),REST ;GET RESTART FIELD
SKIPN S1,.JCHRQ(R) ;ANY CHECKPOINT INFO
SKIPA ;NO..CHECK VALUE NOW
TXNN S1,<BA.ORQ!BA.URQ!BA.CHK> ;WAS IT REQ OR CHKPNT
CAIE S2,%EQRNO ;CHECK IF RESTARTABLE
MOVEI P2,[ASCIZ/Yes/] ;RESTARTABLE.. SAY YES
MOVEI T4,[ASCIZ/Log/] ;DEFAULT TO LOG
GETLIM S1,.JQLIM(R),OUTP ;GET OUPUT VALUE
CAIN S1,%EQOLE ;/OUT:ERROR
MOVEI T4,[ASCIZ/Error/] ;YES
CAIN S1,%EQONL ;/OUT:Nolog
MOVEI T4,[ASCIZ/Nolog/] ;YES
HRRZ T1,.JQLIM+1(R) ;GET TIME FIELD
IDIVI T1,^D3600 ;CONVERT TO HOURS IN T1
IDIVI T2,^D60 ;CONVERT TO MINUTES IN T2
GETLIM S1,.JQLIM(R),BLOG ;GET LOG OPTIONS FOR WRITING
MOVEI S2,[ASCIZ/Append/] ;DEFAULT IS APPEND
CAIN S1,%BAPND ;APPEND..
JRST NEWJ.1 ;YES
CAIN S1,%BSCDE ;SUPERSEDE
MOVEI S2,[ASCIZ/Supersede/] ;SET TO SUPERSEDE
CAIN S1,%BSPOL ;OR CREATE IN SPOOL AREA
MOVEI S2,[ASCIZ/Spool /] ;SET SPOOL
NEWJ.1: GETLIM S1,.JQLIM(R),OINT ;OPERATOR INTERVENTION FIELD
MOVEI P4,[ASCIZ/Yes/] ;ALLOWED..DEFAULT
CAIE S1,.OPINY ;YES
MOVEI P4,[ASCIZ/No/] ;NOT ALLOWED
$TEXT (L$OUT1,< OUTPUT: ^T/(T4)/^T/TABS/TIME-LIMIT: ^I/ITIME/
UNIQUE: ^T/(P1)/^T/TABS/BATCH-LOG: ^T/(S2)/>)
$TEXT (L$OUT1,< RESTART: ^T/(P2)/^T/TABS/ASSISTANCE: ^T/(P4)/
ACCOUNT: ^T31L/.JQACT(R)/SEQUENCE: ^D/.JQJBB+JIB.SQ(R),JB.SEQ/>)
SKIPE CORCHK ;WANT CORE CHECKING
$TEXT (L$OUT1,< CORE:^D/.JQLIM+1(R),LHMASK/P>)
$TEXT (L$OUT1,<
Input from =^7/[76]/ ^F/.JQCFD(R)/
Output to =^7/[76]/ ^F/.JQLFD(R)/
>)
PUSHJ P,LOGINJ ;LOGIN THE JOB
PUSHJ P,LOGSET ;SETUP JOB AFTER LOGIN
PJRST JOBSTA ;START JOB PROCESSING
TABS: ASCIZ/ / ;4 TABS
SUBTTL LOGINJ - LOGIN A JOB ON PTY
IFN FTUUOS,<
LOGINJ: PUSHJ P,SNDUPC ;SEND A ^C
PUSHJ P,IODISP ;WAIT FOR I/O, RETURN FOR MORE INPUT
SKIPE .JRTIM(R) ;TIMESTAMP NEEDED?
PUSHJ P,L$LPER## ;OUTPUT MONITOR PROMPT
$TEXT (LOGPTY,<LOGIN ^O/.JQPPN(R),LHMASK//^O/.JQPPN(R),RHMASK/^A>)
MOVEI T4,.JQPAT(R) ;GET THE LOGIN PATH
SKIPN .JQPAT(R) ;ANY PPN IN THE PATH SPEC
JRST LOGI.3 ;NO, AVOID SENDING BAD DATA
PUSHJ P,SETSFD ;SET AS IF AN SFD SPEC
TLNE T4,-1 ;IS D A PPN
JRST [CAMN T4,.JQPPN(R) ;YES, ARE THE PPNS THE SAME
JRST LOGI.3 ;YES, SKIP THIS OUTPUT
MOVEI T4,SFDPAT-3 ;INSURE FINDING A ZERO
JRST .+1] ;RESUME IN-LINE CODE
MOVEM T4,.JLABL(R) ;SAVE THE POINTER FOR NOW
MOVEI S1,"[" ;[ FOR START OF PPN PATH BLOCK
PUSHJ P,LOGPTY ;OUTPUT THE CHARACTER
MOVE S1,.JQPAT(R) ;GET PATH PPN
CAMN S1,.JQPPN(R) ;SAME AS LOGGED IN PPN
JRST [MOVEI S1,CHR.CA ;SEND A COMMA
PUSHJ P,LOGPTY ;SEND TO PTY AND LOG
JRST LOGI.1] ;GO STRAIGHT TO PATH SPEC
$TEXT (LOGPTY,<^O/.JQPAT(R),LHMASK/,^O/.JQPAT(R),RHMASK/^A>)
LOGI.1: AOS S1,.JLABL(R) ;BUMP TO NEXT SFD LEVEL
SKIPN S1,2(S1) ;IS THERE ANOTHER
JRST LOGI.2 ;NO, END OF THE SPEC
$TEXT (LOGPTY,<,^W/S1/^A>) ;SEND SFD PATH
JRST LOGI.1 ;CONTINUE FOR ALL LEVELS
LOGI.2: MOVEI S1,"]" ;END PATH BLOCK
PUSHJ P,LOGPTY ;OUPUT THE CHARACTER
LOGI.3: $TEXT (LOGPTY,< /DEFER/SPOOL:ALL/TIME:^D/.JQLIM+1(R),RHMASK//ACCOUNT:^T/.JQACT(R)//BATNAM:^W/.JQJBB+JIB.JN(R)//BATSEQ:^D/.JQJBB+JIB.SQ(R),JB.SEQ//REQID:^D/.JQJBB+JIB.ID(R)/^A>)
SKIPE CORCHK ;WANT CORE CHECKING?
$TEXT (LOGPTY,</CORE:^D/.JQLIM+1(R),LHMASK/P^A>)
MOVX S1,<B.REMT> ;HAVE REMOTE STATION LOGIC
TDNN S1,FLAGS ;CHECK AGAINST GLOBAL FLAG WORD
JRST LOGI.4 ;END THE LINE
$TEXT (LOGPTY,</LOCATE:^O/.JQLOC(R)/^A>)
LOGI.4: $TEXT (LOGPTY,</NAME:"^A>)
$TEXT (PTYSCN,<^W6/.JQJBB+JIB.NM(R)/^W/.JQJBB+JIB.NM+1(R)/^A>)
MOVEI S1,CHR.QT ;SEND QUOTE
PUSHJ P,LOGPTY ;OUTPUT CHARACTER
POPJ P, ;RETURN
> ;END OF IFN FTUUOS
IFN FTJSYS,<
LOGINJ: SETOM .JREOL(R) ;FAKE OUT IN CASE OF PROBLEMS
TRO F,FR.JLI ;SET START OF JOB LOGGING IN
MOVE S1,.JPTTY(R) ;GET PTY NUMBER
ASND ;ASSIGN HIM
ERJMP ANLY.4 ; CAN'T? THEN GO FIND OUT WHY
MOVX S1,CJ%LOG!CJ%NAM!FLD(.CJUAA,CJ%ACT)!CJ%ETF!CJ%NPW ;FLAGS
MOVX S2,CRJBLK ;ADDRESS OF CRJOB ARG BLK
MOVE T1,[POINT 7,.JQNAM(R)] ;GET POINTER TO USER NAME STRING
MOVEM T1,.CJNAM(S2) ;PUT IN ARGUMENT BLOCK
MOVE T1,[POINT 7,.JQACT(R)] ;GET POINTER TO ACCOUNT STRING
MOVEM T1,.CJACT(S2) ;PUT IN ARGUMENT BLOCK
SETZM .CJSFV(S2) ;START JOB AT MAIN ENTRY POINT
MOVE T1,.JPTTY(R) ;GET TERMINAL NO. OF JOB
MOVEM T1,.CJTTY(S2) ;PUT THIS IN ARGUMENT BLOCK
MOVX T1,1B4 ;FLAG TO OUTPUT TEXT AT LOGIN
MOVEM T1,.CJEXF(S2) ;AND STORE THIS FLAG
MOVE T1,.JQLIM+1(R) ;GET THIS JOBS RUNTIME LIMIT
IMULI T1,^D1000 ;MAKE MILLISECONDS
MOVEM T1,.CJCPU(S2) ;AND SAVE THIS IN ARG. BLOCK
CRJOB ;TIME TO MAKE THIS JOB
ERJMP [CAIE S1,CRJBX6 ;FAIL...INSUFFICIENT SYS RES?
PJRST ANLY.3 ;NO, SO REALLY KILL THE JOB
AOS S1,.JLOGI(R) ;YES, BUMP LOGIN TRIES
CAILE S1,FULLCT ;ARE WE PAST FULL COUNT?
PJRST ANLY.4 ;YES..REQUEUE THE JOB
TLZ R,RL.JIE ;CLEAR JOB IN ERROR
PUSHJ P,QTS ;STALL AND TRY AGAIN
JRST LOGINJ ] ;NO..TRY AGAIN
POPJ P, ;RETURN
> ;END OF IFN FTJSYS
SUBTTL LOGSET - SETUP JOB AFTER LOGIN
IFN FTUUOS,<
LOGSET: PUSHJ P,SNDCLF ;FORCE OUT CR ,LF AND BUFFER
PUSHJ P,IODISP ;WAIT FOR OUTPUT
TLNE J,JL.ULI ;IS USER LOGGED IN
TLNE R,RL.JIE ;DID LOGIN FAIL
PUSHJ P,ANALYZ ;YES, ANALYZE THE LOGIN ERROR
TRNE F,FR.LFO ;IS LOG FILE OPEN
JRST LOGS.1 ;BYPASS LOG OUTPUT
PUSHJ P,L$OUTP## ;DUMP THE DATA
JUMPF LOGEXT ;ERROR.. FINISH OFF THE JOB
LOGS.1: MOVE S1,[2,,S2] ;SETUP FOR JBSET.
HRRZ S2,J ;GET JOB NUMBER
HRLI T1,.STBSN ;FUNCTION TO SET BATCH STREAM
HRR T1,.JQSTR(R) ;SAVE THE STREAM NUMBER
JBSET. S1, ;DO THE JBSET.
JFCL ;IGNORE THE ERROR
GETLIM T1,.JQLIM(R),OINT ;GET OPERATOR INTERVENTION FLAG
CAIE T1,.OPINN ;NO INTERVENTION ALLOWED?
POPJ P, ;NO..JUST RETURN
TLO F,FL.NOP ;SET NO OPERATOR INTERVENTION FLAG
MOVE S1,[2,,S2] ;SETUP FOR JBSET.
HRRZ S2,J ;GET JOB NUMBER
HRLI T1,.STWTO ;SET WTO FIELDS
HRRI T1,.OBNWR ;NO WTOR ALLOWED
JBSET. S1, ;DO THE FUNCTION
JFCL ;***IGNORE ERRORS
POPJ P, ;RETURN
>;END FTUUOS
IFN FTJSYS,<
LOGSET: PUSHJ P,WAITOU ;WAIT FOR I/O
TLNE J,JL.ULI ;USER LOGGED IN
TLNE R,RL.JIE ;DID LOGIN FAIL
PJRST ANLY3A ;YES, KILL OFF THE JOB
TRNE F,FR.LFO ;IS LOG FILE OPEN
JRST LOGS.1 ;BYPASS LOG OUTPUT
PUSHJ P,L$OUTP## ;DUMP THE DATA
JUMPF LOGEXT ;ERROR.. FINISH OFF THE JOB
LOGS.1: PUSHJ P,HLFDUP ;INSURE LINE STILL HALF DUPLEX
HRLI S1,2 ;LENGTH OF 2
HRRI S1,.MSIMC ;INCREMENT MOUNT COUNT
MOVEI S2,T1 ;GET ADDRESS OF ARGUMENT BLOCK
HRROI T1,.JQCON(R) ;CONNECTED DIRECTORY
MOVE T2,.JJOBN(R) ;GET THE JOB NUMBER
MSTR ;DO THE MSTR
ERJMP LOGS.2 ;IGNORE FOR NOW
LOGS.2: MOVX S1,AC%CON+3 ;FLAGS,,LENGTH IN 1
MOVEI S2,T1 ;ADR IN 2
HRROI T1,.JQCON(R) ;ADR POINTS TO STR-DIR STRING
HRROI T2,[ASCIZ / /] ;ADR+1 POINTS TO PSW (DUMMY)
HRRZ T3,.JJOBN(R) ;ADR+2 POINTS TO JOB NUMBER
ACCES ;CONNECT THE JOB
ERJMP LOGS.3 ;DON'T WAIT IF IT FAILED
PUSHJ P,IOWAIT ;GET RESPONSE FROM ACCES JSYS
LOGS.3: HRRZ S1,.JJOBN(R) ;GET THE JOB NUMBER
MOVEI S2,.SJDFS ;SET DEFAULT SPOOLING
MOVEI T1,.SJSPD ;A = S2 + 1, SET DEFERRED
SETJB ;SET IT FOR THE JOB
ERJMP .+1 ;IGNORE THE ERROR..
HRRZ S1,.JJOBN(R) ;GET THE JOB NUMBER
MOVEI S2,.SJBAT ;SET BATCH INFO
SETZM T1 ;CLEAR DATA WORD
MOVE T2,.JQSTR(R) ;GET STREAM NUMBER
STORE T2,T1,OB%BSN ;SAVE BATCH STREAM NUMBER IN WORD
TXO T1,OB%BSS ;SET THE STREAM SET FLAG
GETLIM T2,.JQLIM(R),OINT ;GET OPERATOR INTERVENTION FLAG
CAIE T2,.OPINN ;NO INTERVENTION ALLOWED?
JRST LOGS.4 ;DO THE FUNCTION
TLO F,FL.NOP ;SET NO OPERATOR INTERVENTION FLAG
MOVX T2,.OBNWR ;NO INTERVENTION ALLOWED
STORE T2,T1,OB%WTO ;SAVE THE DATA
LOGS.4: SETJB ;DO THE FUNCTION
;**;[4302]At LOGS.4:+1L replace 2 lines with 13 lines JYCW 7-Mar-86
ERJMP .+1 ;[4302]Ignore error
MOVEI S2,.SJBSN ;[4302]Set BATCH sequence # function
LOAD T1,.JQJBB+JIB.SQ(R),JB.SEQ ;[4302]Get the sequence number
SETJB ;[4302]Do the function
ERJMP .+1 ;[4302]Ignore error
MOVEI S2,.SJBJN ;[4302]Set Batch Job name function
MOVE T1,.JQJBB+JIB.JN(R) ;[4302]Get the job name
SETJB ;[4302]Do the function
ERJMP .+1 ;[4302]Ignore error
MOVEI S2,.SJBID ;[4302]Set request ID
HRRZ T1,.JQJBB+JIB.ID(R) ;[4302]Get the request ID
SETJB ;[4302]Do the function
ERJMP .POPJ ;[4302]Ignore error return
POPJ P, ;RETURN
>;END FTJSYS
;ROUTINE TO FINISH OFF A JOB
LOGEXT: PUSHJ P,ATOKJB ;LOG THE JOB OUT
PJRST CLOS.1 ;CLOSE IT OUT
SUBTTL JOBSTA - JOB STARTUP AFTER LOGIN COMPLETED
JOBSTA: AOS S1,JOBTOT ;INCREMENT BATCON JOB TOTALS
MOVEM S1,.JOBCT(R) ;JOB COUNT FOR JOB
TLZ R,RL.LGI ;CLEAR LOGIN SEQUENCE NOW
SKIPN S1,.JCHRQ(R) ;IS THERE CHECKPOINT/REQUEUE INFO
JRST NORM.2 ;FIRST TIME..CHECK IF RESTARTABLE
TXNN S1,<BA.JOB> ;BETTER BE SET
$STOP (URJ,UNRECOGNIZED RESTART JOB)
TXNE S1,<BA.ORQ!BA.URQ!BA.CHK>;ANY REQ OR CHKPNT
JRST CKPNTS ;YES,,CHECK FOR CHECKPOINT RESTART
GETLIM S2,.JQLIM(R),REST ;GET RESTART DATA
CAIE S2,%EQRNO ;IS IT RESTARTABLE
JRST CKPNTS ;TREAT IT AS RESTARTABLE
;USER MODIFIED AFTER CRASH BUT BEFORE RESTART
MOVEI T1,[ASCIZ/BTNJNR Job Canceled after a Restart, It is not Restartable/]
NORM.1: PUSHJ P,L$CMNT## ;SET UP FOR COMMENT
$TEXT (L$OUT1,<? ^T/(T1)/>) ;OUTPUT MESSAGE TO LOG
;**;[4303]At NORM.1:+2L replace 2 lines with 6 lines JCR 6/11/86
TRO F,FR.FIN!FR.RER ;[4303]Bypass %FIN::, search for %RERR
TRZ F,FR.LSL ;[4303]Don't list skipped lines
MOVE S1,[SIXBIT/%RERR/] ;[4303]Look for %RERR
MOVEM S1,.JLABL(R) ;[4303]Place in the data base
SETOM .JCRER(R) ;[4303]First search for %RERR
JRST LABSRC ;[4303]Do the search
NORM.2: MOVX S1,<BA.JOB> ;GET SEEN JOB FLAG
IORM S1,.JCHRQ(R) ;UPDATE FLAG WORD
GETLIM S2,.JQLIM(R),REST ;GET RESTART DATA
CAIE S2,%EQRNO ;IS IT RESTARTABLE
JRST CKPNTS ;YES, GO GET STARTING POINT
TRO F,FR.CHK ;UPDATE CHECKPOINT..JOB SCHEDULED
CKPNTS: SKIPN S1,.JCHRQ+1(R) ;GET WHERE TO START PARAMETER
MOVE S1,.JQCFP+1(R) ;GET /TAG OR /START VALUE (NO CHKPNT)
TLNN S1,777777 ;IS IT A RESTART LABEL
JRST CKLINE ;NO, TRY A LINE NUMBER
MOVEM S1,.JLABL(R) ;SAVE FOR LABFND
PUSHJ P,L$CMNT## ;PREPARE FOR A COMMENT
$TEXT (L$OUT1,<BTNBLA Beginning Processing at Label ^W/.JLABL(R)/>)
TRO F,FR.FIN ;THIS SEARCH MAY SKIP A %FIN::
PUSHJ P,SNDSTS ;SEND THE UPDATED STATUS TO QUASAR
JRST LABSRC ;SEARCH FOR THE LABEL
CKLINE: CAIG S1,1 ;IS STARTING LINE .G.1
JRST CKLI.2 ;START JOB NOW
MOVEM S1,.JLABL(R) ;SAVE THE COUNT OF LINES
PUSHJ P,L$CMNT## ;PREPARE FOR A COMMENT
$TEXT (L$OUT1,<BTNBLI Beginning Processing on Line ^D/.JLABL(R)/>)
CKLI.1: SOSG .JLABL(R) ;PASSED OVER ENOUGH YET
JRST CKLI.2 ;START JOB NOW
PUSHJ P,GETCTL ;GET A CHARACTER
PUSHJ P,CMNT.3 ;USE THE SILENCED COPY COMMENT
JRST CKLI.1 ;SKIP OVER JUST ENOUGH
CKLI.2: PUSHJ P,SNDCHK ;UPDATE THE DISK AND QUASAR
JUMPT HONO.0 ;O.K. START THE JOB
PJRST CLOSJB ;ABORT THE JOB
SUBTTL Job Processor - Honor Job's Input Request
HONORJ: PUSHJ P,IODISP
SKIPA ;HAVE STATUS ALREADY
HONO.0: PUSHJ P,GJBSTS ;GET STATUS NOW
TLNN J,JL.UJA ;IS THERE A JOB STILL THERE
JRST [PUSHJ P,L$OUTP## ;OUTPUT THE LOG
TLO R,RL.NLG ;SUPPRESS PRINTING OF THE LOG FILE
JRST CLOS.1] ;SO JUST DISMISS THIS JOB
TLNE F,FL.TLE ;DID THIS JOB EXCEED ITS TIME LIMIT
JRST TIMERR ;YES, CANCEL OR GIVE EXTRA TIME
TLNE R,RL.DIA ;DOES JOB WANT DIALOGUE MODE INPUT
JRST REDOPR ;YES, READ NEXT LINE FROM THE OPERATOR
HONO.1: TLZ F,FL.LAB ;CLEAR A LABEL FOUND FLAG
TLO R,RL.FCI ;LOOKING FOR THE FIRST CHARACTER
PUSHJ P,GETCTL ;GET THE FIRST CHARACTER OF THIS LINE
HONO.2: TLZ R,RL.FCI ;CLEAR FLAGS
SETZM .JREOL(R) ;CLEAR END OF LINE SENT
PUSHJ P,CLASSF ;CLASSIFY THE CHARACTER WE HAVE
JRST CNTLLI ;LINE TERMINATORS ARE ALSO SPEC. ACTION
JRST CNTLLI ;SPECIAL ACTION CHARACTER
JRST CPYLOP ;LINE STARTS WITH A NUMBER, IS USER DATA
PUSHJ P,DECRBP ;A LETTER, CHECK FOR A LABEL
PUSHJ P,SAVPOS ;SAVE CURRENT CTL FILE POSITION
PUSHJ P,GETSIX ;GET THE POSSIBLE LABEL
TLON F,FL.LAB ;ALREADY FIND 1 LABEL ON THIS LINE
CAIE CH,":" ;DID IT END WITH A COLON
JRST NOTLAB ;NO, CANNOT BE A LABEL
PUSH P,S1 ;SAVE S1 SINCE GETCTL WILL MODIFY IT
PUSHJ P,GETCTL ;GET THE NEXT CHARACTER
POP P,S1 ;RESTORE LABEL IN S1
CAIE CH,":" ;IS IT LABEL::
JRST NOTLAB ;NO, THAT IS THE ONLY KIND WE CAN 'FALL INTO'
MOVEM S1,.JLABL(R) ;SAVE THE LABEL
IDENT [ASCIZ/ BLABL /] ;IDENTIFY THE LABELED LINE
MOVE T1,.JLABL(R) ;GET LABEL FOR LUUO INTO T1
PUSHJ P,L$LSIX## ;LOG THE LABEL (SIXBIT)
PUSHJ P,L$LCOL## ;LOG ONE COLON
PUSHJ P,L$LCOL## ;LOG THE SECOND ONE
PUSHJ P,L$CRLF ;PUT OUT CRLF
HONO.3: PUSHJ P,SKPBL1 ;SKIP ANY BLANKS AFTER THE LABEL
HONO.4: TLO F,FL.LAB ;NO MORE LABELS ON THIS LINE
TLNN J,JL.UJA ;IS THERE A JOB STILL THERE
JRST [PUSHJ P,L$OUTP## ;OUTPUT THE LOG
TLO R,RL.NLG ;SUPPRESS PRINTING OF THE LOG FILE
JRST CLOS.1] ;SO JUST DISMISS THIS JOB
CAIE CH,CHR.CR ;IS THIS A NULL STATEMENT
JRST HONO.2 ;NO, TREAT THIS AS A LINE IDENTIFIER
PUSHJ P,GETCTL ;CHEW UP THE LINE FEED TOO
JRST HONO.1 ;NOW MAY HAVE A LABEL
;HERE WHEN A LINE DOES NOT BEGIN WITH A LABEL
NOTLAB: TLNE J,JL.UML ;NOT A LABEL, IS USER AT MONITOR LEVEL
JRST MONLIN ;YES, S1=MONIOR COMMAND OR BATCH COMMAND
PUSHJ P,REPOSI ;REPOSITION THE POINTERS
PUSHJ P,GETCTL ;GET THE FIRST CHARACTER OF THE LINE
JRST CPYLOP ;COPY TO THE USER JOB
;HERE WHEN DIALOGUE MODE IS IN EFFECT, READ FROM THE OPERATOR
REDOPR: SETZ S1, ;CLEAR S1..NO TEXT TO FOR RESPONSE
PUSHJ P,SNWTOR ;SEND WTOR MESSAGE
PUSHJ P,OPRRES ;GET THE RESPONSE
TLNN J,JL.UJA ;IS THERE A JOB STILL THERE
JRST CLOS.1 ;NO, JUST DISMISS IT
TLNE R,RL.DIA ;IS THE JOB STILL WAITING
JRST REDOPR ;YES, OPERATOR MUST RESPOND
IDENT [ASCIZ/ BAOPR From Operator: /] ;IDENTIFY THE OPERATOR RESPONSE
PUSH P,F ;SAVE F IN CASE SILENCE IS SET
TLZ F,FL.SIL ;THIS LINE MUST GO TO THE LOG FILE
TXTJOB @.JOPER+ARG.DA(R) ;SEND RESPONSE WITH TERMINATORS
SKIPL .JREOL(R) ;HAVE END OF LINE
TXTJOB CRLF ;NO..END THE LINE
DMOVE S1,.JOPER(R) ;GET LENGTH AND ADDRESS OF RESPONSE AREA
$CALL M%RMEM ;RETURN THE RESPONSE DATA
SETZM .JOPER(R) ;CLEAR COUNT WORD
SETZM .JOPER+1(R) ;AND ADDRESS WORD
POP P,S1 ;RESTORE OLD F
TLNE S1,FL.SIL ;WAS SILENCE SET
TLO F,FL.SIL ;YES, SET IT AGAIN
PUSHJ P,PTYSND ;OUTPUT THE PTY BUFFER
SETOM .JREOL(R) ;INDICATE AN END OF LINE SENT
JRST HONORJ ;END THIS DIALOGUE
;HERE IF LINE STARTS WITH A SPECIAL ACTION CHARACTER. DETERMINE WHICH ONE
CNTLLI: TLZ F,FL.PER ;CLEAR A FLAG
CAIE CH,CHR.FF ;IS IT VERTICAL PAPER MOTION IN CLOUMN 1
CAIN CH,CHR.VT ;LOOK FOR FORM FEED AND VERTICAL TAB
JRST VERTMO ;YES, PRETEND COLUMN 2 IS COLUMN 1
CAIE CH,";" ;A COMMENT LINE
CAIN CH,"!" ;AS DEFINED BY THE STANDARD
JRST CMNTLI ;YES, COPY THE COMMENT LINE
CAIN CH,"*" ;CUSP OR USER INPUT
JRST USRINP ;YES, IS USER MODE INPUT
CAIN CH,"=" ;SPECIAL USER LINES
JRST EQUINP ;YES, IS USER MODE DATA
CAIN CH,"%" ;ONE OF THE RESERVED LABELS
JRST DECLAB ;YES, SET UP SEARCH FOR A DIGITAL LABEL
CAIE CH,MONCHR ;MONITOR LEVEL ( . OR @ )
JRST CPYLOP ;IF NONE OF THE ABOVE SPECIALS, IS USER DATA
TLO F,FL.PER ;REMEMBER A PERIOD WAS SEEN
PUSHJ P,SAVPOS ;SAVE THE CURRENT POSITION
PUSHJ P,GETSIX ;GET A COMMAND
IFE <MONCHR-".">,< ;IF PROMPT IS A DOT, RESLVE THE AMBIGUITY OF .NUM
JUMPN S1,MONLIN ;SOMETHING IS PRESENT, SEE IF A BATCH COMMAND
CAIG CH,"9" ;SEE IF LINE IS .NUMBER
CAIGE CH,"0" ;SEE IF THE TERMINATOR IS A VALID DIGIT
JRST MONSND ;SEND THE LINE TO THE MONITOR
PUSHJ P,REPOSI ;REPOSITION THE CTL FILE
TLZ F,FL.PER ;CLEAR A FLAG
MOVEI CH,MONCHR ;WILL SEND A PERIOD TO THE JOB
JRST CPYLOP ;THIS LINE IS USER DATA
> ;END OF IFE
MONLIN: TLNN S1,007700 ;CANNOT BE A BATCH COMMAND IF 1 LETTER
JRST MONSND ;SEND SINGLE LETTER COMMANDS TO THE MONITOR
MOVE T1,[-NBACMD,,BACMDS] ;AOBJN FOR TABLE LOOKUP
PUSHJ P,TABSRC ;DO THE TABLE SEARCH FOR COMMAND IN S1
JRST MONSND ;NOT FOUND, GIVE TO THE MONITOR
JRST MONSND ;GIVE AMBIGUOUS ONES TO THE MONITOR ALSO
SKIPL T3,BADISP(T3) ;GET DISPATCH, SEE IF VALID IF JOB IS IN ERROR
TLNN R,RL.JIE ;NOT VALID, IS THE JOB IN ERROR
JRST (T3) ;OK TO DO THE COMMAND
MONSND: PUSHJ P,REPOSI ;REPOSITION THE FILE
TLNE R,RL.JIE ;IS THE JOB IN ERROR NOW
JRST USRERR ;YES, BUT NO .IF(XXXX) STUFF, LOOK FOR ERROR PACKETS
PUSHJ P,INMONM ;MAKE SURE THE JOB'S IN MONITOR MODE
TLNE F,FL.SIL ;IS THIS OUTPUT TO BE SILENCE
TLZ F,FL.PER ;YES, CLEAR POSSIBLE PERIOD FLAG
TLZE F,FL.PER ;DID THE LINE START WITH A PERIOD
PUSHJ P,L$LPER## ;YES, ECHO A PERIOD FOR CLEANLINESS
PUSHJ P,SAVPOS ;SAVE CTL FILE POSITION FOR ^Z CHECK
PUSHJ P,GETCTL ;GET NEXT CHAR IF ^Z THEN TREAT AS USER
;DATA (IE. AS A COMMENT)
CAIN CH,CHR.CZ ;IS IT A ^Z?
JRST CPYLOP ;YES, SEND OFF AS USER DATA (COMMENT)
PUSHJ P,REPOSI ;NO, REPOSITION AND RESTORE CH TO
MOVEI CH,MONCHR ;TO A MONITOR PROMPT
JRST MONSUP ;COPY THE REST OF THE LINE (SUPPRESS TRAILING BLANKS)
;RULES FOR THE COMMAND TABLE
; 1)COMMANDS ARE UNIQUE IN 4 LETTERS
; 1.1)EXCEPT BACKTO AND BACKSPACE (MONITOR COMMAND TAKES PRECEDENCE)
; 2)IF THE SECOND ARGUMENT IS PRESENT, THE COMMAND CAN BE EXECUTED
; EVEN IF THE JOB IS IN ERROR
; 3)IF THE THIRD ARGUMENT IS PRESENT, IT IS THE DISPATCH ADDRESS
DEFINE CMDTBL<
LSTOFF
X BACKSP,,MONSND ;SEND ANY ABBREVIATION OF BACKSP TO THE MONITOR
X BACKTO, ;GOTO A PRIOR LABEL
X CHKPNT, ;TAKE A CHECK POINT
X ERROR, ;DEFINE AN ADDITIONAL ERROR CHARACTER
X GOTO, ;PROCEED AT ANOTHER PLACE
X IF,E ;ERROR TESTING
X MESSAG, ;$MESSAGE FOR MINI-BATCH STANDARD
X NOERRO, ;TURN OFF ALL ERRORS (EXCEPT TIME EST EXCEEDED)
X NOOPER,E ;LEAVE DIALOGUE MODE
X OPERAT, ;ENTER DIALOGUE MODE WITH A SPECIFIC CHARACTER
X PLEASE, ;TRAP SYSTEM PLEASE COMMANDS
X REQUEU, ;REQUEUE THIS JOB
X REVIVE, ;RESUME NORMAL LISTING MODE
X SILENC, ;TURN OFF ALL OUTPUT
LSTON
>
DEFINE X(A,B,C)<
<SIXBIT\A\>
>
BACMDS: CMDTBL ;GENERATE THE COMMAND TABLE
NBACMD==.-BACMDS ;NUMBER OF COMMANDS
DEFINE X(A,B,C)<
IFB <C>,<
IFB <B>,<EXP BB'A>
IFNB <B>,<XWD 400000,BB'A>>
IFNB <C>,<
IFB <B>,<EXP C>
IFNB <B>,<XWD 400000,C>>
>
BADISP: CMDTBL ;GENERATE THE DISPATCH TABLE
;HERE IF LINE IS FOR USER LEVEL INPUT
EQUINP: TLO F,FL.SUP ;SET SUPPRESSION OF FINAL CR-LF
USRINP: JSP P2,ISCMNT ;SEE IF THIS LINE IS A COMMENT TO THE LOG FILE
TLNN F,FL.SIL ;IS THE LOG FILE SILENCED
PUSHJ P,L$PLOG## ;NO, ECHO THE CHARACTER
CPYLIN: PUSHJ P,GETCTL ;GET THE NEXT CHARACTER
CPYL.1: TLNE F,FL.SUP ;Suppress the crlf?
JRST CPYL.2 ;Yes, see if this is the line feed
;**;[4301]Insert 10 lines at CPYL.1:+1L JCR 10/15/85
TLNE F,FL.XCC ;[4301]Generated control character?
TLNE J,JL.UML ;[4301]Yes, at monitor level?
JRST CPYSND ;[4301]Yes, send character as is
CAIE CH,CHR.LF ;[4301]User level, don't treat ^J or ^L
CAIN CH,CHR.FF ;[4301]as generated control characters
JRST ZEROCC ;[4301]Go turn off FL.XCC
CAIE CH,CHR.CR ;[4301]Turn off FL.XCC for ^M also
JRST CPYSND ;[4301]Send it off
ZEROCC: TLZ F,FL.XCC ;[4301]Turn off FL.XCC
TLO F,FL.ZXC ;[4301]Indicate FL.XCC was once on
CPYSND: PUSHJ P,CHKSND ;SEND IT TO THE JOB, CHECK RESULT
TLNE F,FL.SUP ;Suppress the crlf?
JRST CPYLIN ;Yes
;**;[4301]Insert 2 lines at CPYSND:+2L JCR 10/15/85
TLNE F,FL.ZXC ;[4301]Was this once a generated ctl char?
JRST CPYLIN ;[4301]Yes, get the next character
TLNE F,FL.XCC ;WAS THIS A GENERATED CTL CHARACTER?
JRST CPYXCC ;YES, GO CHECK FOR LINE ENDER
CAIE CH,CHR.LF ;DID WE SEND THE LINE FEED
JRST CPYLIN ;NO, CONTINUE COPY
CPYOUT: SETOM .JREOL(R) ;MARK END OF LINE SENT
PUSHJ P,PTYSND ;SEND THE PTY BUFFER
;FIXED BY 4070
;IFN FTJSYS,<
; PUSHJ P,QTS ;GIVE THE JOB SOME TIME
;>;END FTJSYS
JRST HONORJ ;AND WAIT FOR NEXT INPUT REQUEST
;**;[4301]Replace 6 lines at CPYL.2:+0L with 17 lines JCR 10/15/85
CPYL.2: CAIN CH,CHR.CR ;[4301]Is this a carriage return?
JRST CHKCR ;[4301]Yes, determine if generated or not
CAIE CH,CHR.LF ;[4301]Is this a line feed?
JRST CHKFF ;[4301]No, check for form feed
TLZE F,FL.XCC ;[4301]Yes, is this a generated line feed?
JRST CHKLF ;[4301]Yes, this is user data, so send it
TLZ F,FL.SUP ;[4301]Clear the suppression flag
JRST CPYOUT ;[4301]Output the current buffers
CHKCR: TLZN F,FL.XCC ;[4301]Was this a generated carriage return?
JRST CPYLIN ;[4301]No, so ignore; get the next character
TLO F,FL.ZXC ;[4301]Yes, indicate it was once generated
JRST CPYSND ;[4301]Send it down the PTY:
CHKFF: CAIE CH,CHR.FF ;[4301]Is this a form feed?
JRST CPYSND ;[4301]No, so send it down the PTY
TLZ F,FL.XCC ;[4301]Yes, user data so turn off generated
CHKLF: TLO F,FL.ZXC ;[4301]Indicate it was once generated
JRST CPYSND ;[4301]Send it down the PTY:
VERTMO: JSP P2,ISCMNT ;SEE IF THIS LINE IS A COMMENT TO THE LOG FILE
PUSHJ P,SNDCHR ;SEND THE FF OR VT
JRST CPYOUT ;SEND THE BUFFER AND WAIT
CPYXCC: CAIE CH,CHR.CR ;IS IT A CARRIAGE RETURN OR ELSE
PUSHJ P,COMTRM ; ANOTHER COMMON LINE TERMINATOR?
CAIA ;YES, PROCEED WITH THIS...
JRST CPYLIN ;NO, JUST KEEP ON COPYING
TLZ F,FL.XCC ;TURN OFF FORCED CONTROL CHAR. BIT
PUSHJ P,PTYSND ;SEND THIS BUFFER TO THE JOB
TLNE F,FL.SIL ;IS LOG OUTPUT SILENCED?
JRST CPYX.1 ;YES, SO BYPASS TIME STAMP
PUSHJ P,L$CRLF## ;OUTPUT CR-LF TO THE JOB
PUSHJ P,L$LSTP## ;AND OUTPUT THE TIME STAMP
CPYX.1: SETOM .JREOL(R) ;NOTE EOL SENT SO ERRORS CAN BE FOUND
PUSHJ P,IOWAIT ;WAIT UNTIL THE JOB WANTS MORE INPUT
SETZM .JREOL(R) ;CLEAR EOL FLAG
TLNN J,JL.UJA ;IS THE JOB STILL THERE?
JRST CPYX.2 ;NO, GO WRAP UP THIS JOB
SKIPE .JRTIM(R) ;IS TIME STAMP NEEDED?
TLNE F,FL.SIL ;YES, BUT ARE WE SILENCED?
CAIA ; DON'T OUTPUT A TIME STAMP
PUSHJ P,L$LSTP## ; YES, OUTPUT THE TIME STAMP
JRST CPYLIN ;GO SEND SOME MORE DATA
CPYX.2: PUSHJ P,SNDUPC ;NO, ADD ^C AND DUMP THE BUFFER
PUSHJ P,IOWAIT ;WAIT FOR MONITOR TO WAKE US UP
JRST CLOS.1 ;THEN DISMISS THE JOB
;HERE TO SUPPRESS TRAILING BLANKS ON A MONITOR COMMAND LINE
MONSUP: SKIPE .JRTIM(R) ;NEED A TIME STAMP
TLNE F,FL.SIL ;YES BUT IS THE OUTPUT SILENCED
SKIPA ;NEVER MIND THE STAMP
PUSHJ P,L$LSTP## ;OUTPUT ONE NOW
SETZ P1, ;WILL COUNT BLANKS
MONS.1: PUSHJ P,GETCTL ;GET A CHARACTER FROM THE CTL FILE
CAIE CH,CHR.LF ;END OF THE LINE
CAIN CH,CHR.CR ;THE CARRIAGE RETURN
JRST CPYSND ;YES, SEND THAT, THE LINE FEED, AND DONE
CAIN CH," " ;A BLANK TO SUPPRESS
AOJA P1,MONS.1 ;YES, COUNT IT AND GET ANOTHER
JUMPE P1,MONS.2 ;JUMP IF NO BLANKS PRECEEDED IT
MOVE P2,CH ;SAVE THE CHARACTER
MOVEI CH," " ;GET A BLANK
PUSHJ P,CHKSND ;SEND IT TO THE JOB, CHECK RESULT
SOJG P1,.-1 ;SEND AS MANY AS NEEDED, CLEAR THE COUNTER
MOVE CH,P2 ;GET THE ORIGINAL BACK
MONS.2: PUSHJ P,CHKSND ;SEND IT TO THE JOB, CHECK RESULT
JRST MONS.1 ;GET ANOTHER
;HERE TO DETERMINE IF THIS LINE IS A COMMENT OR TO BE SENT AS USER DATA
CPYLOP: MOVEI P2,CPYL.1 ;FAKE OUT A JSP
ISCMNT: TLNE R,RL.JIE ;Is the job in error state
JRST CMNTLI ;Yes, write out as a comment
TLNE J,JL.UML ;At Monitor level?
JRST [ CAIN CH,CHR.CZ ;Yes, a ^Z?
JRST (P2) ;Yes, send it off
JRST CMNTLI ] ;No, send off as a comment
CAIE CH,CHR.LF ;User level, don't treat ^J or ^L
CAIN CH,CHR.FF ;as generated control characters
JRST UPZC.1 ;Go turn off FL.XCC
CAIE CH,CHR.CR ;Turn off FL.XCC for ^M also
JRST (P2) ;Send it off
UPZC.1: TLZ F,FL.XCC ;Turn off FL.XCC
;**;[4301]Insert line at UPZC.1:+1L JCR 10/15/85
TLO F,FL.ZXC ;[4301]Indicate FL.XCC was once on
JRST (P2) ;Send it off
;HERE TO COPY A COMMENT LINE TO THE LOG FILE (CH IS THE FIRST CHARACTER)
CMNTLI: PUSHJ P,CPYCMT ;USE THE SUBROUTINE FOR THIS
TLZ F,FL.SUP ;IF COPIED A COMMENT LINE, CLEAR SUPRESSION
JRST HONO.1 ;RESUME READING THE CTL FILE
;HERE TO SEND A CHARACTER TO THE SUBJOB, CHECK IF JOB IS STILL AROUND
CHKSND: PUSHJ P,SNDCHR ;FIRST, SEND THE CHARACTER, LOG IT
TLNE J,JL.UJA ;IS THE JOB STILL THERE
POPJ P, ;YES, RETURN FOR MORE DATA
PUSHJ P,SNDUPC ;NO, ADD CONTROL C AND DUMP THE BUFFER
PUSHJ P,IOWAIT ;WAIT FOR MONITOR TO TYPE "?"
JRST CLOS.1 ;AND DISMISS THE JOB
SUBTTL Job Processor - Execute Batch Commands
;GOTO COMMAND - PROCEED AT ANOTHER PLACE
BBGOTO: PUSHJ P,GETLAB ;GET A LABEL AND ECHO THE BATCH COMMAND LINE
SKIPE .JLABL(R) ;WAS THERE ONE
JRST LABSRC ;YES, GO LOOKING
GOTO.1: MOVEI T1,[ASCIZ/BTNNLS No label specified or illegal syntax./]
;**;[4303]At GOTO.1:+1L Change 1 line JCR 6/11/86
JRST SRCFIN ;[4303]Output error and go to %FIN::
;BACKTO COMMAND - GOTO A PRIOR LABEL
BBBACK: MOVE S1,.JCJFN(R) ;JFN FOR CTL FILE
$CALL F%CHKP ;TAKE CHECKPOINT OF FILE
MOVEM S1,.JBAKP(R) ;SAVE POINTER
PUSHJ P,GETLAB ;GET A LABEL AND ECHO THIS LINE
SKIPN .JLABL(R) ;WAS THERE ONE
JRST GOTO.1 ;NO GIVE AN ERROR
HRRZ S1,J ;GET THE MONITOR JOB NUMBER
MOVX S2,JI.RTM ;GET THE RUNTIME
PUSHJ P,I%JINF ;GET THE JOB INFO
CAMG S2,.JRUNT(R) ;USER MUST DO SOMETHING TO GET RUNTIME
JRST BACK.1 ;OTHERWISE COULD BE A::.BACKTO A
MOVEM S2,.JRUNT(R) ;SAVE FOR NEXT BACKTO COMMAND
TRO F,FR.BAK!FR.FIN ;SET SOME SEARCH FLAGS
MOVE S1,.JCJFN(R) ;JFN FOR FILE
MOVEI S2,0 ;BEGINNING OF FILE
$CALL F%POS ;POSITION FILE FOR BACKTO
JRST LABSRC ;GO FIND THE LABEL
BACK.1: MOVEI T1,[ASCIZ/BTNBPL Your use of BACKTO has caused a possible loop./]
;**;[4303]At BACK.1:+1L change 1 line JCR 6/11/86
JRST SRCFIN ;[4303]Issue error and go to %FIN::
;CHKPNT COMMAND - TAKE A CHECKPOINT
BBCHKP: PUSHJ P,GETLAB ;GET THE REQUEUE LABEL AND ECHO THIS LINE
MOVX S1,<BA.CHK> ;GET CHECKPOINT FLAG
IORM S1,.JCHRQ(R) ;TURN ON CHECKPOINT FLAG IN CHECK WORDS
SKIPN S1,.JLABL(R) ;WAS THERE A LABEL
JRST GOTO.1 ;NO, IS AN ERROR
MOVEM S1,.JCHRQ+1(R) ;STORE THE RESTART LABEL
TRO F,FR.CHK ;UPDATE CHECKPOINT DATA TO DISK
PUSHJ P,SNDCHK ;SEND STATUS UPDATE AND CHECKPOINT
JUMPT HONO.1 ;O.K.RESUME THE CTL FILE
JRST CLOSJB ;ERROR..CLOSE OUT THE JOB
;REQUEUE COMMAND - REQUEUE THIS JOB (OPTIONAL RESTART LABEL)
BBREQU: PUSHJ P,GETLAB ;GET THE OPTIONAL LABEL, ECHO THIS LINE
MOVX S1,<BA.URQ> ;GET REQUEUE BY USER
IORM S1,.JCHRQ(R) ;TURN ON USER REQUEUE IN CHECK WORDS
MOVEI S1,E.RUSR ;REQUEUED BY THE USER
MOVEM S1,.JERRO(R) ;REASON FOR ENDING
SKIPE S1,.JLABL(R) ;WAS THERE A LABEL
MOVEM S1,.JCHRQ+1(R) ;STORE THE RESTART LABEL
IDENT [ASCIZ / BTNJRQ JOB REQUEUED/]
PUSHJ P,L$CRLF## ;CRLF TO JOB
MOVEI S1,REQTIM ;Set the requeue time
MOVEM S1,.JREQI(R) ;Set it in the requeue flag word
JRST REQEXT ;GIVE AN AFTER, LOGOUT, AND REQUEUE
;NOERROR COMMAND - TURN OFF ALL ERRORS (EXCEPT TIME EST EXCEEDED)
BBNOER: TLO F,FL.NER ;SET NOERROR IN EFFECT
BAEXIT: PUSHJ P,BALINE ;ECHO THE BATCH COMMAND
JRST HONO.1 ;RESUME READING THE CTL FILE
;NOOPERATOR COMMAND - LEAVE DIALOGUE MODE
BBNOOP: SETZ S1, ;CLEAR THE DIALOGUE CHARACTER
DPB S1,LDOPCH ;CLEAR IT
JRST BAEXIT ;AND EXIT THROUGH COMMON CODE
;ERROR COMMAND - DEFINE AN ADDITIONAL ERROR CHARACTER
BBERRO: TLZ F,FL.NER ;CLEAR NOERROR MODE
JSP T4,ER..OP ;CALL COMMON ROUTINE FOR ERROR/OPERATOR
XWD 0,[ASCIZ/ERROR/] ;DEFAULT CHARACTER,,STRING NAME OF CALLER
LDERCH: POINT 9,.JERCD(R),8 ;HOW TO LOAD/STORE THE CHARACTER
;OPERATOR COMMAND - ENTER DIALOGUE MODE WITH THE SPECIFIED CHARACTER
BBOPER: JSP T4,ER..OP ;CALL THE COMMON PROCESS (IT WILL NO RETURN HERE)
XWD "$",[ASCIZ/OPERATOR/] ;DEFAULT IS $,CALLER IS OPERATOR
LDOPCH: POINT 9,.JERCD(R),17 ;HOW TO LOAD/STORE THE CHARACTER
;PLEASE COMMAND - OUTPUT A MESSAGE TO THE OPERATOR (OPTIONALLY WAIT)
;MESSAGE COMMAND - THE PLEASE COMMAND FOR THE MINI-BATCH STANDARD
BBMESS:
BBPLEA: TLO F,FL.PLS ;SET PLEASE IN PROGRESS
PUSHJ P,STAWTO ;GIVE A HEADER TO THE OPERATOR
PUSHJ P,BALINE ;ECHO LINE TO THE LOG AND TO THE OPERATOR
TLZN F,FL.PLS ;IS PLEASE STILL SET
JRST [PUSHJ P,OUTEXT ;END THE TTY LINE
JRST HONO.1] ;RESUME READING THE CTL FILE
PUSHJ P,SNWTOR ;SEND WTOR
PUSHJ P,OPRRES ;GET THE OPERATOR RESPONSE
PUSHJ P,IDNOPR ;IDENTIFY LINE TO OPERATOR
$TEXT (SENDJ1,<From Operator: ^T/@.JOPER+1(R)/^A>)
PUSHJ P,L$CRLF## ;PUT OUT CR, AND LINE FEED
DMOVE S1,.JOPER(R) ;GET THE SIZE AND ADDRESS
PUSHJ P,M%RMEM ;RELEASE THE MEMORY
SETZM .JOPER(R) ;CLEAR VALUE
SETZM .JOPER+1(R) ;CLEAR ADDRESS WORD
JRST HONO.0 ;START AT THE BEGINNING
;SILENCE COMMAND - TURN OFF THE LOG FILE
;REVIVE COMMAND - TURN IT BACK ON
BBSILE: TLOA F,FL.SIL ;SET SILENCE MODE
BBREVI: TLZ F,FL.SIL ;CLEAR SILENCE MODE
JRST BAEXIT ;END OF THESE COMMANDS
;IF COMMAND - DO SOME ERROR TESTING
BBIF: PUSHJ P,SKPBLK ;SKIP OVER ANY BLANKS
CAIE CH,"(" ;NEED THE OPENING PAREN
JRST IF...E ;BAD IF COMMAND
PUSHJ P,GETSIX ;GET THE ARGUMENT
JUMPE S1,IF...E ;BAD COMMAND
PUSHJ P,SKPBLK ;SKIP MORE BLANKS
CAIE CH,")" ;BETTER BE THE CLOSURE
JRST IF...E ;REAL BAD COMMAND
MOVE T1,[-NIFCMD,,IFCMDS] ;AOBJN FOR TABLE LOOKUP
PUSHJ P,TABSRC ;LOOK FOR THE COMMAND IN S1
JRST IF...E ;NOT FOUND
JRST IF...E ;AMBIGUOUS
JRST @IFDISP(T3) ;PROCESS THE IF COMMAND
IF...E: PUSHJ P,BALINE ;OUTPUT THE LINE
MOVEI T1,[ASCIZ/BTNIIC Illegal IF command argument or syntax error./]
;**;[4303]At IF...E:+2L change 1 line JCR 6/11/86
JRST SRCFIN ;[4303]Give error and go to %FIN::
;DEFINE THE LEGAL ARGUMENTS FOR IF COMMANDS. RULES:
; 1)COMMANDS ARE UNIQUE IN 4 LETTERS
DEFINE CMDTBL<
LSTOFF
X ERROR, ;TEST IF AN ERROR OCCURRED
X NOERRO, ;TEST IF NO ERRORS HAVE OCCURRED
LSTON
>
DEFINE X(A)<
<SIXBIT\A\>
>
IFCMDS: CMDTBL ;GENERATE THE ARGUMENT TABLE
NIFCMD==.-IFCMDS ;NUMBER OF THEM
DEFINE X(A)<
EXP FF'A
>
IFDISP: CMDTBL ;GENERATE THE DISPATCH TABLE
;HERE TO PROCESS THE IF COMMAND
;FFERRO PROCESSES THE .IF(ERROR)statement FORM
;FFNOER PROCESSES THE .IF(NOERROR)statement FORM
;EXIT IS VIA IFTRUE IF THE CONDITION IS TRUE AND THE STATEMENT IS TO BE EXECUTED
;OR IFFALS IF THE CONDITION IS FALSE AND THE STATEMENT IS TO BE SKIPPED
FFERRO: TLZN R,RL.JIE ;DID AN ERROR OCCUR
JRST IFFALS ;NO, IF(ERROR) IS FALSE
IFTRUE: IDENT [ASCIZ/ TRUE /] ;IDENTIFY TRUE LINE
PUSHJ P,REPOSI ;BACK TO THE START OF THIS LINE
TLZE F,FL.PER ;NEED A PERIOD
PUSHJ P,L$LPER## ;YES, ECHO ONE FOR CLEANLINESS
IFTR.1: PUSHJ P,GETCTL ;CAN COPY EVERYTHING UP TO THE CLOSE PAREN
PUSHJ P,L$PLOG## ;OUTPUT THIS ONE
CAIE CH,")" ;ALL AFTER THAT IS ANOTHER COMMAND
JRST IFTR.1 ;CONTINUE
PUSHJ P,L$CRLF## ;END THIS LINE
JRST HONO.3 ;FIND THE OBJECT STATEMENT AND EXECUTE IT
FFNOER: TLZN R,RL.JIE ;DID AN ERROR OCCUR
JRST IFTRUE ;NO, .IF(NOERROR) IS TRUE
IFFALS: IDENT [ASCIZ/ FALSE /] ;IDENTIFY THE FALSE LINE
PUSHJ P,REPOSI ;BACK UP THE LINE
PUSHJ P,BALI.1 ;COPY THE ENTIRE LINE AS A COMMENT
JRST HONO.1 ;PROCESS THE NEXT STATEMENT
;HERE TO GET A LABEL FOR COMMANDS LIKE GOTO (AND ECHO A BATCH COMMAND LINE)
GETLAB: TRO F,FR.RSC ;ALREADY HAVE CH
PUSHJ P,GETSIX ;GET A SIXBIT LABEL
MOVEM S1,.JLABL(R) ;STORE IT (EVEN IF NONE)
BALINE: IDENT [ASCIZ/ BATCH /] ;IDENTIFY THIS LINE
PUSHJ P,REPOSI ;REPOSITION TO THE BEGINNING OF THE LINE
BALI.1: TLZE F,FL.PER ;DID LINE START WITH A PERIOD
PUSHJ P,L$LPER## ;YES, ECHO ONE FOR CLEANLINESS
PUSHJ P,GETCTL ;GET THE CHARACTER
PJRST CMNT.1 ;ECHO IT AND THE LINE, THEN RETURN
;HERE TO GET THE CHARACTER FOR .ERROR AND .OPERATOR
;CALL VIA JSP T4,ER..OP (DOES NOT RETURN TO CALLER)
; 0(S1) = XWD DEFAULT CHARACTER , [ASCIZ/CALLERS NAME/]
; 1(S1) = POINT STATEMENT TO STORE THE CHARACTER
ER..OP: HLR S2,(T4) ;GET THE DEFAULT CHARACTER
DPB S2,1(T4) ;STORE IT NOW
PUSHJ P,SKPBLK ;SKIP OVER ANY BLANKS (TABS)
CAIE CH,CHR.CR ;IS IT THE CARRIAGE RETURN
PUSHJ P,COMTRM ;THIS IS THE SAME CHECK AS IN GETONE
JRST BAEXIT ;YES, RETURN WITH DEFAULT SET
CAIE CH,";" ;LINE HAVE A COMMENT
CAIN CH,"!" ;OTHER COMMENT CHARACTER
JRST BAEXIT ;YES, STOP NOW
CAIG CH,40 ;ONLY VALID IF ABOVE 40 OCTAL
JRST ER...1 ;BAD CHARACTER SPECIFIED
DPB CH,1(T4) ;STORE THE SPECIFIED CHARACTER
JRST BAEXIT ;AND RETURN THROUGH COMMON CODE
ER...1: SETZ S2, ;ON ERROR, CLEAR ANY DEFAULT CHARACTER
DPB S2,1(T4) ;STORE A NULL CHARACTER
HRRZ S1,(T4) ;GET ADDRESS OF CALLERS NAME
MOVEM S1,TEMP2 ;SAVE IN A TEMP
PUSHJ P,BALINE ;ECHO THE BATCH COMMAND
$TEXT (L$OUT1,<BTNICS Illegal character specified for ^T/TEMP2/
>) ;END THE MESSAGE
;**;[4303]At ER...1:+7L replace 1 line with 2 lines JCR 6/11/86
MOVE S1,[SIXBIT/%FIN/] ;[4303]Look for a %FIN::
JRST FINSR3 ;[4303]GOTO %FIN::
;HERE FOR THE FIRST LOOK AT DIGITAL RESERVED LABELS (%XXXXX::)
USRERR: TLZE F,FL.PER ;ENTERED AT USRERR FROM MONSND
DECLAB: PUSHJ P,DECRBP ;BACK UP OVER THE % SIGN (OR .)
TRO F,FR.LSL ;LIST LINES SKIPPED
TLNN R,RL.JIE ;IS THE JOB IN ERROR
JRST FINSRC ;NO, LOOK FOR % FIN
PUSHJ P,SYSPRG ;WHERE DID THE PROGRAM COME FROM
SKIPA S1,[SIXBIT/%CERR/] ;SYS
MOVE S1,[SIXBIT/%ERR/] ;USER
MOVEM S1,.JLABL(R) ;SAVE THE LABEL
JRST LABSRC ;NOW SEARCH FOR IT
;HERE TO SET UP FOR A SEARCH FOR %FIN:: OR %TERR::
TIMERR: MOVEI S1,E.TLMT ;TIME LIMIT EXCEEDED
MOVEM S1,.JERRO(R) ;SAVE ERROR CODE FOR END STATEMENT
TLO F,FL.ERR ;SET ERROR CONDITION FLAG
TLOE F,FL.%XT ;TIME EST EXCEEDED GIVE EXTRA TIME
JRST CLOSJB ;ALREADY DID, KLUNK THE JOB NOW
TRO F,FR.LSL ;LIST LINES SKIPPED FOR TIME LIMIT EXCEEDED
;**;[4303]At TIMERR:+6L replace 4 lines with 24 lines JCR 6/11/86
MOVE S1,[SIXBIT/%TERR/] ;[4303]Set up for search
JRST FINSR3 ;[4303]Do the search
FINSRC: $CALL SAVPOS ;[4303]Save the current file position
TRO F,FR.%SG ;[4303]% is legal
$CALL GETSIX ;[4303]Get the potential label
CAIE CH,":" ;[4303]Was it a label?
JRST FINSR2 ;[4303]No, so search for %FIN::
CAMN S1,[SIXBIT/%RERR/] ;[4303]Was the label a %RERR:: ?
SKIPA ;[4303]Yes, the one we want
FINSR2: MOVE S1,[SIXBIT/%FIN/] ;[4303]The label we want
PUSH P,S1 ;[4303]Destroyed by REPOSI
$CALL REPOSI ;[4303]Restore the original position
POP P,S1 ;[4303]Restore the label
FINSR3: MOVEM S1,.JLABL(R) ;[4303]Store in the data base
JRST LABSRC ;[4303]NOW SEARCH FOR IT
;[4303]Here on label errors from GOTO, CHKPNT, IF and operator
;[4303]response not allowed.
SRCFIN: $CALL L$CMNT## ;[4303]Set up for comment
$TEXT (L$OUT1,<? ^T/(T1)/>) ;[4303]Output message to log
TRO F,FR.LSL ;[4303]List skipped lines
MOVE S1,[SIXBIT/%FIN/] ;[4303]Label we want
MOVEM S1,.JLABL(R) ;[4303]Place in the data base
;HERE TO ACTUALLY DO THE LABEL SEARCH. .JLABL(R) HAS THE LABEL
LABSRC: TRO F,FR.%SG ;INCLUDE % SIGNS IN LABELS
TLO R,RL.FCI ;FAKE OUT CLOSJB IF WE NEVER FIND THE LABEL
LABS.0: TRNE F,FR.LSL ;LISTING SKIPPED LINES
PUSHJ P,SAVPOS ;YES, SAVE OUT CURRENT POSITION
PUSHJ P,GETONE ;GET THE FIRST CHARACTER OF THIS LINE
JRST LABS.5 ;END OF LINE CHARACTER
CAIE CH,"%" ;SPECIAL CHARACTER, IS IT % SIGN
JRST LABS.4 ;A NUMBER OR OTHER SPECIAL, IS NOT A LABEL
TRO F,FR.RSC ;LINE STARTS WITH A LETTER, RE-GET IT IN GETSIX
;**;[4303]At LABS.0:+6L replace 1 line with 8 lines JCR 6/11/86
JUMPGE CH,LABS0A ;[4303]End of the file found?
SETZM .JCUSI(R) ;[4303]Yes, position the file to the start
$CALL REPOSI ;[4303]Yes, Reposition the file
TRZ F,FR.FIN ;[4303]Do not skip over %FIN::
TRO F,FR.LSL ;[4303]List skipped lines
MOVE S1,[SIXBIT/%FIN/] ;[4303]Look for a %FIN:: this time
JRST FINSR3 ;[4303]Try for a %FIN this time
LABS0A: PUSHJ P,GETSIX ;[4303]GET A POSSIBLE LABEL
CAIN CH,":" ;FIELD END WITH A COLON
JRST LABFND ;YES, FOUND A LABEL
LABS.4: TRNE F,FR.LSL ;IS THE POSITION ON THE STACK
JRST LABS.3 ;YES, LIST THE SKIPPED LINE
JRST LABS.S ;MIGHT ALREADY BE A TERMINATOR
LABS.1: PUSH P,S1 ;SAVE S1 SINCE GETCTL WILL MODIFY IT
PUSHJ P,GETCTL ;GET THE NEXT CHARACTER
POP P,S1 ;RESTORE LABEL IN S1
LABS.S: CAIE CH,CHR.LF ;END OF THIS LINE YET
JRST LABS.1 ;IGNORE MORE CHARACTERS
LABS.2: TRNN F,FR.BAK ;END OF A LINE, DOING A BACKTO
JRST LABS.0 ;NO, CHECK FOR A LABEL ON THIS LINE
MOVE S1,.JCJFN(R) ;JFN FOR CONTROL FILE
$CALL F%CHKP ;CHECKPOINT THE FILE
CAML S1,.JBAKP(R) ;PASS IT UP YET
JRST CLOSJB ;YES, REPORT THE ERROR
JRST LABS.0 ;NO, LOOK FOR A LABEL ON THIS LINE
LABFND: TRNN F,FR.FIN ;CAN WE SKIP OVER A %FIN::
CAME S1,[SIXBIT/%FIN/] ;NO, IS THIS %FIN::
SKIPA ;SEE IF LABEL WE ARE SEARCHING FOR
JRST FINFND ;FOUND A %FIN::, SEARCH IS COMPLETED
CAME S1,.JLABL(R) ;IS IT THE ONE WE WERE LOOKING FOR
JRST LABS.4 ;NO, CONTINUE SEARCH
CAMN S1,[SIXBIT/%TERR/] ;LOOKING FOR TIME LIMIT RECOVERY
JRST FINF.2 ;YES, AND THIS IS IT, GIVE %EXTRA
;**;[4303]At LABFND:+7L add 11 lines JCR 6/11/86
TRNN F,FR.RER ;[4303]Looking for %RERR:: ?
JRST LABF.1 ;[4303]No, so just output the label
CAME S1,[SIXBIT/%RERR/] ;[4303]Is this a %RERR:: ?
JRST LABF.1 ;[4303]No, so just output the label
SKIPL .JCRER(R) ;[4303]Yes, first time for search?
JRST FINFND ;[4303]No, treat as a %FIN::
TRO F,FR.LSL ;[4303]Yes, this time list skipped lines
SETZM .JCRER(R) ;[4303]Second time for %RERR:: search
SETZM .JCUSI(R) ;[4303]Position file to the start
$CALL REPOSI ;[4303]Position the file
JRST LABSRC ;[4303]Find the %RERR:: and list skipped lines
LABF.1:
LABF.2: IDENT [ASCIZ/ BLABL /] ;IDENTIFY LABELED LINE
SIXLOG .JLABL(R) ;OUTPUT THE LABEL FOUND
PUSHJ P,L$LCOL## ;ADD A COLON
PUSHJ P,GETCTL ;GET THE NEXT CHARACTER (MAYBE ANOTHER COLON)
PUSH P,CH ;SAVE IT FOR NOW
CAIN CH,":" ;WAS IT A COLON
PUSHJ P,L$PLOG## ;YES, OUTPUT IT
PUSHJ P,L$CRLF## ;END THE LINE
TRZ F,FR.%SG!FR.BAK!FR.LSL!FR.FIN ;CLEAR SEARCH TYPE FLAGS
TLZ R,RL.JIE!RL.DIA ;AFTER A SUCCESSFUL FIND, CLEAR JOB IN ERROR
POP P,CH ;RESTORE THAT CHARACTER
CAIN CH,":" ;WAS IT THE SECOND COLON
JRST HONO.3 ;YES, FIND THE OBJECT STATEMENT AND EXECUTE IT
PUSHJ P,SKPBLK ;SKIP THIS IF A BLANK (AND ANY OTHERS)
JRST HONO.4 ;NOW EXECUTE THE OBJECT STATEMENT
LABS.3: PUSHJ P,REPOSI ;REPOSITION THE CTL FILE
PUSHJ P,GETCTL ;GET THE FIRST CHARACTER
PUSHJ P,CPYCMT ;COPY IT AND THE REST AS A COMMENT LINE
JRST LABS.2 ;RETURN TO BACKTO CHECK
LABS.5: CAIE CH,CHR.FF ;CHECK EOL CHARACTER FOR FORM FEED-VERTICAL TAB
CAIN CH,CHR.VT ;CHARACTER AFTER THEM CAN START A NEW LABEL
MOVEI CH,CHR.LF ;PRETEND A LINE FEED TO END THIS LINE
JRST LABS.4 ;IF LISTING LINES, IT WILL COME OUT A FF OR VT
;HERE WHEN A %FIN:: HAS BEEN FOUND S1=SIXBIT/%FIN/
;**;[4303]At FINFND:+0L replace 1 line with 2 lines JCR 6/11/86
FINFND: TRZ F,FR.RER ;[4303]Turn off looking for %RERR::
CAMN S1,.JLABL(R) ;[4303]Were we searching for %FIN:: (or %RERR)
JRST FINF.1 ;YES, SKIP THE MESSAGE
PUSHJ P,L$BLNK## ;GET A BLANK LINE IN THE LOG FILE
PUSHJ P,L$CMNT## ;PREPARE A COMMENT LINE
TXTLOG [ASCIZ/BTNFFS Found %FIN while searching for /]
SIXLOG .JLABL(R) ;OUTPUT THE LABEL
TXTLOG [ASCIZ/, proceeding from %FIN/]
PUSHJ P,L$CRL2## ;FINISH LINE AND ADD 1
MOVE S1,[SIXBIT/%FIN/] ;NEED TO RESET THE LABEL SEARCHED FOR
MOVEM S1,.JLABL(R) ;SO WE CAN PRINT IT OUT AT LABF.2
FINF.1: PUSHJ P,CHKCLS ;SEE IF A CLOSE/DUMP IS NEEDED
FINF.2: TLZN F,FL.TLE ;DID THE JOB EXCEED THE TIME LIMIT
JRST LABF.1 ;NO, RESUME NORMAL ROUTE
PUSHJ P,INMONM ;MAKE SURE THE JOBS IN MONITOR MODE
HRRZ T3,.JQLIM+1(R) ;GET THE JOBS TIME EST
IMULI T3,%EXTRA ;COMPUTE THE EXTRA TIME AVAILABLE
IDIVI T3,^D100 ;AS A PERCENTAGE OF THE ORIGINAL EST
CAIGE T3,%EXTRA ;BUT LETS BE REASONABLE ABOUT IT
MOVEI T3,%EXTRA ;USING %EXTRA HERE IS PROBABLY OK
IFN FTUUOS,<
MOVE T1,[2,,T2] ;SET UP FOR JBSET
HRRZ T2,J ;GET THE JOB NUMBER
HRLI T3,.STTLM ;SET TIME FUNCTION
JBSET. T1, ;TRY IT WITH THE UUO
> ;END OF IFN FTUUOS
PUSHJ P,SETTIM ;SEND THE COMMAND IF THAT FAILED
JRST LABF.1 ;AND RETURN TO NORMAL SEARCH
SUBTTL Job Processor - Perform Auto KJOB and Dismiss the Job
CLOSJB:: TLNE R,RL.KJB ;WHAT ARE WE DOING HERE
JRST CLOS.3 ;IN LOTS OF TROUBLE, GO DISMISS THE JOB
TRNN F,FR.%SG ;WAS A LABEL SEARCH IN PROGRESS
JRST CLOS.0 ;NO, SKIP THE ERROR MESSAGE
LDB S1,[POINT 6,.JLABL(R),5] ;GET THE FIRST SIXBIT CHARACTER
CAIN S1,'%' ;WAS IT ONE OF THE % LABELS
JRST CLOS.4 ;YES, GIVE A DIFFERENT MESSAGE
PUSHJ P,L$BLNK## ;LOG A BLANK LINE
PUSHJ P,L$CMNT## ;LOG A COMMENT
$TEXT (L$OUT1,<? BTNCNF Could not find Label ^A>)
CLOS.5: SIXLOG .JLABL(R) ;OUTPUT THE LABEL
PUSHJ P,L$CRL2## ;FINISH LINE AND ADD ONE
SKIPN .JERRO(R) ;ALREADY HAVE AN ERROR
TLOE F,FL.ERR ;ERROR FLAG ON...ELSE SET IT
JRST CLOS.0 ;YES..ALREADY HAD AN ERROR
MOVEI S1,E.UERR ;USER ERROR
MOVEM S1,.JERRO(R) ;SAVE ERROR CODE FOR END
CLOS.0:
IFN FTUUOS,< ;NOT NEEDED ON -20 USE LGOUT JSYS
TLNE R,RL.FCI ;HIT EOF WHILE LOOKING FOR FIRST CHARACTER
TLNN J,JL.UML ;IS JOB AT MONITOR LEVEL
PUSHJ P,INMO.1 ;JUNK SENT OR AT USER LEVEL, GET TO THE MONITOR
>;END FTUUOS
PUSHJ P,CHKCLS ;CHECK IF A CLOSE/DUMP IS NEEDED
PUSHJ P,ATOKJB ;PERFORM THE AUTO KJOB
CLOS.1:: TLNN R,RL.FLS ;FLUSHING THE JOB
PUSHJ P,CTLDIS ;DISPOSE OF THE CTL FILE (MAYBE)
CLOS.3: PUSHJ P,REMCTL ;REMOVE ANY OLD CTL FILE ASSIGNMENTS
;DELSPL MUST FOLLOW CTL SINCE IT USES .JQCFD(R)
PUSHJ P,DELSPL ;REMOVE ANY SPOOLED FILES FOR THIS JOB
MOVEI S1,REL.FD ;GET MINIMUM RELEASE MESSAGE
PUSHJ P,MSGQSR ;SETUP MESSAGE TO QUASAR
MOVX T2,<INSVL.(REL.FD,MS.CNT)!INSVL.(.QOREL,MS.TYP)>
MOVEM T2,.MSTYP(S2) ;STORE LENGTH AND TYPE
MOVE T2,.JQITN(R) ;TASK NAME GIVEN BY QUASAR
MOVEM T2,REL.IT(S2) ;STORE IT
MOVE T2,.JJOBN(R) ;GET THE JOB NUMBER
MOVE T3,.JQLFP(R) ;GET THE LOG FILE BITS
TXNE T3,FP.DEL ;TO BE DELETED
TXO T2,RL.DLG ;YES, SET A BIT
TXNE T3,FP.SPL ;SPOOLED FILE
TXO T2,RL.SPL!RL.DLG ;SET SPL AND DEL.ALWAYS DELETE SPOOL FILES
TLNE R,RL.FLS ;FLUSHING THE JOB
JRST CLOS.D ;YES..IGNORE OUTPUT REQUESTS FOR LOG
GETLIM T3,.JQLIM(R),OUTP ;GET OUTPUT VALUE
CAIN T3,%EQOLG ;PRINT THE LOG
JRST CLOS.8 ;YES..PRINT THE LOG
CAIN T3,%EQOLE ;OR PRINT IT IF AN UNHANDLED ERROR
TRNN F,FR.UHE ;YES..WAS THERE AN UNHANDLED ERROR
JRST CLOS.D ;NEITHER, DON'T REQUEST PRINTING
CLOS.8: MOVEM T2,REL.BJ(S2) ;STORE FLAGS AND JOB NUMBER
IFN FTUUOS,<
MOVE T2,.JQLFD+.FDSTR(R) ;GET THE LOG FILE STRUCTURE
CAMN T2,[SIXBIT/NUL/] ;HAVE I BEEN WRITING ON NUL:
JRST CLOS.6 ;YES, SKIP THE SPEC
> ;END IFN FTUUOS
IFN FTJSYS,<
MOVE T2,.JQLFD+.FDFIL(R) ;GET LOG FILE DEVICE WORD
AND T2,[-1,,777400] ;WAS IT NUL:
CAMN T2,[ASCII /NUL:/] ;IS IT "NUL"?
JRST CLOS.6 ;YES, IGNORE ALL OF THIS
> ;END IFN FTJSYS
HRLI T2,.JQLFD(R) ;GET SOURCE OF BLT
HRRI T2,REL.FD(S2) ;GET DESTINATION OF BLT
LOAD T3,.JQLFD+.FDLEN(R),FD.LEN
LOAD T4,.MSTYP(S2),MS.CNT ;GET LENGTH OF THE MESSAGE
ADD T4,T3 ;ADD LENGTH OF THE FD
STORE T4,.MSTYP(S2),MS.CNT ;STORE MESSAGE LENGTH
ADDI T3,-1(T2) ;COMPUTE END OF BLT
BLT T2,0(T3) ;BLT THE FD FOR THE LOG
CLOS.6: TRNN F,FR.LFO ;WAS LOG FILE OPEN
JRST CLOS.C ;NO..DO NOT RELEASE
PUSHJ P,L$OUTP## ;FORCE OUT THE DATA
$CALL ZFBBK0 ;Zero out word .FBBK0 of the log file
MOVE S1,.JLJFN(R) ;LOG FILE JFN
$CALL F%REL ;CLOSE THE FILE
SKIPT ;CONTINUE IF O.K.
PUSHJ P,CLOS.E ;NOTE THE ERROR AND CONTINUE
TRZ F,FR.LFO ;MARK LOG FILE AS CLOSED
CLOS.C: PUSHJ P,CLOS.M ;SEND CLOSE MESSAGE
PUSHJ P,CLRSTR ;CLEAN UP STREAM
PUSHJ P,SNDQSR ;SEND ANSWER TO QUASAR
JRST STEXIT ;EXIT FROM STREAM
CLOS.4: PUSHJ P,L$BLNK## ;GET A BLANK LINE BEFORE THE MESSAGE
PUSHJ P,L$CMNT## ;PREPARE THE LOG FILE FOR A COMMENT
$TEXT (L$OUT1,<BTNECF End of Control File while searching for ^A>)
JRST CLOS.5 ;ADD THE LABEL AND AUTO KJOB THIS JOB
CLOS.D: MOVEM T2,REL.BJ(S2) ;SAVE FLAGS IN RELEASE MESSAGE
TRNN F,FR.LFO ;WAS LOG FILE OPEN
JRST CLOS.C ;NO..IGNORE DELETE
TXNN T2,RL.DLG ;DELETE THE LOG FILE
JRST CLOS.6 ;JUST RELEASE THE JOB AND LOG
MOVE S1,.JLJFN(R) ;GET LOG FILE JFN
$CALL F%DREL ;DELETE AND RELEASE LOG FILE
SKIPT ;CONTINUE IF O.K.
PUSHJ P,CLOS.E ;NOTE THE ERROR AND CONTINUE
TRZ F,FR.LFO ;CLEAR LOG FILE OPEN FLAG
JRST CLOS.C ;FINISH OFF THE STREAM
;**;[6003]At CLOS.E:+0L change 1 line JYCW Oct-18-88
CLOS.E: $QWTO (<BATCON Log Error>,<^I/JIBTXT/^I/LOGERR/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>) ;[6003]Use $QWTO instead of $WTO
POPJ P, ;RETURN
CLOS.M: MOVEI T1,[ASCIZ/End/] ;ENDED NORMALLY MESSAGE
; TLNE F,FL.ERR ;ANY ERRORS
; MOVEI T1,[ASCIZ/Enderr/] ;YES..HAD ERRORS
MOVEI S2,[ITEXT(<
-- Job ^I/@ERRTAB(T2)/ -->)]
SKIPN T2,.JERRO(R) ;GET ERROR CODE IF ANY
MOVEI S2,NULTXT ;NULL FIELD
CLOS.J: $WTOJ (<^T/(T1)/>,<^R/.JQJBB(R)/^I/(S2)/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>)
POPJ P, ;RETURN
SUBTTL QSRUPD - UPDATE DEVICE STATUS TO QUASAR
;THIS ROUTINE WILL SEND QUASAR A DEVICE STATUS MESSAGE
;CALLED WITH T1/ STATUS CODE
QSRUPD: MOVEI S1,STU.SZ ;GET STATUS SIZE
PUSHJ P,MSGQSR ;SETUP MESSAGE TO QUASAR
MOVEM T1,STU.CD(S2) ;SAVE THE CODE
MOVE S1,[STU.SZ,,.QOSTU] ;GET HEADER WORD
MOVEM S1,.MSTYP(S2) ;STORE IN MESSAGE
MOVSI S1,.JQTYP(R) ;GET SOURCE TYPE FROM STREAM
HRRI S1,STU.RB(S2) ;DESTINATION,,RESPONSE TYPE
BLT S1,STU.RB+OBJ.SZ-1(S2) ;MOVE TYPE,UNIT,NUMBER
PJRST SNDQSR ;SEND TO QUASAR AND RETURN
SUBTTL IDNOPR - IDENTIFY LINE TO OPERATOR
IDNOPR: PUSHJ P,L$BLNK## ;OUTPUT A BLANK LINE
IDENT [ASCIZ/ BAOPR /] ;IDENTIFY THIS LINE
POPJ P, ;RETURN
CRLF: ASCIZ /
/
MESDEL: MOVE S1,.JMLST(R) ;GET LIST NAME
$CALL L%PREM ;GET REMEMBERED ENTRY
SKIPE T1,IPC.CD(S2) ;GET THE ACTION CODE
PUSHJ P,QSRUPD ;SEND UPDATED STATUS TO QUASAR
MOVE S1,.JMLST(R) ;GET LIST NUMBER
PJRST L%DENT ;DELETE AND RETURN
;HERE TO PROCESS OPERATOR REQUEST TO REQUEUE THIS JOB
;***PROCESS THE REASON INFO TO LOG...
REQUJB:
IFN FTUUOS,<
;NOT NEEDED ON THE -20 BECAUSE OF LGOUT JSYS
PUSHJ P,INMO.1 ;PUT AT MONITOR LEVEL
>;END FTUUOS
PUSHJ P,IDNOPR ;IDENTIFY BAOPR MESSAGE
PUSHJ P,JOBOUT ;CHECK AND SEND JOB MESSAGE
$TEXT (L$OUT1,<Job Requeued By Operator>)
PUSHJ P,L$BLK1## ;SEND BLANK CR,LF..NO TIME STAMP
MOVX S1,RQ.HBO ;HELD BY OPERATOR FOR REQUEUE
MOVEM S1,.JREQI(R) ;SAVE REQUEUE FLAG WORD
MOVEI S1,E.ROPR ;REQUEUED BY OPERATOR
MOVEM S1,.JERRO(R) ;SAVE CODE FOR END
MOVX S1,<BA.ORQ!BA.JOB> ;OPERATOR REQUEUE
IORM S1,.JCHRQ(R) ;SAVE IN CHECKPOINT WORDS
REQEXT: PUSHJ P,REQMSG ;SET JOB FOR LOGOUT
MOVX S1,REQ.SZ ;REQUEUE MESSAGE SIZE
PUSHJ P,MSGQSR ;SETUP MESSAGE TO QUASAR
MOVE S1,[REQ.SZ,,.QOREQ] ;HEADER WORD
MOVEM S1,.MSTYP(S2) ;SAVE IN MESSAGE
MOVE S1,.JREQI(R) ;GET REQUEUE FLAG WORD
IORM S1,REQ.FL(S2) ;SAVE IN REQUEUE FLAG WORD
MOVE S1,.JQITN(R) ;THE TASK NAME
MOVEM S1,REQ.IT(S2) ;STORE
HRLI S1,.JINFO(R) ;CHECKPOINT/REQUEUE INFORMATION
HRRI S1,REQ.IN(S2) ;INTO THE MESSAGE
BLT S1,REQ.IN+<EQCKSZ-1>(S2) ;MOVE ALL THE WORDS
PUSHJ P,SNDQSR ;SEND IT TO QUASAR
PUSHJ P,CLRSTR ;CLEAN UP STREAM
PJRST STEXIT ;EXIT FROM STREAM
SUBTTL CANCJB - CANCEL A JOB ROUTINE
CANCJB:
IFN FTUUOS,<
;NOT NEEDED ON THE -20 BECAUSE OF LGOUT JSYS
PUSHJ P,INMO.1 ;PUT AT MONITOR LEVEL
>;END FTUUOS
PUSHJ P,IDNOPR ;PUT OUT BAOPR LINE
MOVE S1,.JMLST(R) ;GET LIST NAME
$CALL L%PREM ;GET REMEMBERED ENTRY
MOVE T2,S2 ;GET MESSAGE ADDRESS
SETZB T3,T4 ;CLEAR T3 AND T4
SKIPN P1,IPC.DA+.OARGC(T2) ;ANY ARGUMENT LEFT
JRST CANC.3 ;NO..DEFAULT BOTH
MOVE S1,IPC.AR(S2) ;GET ARGUMNET POINTER
CANC.1: LOAD T1,ARG.HD(S1),AR.TYP ;GET ARGUMENT TYPE
CAIN T1,.CANTY ;TYPE FIELD
JRST CANC.4 ;YES..PROCESS TYPE
CAIN T1,.ORREA ;REASON FIELD
JRST CANC.5 ;YES..SETUP POINTER
CANC.2: LOAD T1,ARG.HD(S1),AR.LEN ;GET ARGUMENT LENGTH
ADD S1,T1 ;BUMP TO NEXT ARGUMENT
SOJG P1,CANC.1 ;PROCESS ARGUMENTS
CANC.3: SKIPN T3 ;ANY ERROR TYPE GIVEN
MOVX T3,.CNERR ;ERROR PROCESSING
SKIPN T4 ;ANY REASON
MOVEI T4,[ASCIZ/No Reason Given/]
HLLZ T1,CANCTB-1(T3) ;GET ERROR FLAGS
IORM T1,R ;PLACE IN R
HRRZ T3,CANCTB-1(T3) ;GET THE TEXT FOR ERROR TYPE
MOVEI S1,E.COPR ;CANCELED BY THE OPERATOR
MOVEM S1,.JERRO(R) ;SAVE CODE FOR END MESSAGE
$TEXT (L$OUT1,<Job Aborted By Operator with ^T/(T3)/>)
$TEXT (CANC.6,< REASON: ^T/(T4)/>)
PUSHJ P,L$CRLF ;PUT CR.LF AND SETUP FOR TIMESTAMP
TLO F,FL.SPL ;WANT TO ADD TEXT
MOVEI S1,CANTXT ;GET CANCEL TEXT ARGUMENTS
PUSHJ P,MSGOUT ;SEND THE MESSAGE
PUSHJ P,MESDEL ;DELETE THE ENTRY
TLZ R,RL.MIP ;CLEAR MESSAGE IN PROGRESS
TLNE R,RL.JIE ;CHECK IF JOB IN ERROR
JRST HONO.0 ;YES, JIE IS SET, RESUME WITH THE CTL FILE
TRO F,FR.UHE ;AN UNEXPECTED CONDITION
JRST CLOSJB ;GO KILL THE JOB
CANC.4: SKIPG T3,ARG.DA(S1) ;VALID ERROR TYPE
MOVEI T3,.CNERR ;ASSUME ERROR PROCESSING
CAILE T3,.CNPRG ;WITHIN RANGE
MOVEI T3,.CNERR ;ASSUME ERROR PROCESSING
JRST CANC.2 ;CHECK NEXT ARGUMENT
CANC.5: MOVEI T4,ARG.DA(S1) ;GET ADDRESS OF REASON
JRST CANC.2 ;PROCESS ARGUMENTS
CANTXT: ITEXT (<
^T/(T4)/ with ^T/(T3)/>)
CANC.6: PUSHJ P,L$OUT1## ;OUTPUT THE CHARACTER
CAIE CH,CHR.LF ;HIT A LINE FEED
$RETT ;RETURN
PUSHJ P,L$2TAB## ;SEND TWO TABS
PUSHJ P,L$2TAB## ;SEND TWO TABS
$RETT ;RETURN
;TABLE OF CANCEL OPTIONS AND FLAGS
CANCTB: XWD RL.JIE,[ASCIZ/Error-Processing/]
XWD 0,[ASCIZ/Noerror-Processing/]
XWD RL.FLS,[ASCIZ/Purge/]
SUBTTL STOPJB AND CONTJB ROUTINES
STOPJB: TLNE R,RL.STP ;STOPPED ALREADY?
JRST STOP.1 ;YES..GIVE ERROR MESSAGE
PUSHJ P,GJBSTS ;GET CURRENT STATUS
TLNN R,RL.LGI ;IS JOB LOGGING IN NOW
TLNE J,JL.UML ;At user level
JRST STOP.0 ;BYPASS CHECK
TRO F,FR.SCC ;SENT ^C TO STOP JOB
PUSHJ P,INMO.1 ;PUT AT MONITOR LEVEL
STOP.0: PUSHJ P,IDNOPR ;IDENTIFY OPERATOR LINE
PUSHJ P,JOBOUT ;SEND JOBMSG
$TEXT (L$OUT1,<Job Stopped By Operator>)
SETOM .JRTIM(R) ;MARK TIME STAMP NEEDED
JUSTCL: TLO R,RL.STP ;STREAM STOPPED
TLZ R,RL.MIP ;CLEAR MESSAGE IN PROGRESS
JRST QTS ;WAIT FOR CONTINUE
STOP.1: PUSHJ P,JOBOUT ;OUTPUT THE MESSAGE DATA
JRST JUSTCL ;SET FLAGS AND EXIT
;ROUTINE TO SEND JOBMSG TO OPERATOR
JOBOUT: MOVE S1,.JMLST(R) ;GET LIST NUMBER
$CALL L%PREM ;GET REMEMBERED ENTRY
MOVE T2,S2 ;PLACE ADDRESS IN T2
PUSHJ P,MSGOUT ;SEND THE MESSAGE
PJRST MESDEL ;DELETE THE ENTRY AND RETURN
SUBTTL CONTJB - CONTINUE JOB BY OPERATOR
CONTJB: TLZN R,RL.STP ;STOPPED ..CLEAR
JRST CONT.1 ;MUST ACK MESSAGE
;IN CASE IN OPER WAIT
IDENT [ASCIZ / BAOPR Job Continued By Operator
/]
SETOM .JRTIM(R) ;SET TIME-STAMP NEEDED
TRNN F,FR.SCC ;SENT ^C TO JOB
JRST CONT.1 ;NO..SKIP CONTINUE TO JOB
MOVEI CH,MONCHR ;MONITOR CHARACTER TO LOG
PUSHJ P,L$PLOG## ;OUTPUT THE CHARACTER
$TEXT (LOGPTY,<CONTINUE>) ;SEND CONTINUE TO JOB
SETOM .JRTIM(R) ;NEED A TIME STAMP
PUSHJ P,PTYSND ;SEND THE BUFFER
CONT.1: TLZ R,RL.MIP ;CLEAR MESSAGE IN PROGRESS
PUSHJ P,JOBOUT ;SEND JOBMSG
JRST QTS ;CONTEXT SWITCH AND SCHEDULE
;QTS IS CALLED TO EXIT FROM STOP AND CONTINUE IN CASE JOB
;IS STILL IN WAITING FOR THE OPERATOR
SUBTTL CANUSR - CANCEL FROMA USER REQUEST
;HERE TO PROCESS USER REQUEST TO KILL THE JOB
CANUSR:
IFN FTUUOS,<
;NOT NEEDED ON THE -20 BECAUSE OF LGOUT JSYS
PUSHJ P,INMO.1 ;PUT AT MONITOR LEVEL
>;END FTUUOS
MOVE S1,.JMLST(R) ;GET THE MESSAGE LIST
$CALL L%PREM ;GET PREVIOUS REMEMBERED ENTRY
MOVEI T2,IPC.DA(S2) ;GET ADDRESS OF MESSAGE
PUSHJ P,L$BLNK## ;FORCE OUT BLANK LINE
IDENT [ASCIZ/ BAUSR Job Canceled by User /]
$TEXT (L$OUT1,<^P/ABO.ID(T2)/^A>) ;KILLERS PPN
MOVEI S1,E.CUSR ;CANCELED BY THE USER
MOVEM S1,.JERRO(R) ;SAVE FOR END MESSAGE
MOVE S1,ABO.ID(T2) ;GET PPN OR USER NUMBER
MOVEM S1,.JARG1(R) ;SAVE ARGUMENT ONE FOR MESSAGE
PUSHJ P,L$BLNK## ;ISOLATE THE LINE
TLO R,RL.FCI ;SET A FLAG FOR CLOSJB
TLZ R,RL.JIE ;AVOID THE CLOSE/DUMP PAIR
TRO F,FR.UHE ;AN UNEXPECTED CONDITION
PUSHJ P,MESDEL ;DELETE THE MESSAGE
JRST CLOSJB ;CANCEL IT NOW
SUBTTL ATOKJB - LOGOUT FOR THE -10
IFN FTUUOS,<
ATOKJB:: PUSHJ P,GJBSTS ;GET CURRENT STATUS
TLNN J,JL.ULI ;IS JOB LOGGED IN
POPJ P, ;NO..RETURN
TLZ F,FL.SIL ;CLEAR SILENCE IF WE ARE GOING TO KJOB THIS JOB
PUSHJ P,PREKJB ;SET UP FOR AUTO LOGOUT
PUSHJ P,INMONM ;MAKE SURE THE JOBS IN MONITOR MODE
SKIPE .JRTIM(R) ;NEED A TIME STAMP
PUSHJ P,L$LPER## ;YES, OUTPUT (SOMETHING), THAT WILL STAMP IT
KJOB.0: TLNN J,JL.ULI ;IS THE JOB THERE NOW
POPJ P, ;NO, THAT WAS EASY
TLO R,RL.KJB ;MARK ON THE WAY OUT
MOVEI S1,"""" ;GET A QUOTE
DPB S1,LDOPCH ;SET AS DIALOGUE MODE SIGNAL
$TEXT (LOGPTY,<^T/KJSTR/>) ;SEND KJOB STRING
KJOB.1: SETOM .JRTIM(R) ;FORCE TIME STAMP TO ALIGN
PUSHJ P,PTYSND ;SEND TO THE PTY
KJOB.W: PUSHJ P,IODISP ;WAIT FOR RETURN TO MONITOR MODE
TLNN J,JL.ULI ;DID THE JOB GO AWAY
POPJ P, ;YES..RETURN
KJOB.2: TLZ R,RL.DIA ;NO, CLEAR OUTPUT TO THE OPERATOR
PUSHJ P,INMO.1 ;GET BACK TO MONITOR MODE
$WTOR (<BATCH Logout Error>,<^I/JIBTXT/^I/LGOTXT/>,.JQOBJ(R),.JQITN(R))
PUSHJ P,OPRRES ;WAIT FOR THE RESPONSE
JRST KJOB.0 ;SEE IF JOB IS STILL THERE (OR TRY AGAIN)
>;END FTUUOS
LGOTXT: ITEXT (<Unable to LOGOUT Batch Job # ^D/.JJOBN(R)/
Please Kill the Job and then
RESPOND (message number) GO>)
SUBTTL ATOKJB - LOGOUT FOR THE -20
IFN FTJSYS,<
ATOKJB:: PUSHJ P,GJBSTS ;GET CURRENT STATUS
TLNN J,JL.ULI ;IS USER LOGGED IN
POPJ P, ;NO..JUST RETURN
TLO R,RL.KJB ;SET FOR KJOB
TLZ F,FL.SIL ;CLEAR THE SILENCE
PUSHJ P,L$CRLF ;GET TO NEW LINE
MOVE S1,.JJOBN(R) ;GET THE JOB NUMBER
LGOUT ;LOG OUT THE JOB
JFCL ;IGNORE ERRORS
PUSHJ P,INPPTY ;GET PTY OUTPUT FIRST
JUMPF KJOB.0 ;NO INPUT BYPASS JOB CHECK
PUSHJ P,GJBSTS ;GET CURRENT STATUS
TLNN J,JL.ULI ;IS USER LOGGED IN
POPJ P, ;NO..JUST RETURN
KJOB.0: PUSHJ P,WAITOU ;WAIT FOR OUTPUT
TLNN J,JL.ULI ;USER STILL LOGGED IN
POPJ P, ;NO..RETURN
$WTOR (<BATCH Logout Error>,<^I/JIBTXT/^I/LGOTXT/>,.JQOBJ(R),.JQITN(R))
PUSHJ P,OPRRES ;WAIT FOR THE RESPONSE
JRST KJOB.0 ;SEE IF JOB IS STILL THERE (OR TRY AGAIN)
>;END FTJSYS
SUBTTL IOWAIT - Routine for Output/Input Waiting
IOW.01: PUSHJ P,QTS ;WAIT FOR NEXT WAKE UP
IOW.02:
IOWAIT: PUSHJ P,GJBSTS ;GET THE STATUS OF THE JOB
IOW.03: TLNN J,JL.UDI!JL.UOA ;JOB WANT INPUT OR HAS OUTPUT
JRST IOW.01 ;NO, GO BACK AND WAIT
TLNN J,JL.UOA ;WAS IT OUTPUT AVAILABLE
JRST [TLNE F,FL.SIL ;JOB WANTS INPUT, IN SILENCE MODE
SETOM .JRTIM(R) ;YES, KEEP OUTPUT ALIGNED
POPJ P,] ;RETURN TO THE CALLER
PUSHJ P,INPPTY ;INPUT THE BUFFER
READPY: PUSHJ P,GETPTY ;GET CHARACTER FROM PTY
JUMPT READ.0 ;PROCESS THE INPUT
IFN FTJSYS,<
TLZ J,JL.UOA ;CLEAR OUTPUT AVAILABLE FLAG
MOVSI S1,JL.UDI ;GET INPUT FLAG
TLNE J,JL.UDI ;IS IT SET?
IORM S1,.JFLAG(R) ;HOLD FOR INTERRUPT?
>;END FTJSYS
JRST IOWAIT ;CHECK STATUS AGAIN
READ.0: AOSE .JREOL(R) ;HAS A LINE TERMINATOR BEEN SENT
SKIPE .JRTIM(R) ;OR IS THIS THE FIRST CHARACTER OF A LINE
PUSHJ P,ERRCHK ;YES, CHECK FOR ERROR INDICATORS
TLNE R,RL.JIE ;DID ERRCHK FIND AN ERROR
TLZ F,FL.SIL ;YES, CLEAR SILENCE FOR THIS JOB
TLNE R,RL.QTS!RL.DIA ;SHOULD THE OPERATOR SEE THIS CHARACTER
JRST [MOVE S1,CH ;GET CHARACTER IN S1
PUSHJ P,OUTDAT ;OUTPUT CHARACTER
JRST .+1] ;CONTINUE IN LINE
TLNE F,FL.SIL ;IS THE JOB OUTPUT TO BE SUPPRESSED
JRST READ.2 ;YES, DON'T INCLUDE IN THE LOG FILE
PUSHJ P,L$PLOG## ;ECHO THE CHARACTER
READ.1: SKIPN .JRTIM(R) ;END OF LINE SENT?
JRST READPY ;CONTINUE READING
TLZE R,RL.QTS ;DOING QUOTES
PUSHJ P,OUTEXT ;END WTO
JRST READPY ;CONTINUE READING
READ.2: SETZM .JRTIM(R) ;CLEAR TIME STAMP NEEDED
CAIG CH,CHR.FF ;DO VERTICAL PAPER MOTION CHECK HERE
CAIGE CH,CHR.LF ;SO ERRCHK CAN BE CALLED EVEN IF SILENCE IS SET
JRST READ.1 ;NOT ONE OF LF,VT,FF RESUME NORMAL PATH
SETOM .JRTIM(R) ;SET TIME STAMP TO RECOGNIZE COLUMN 1
JRST READ.1 ;RESUME
SUBTTL WAITOU - WAIT FOR OUTPUT BEFORE PROCEEDING
;THIS ROUTINE WILL WAIT FOR OUTPUT BEFORE CONTINUING
;INORDER TO GIVE JOB A CHANCE TO GET SCHEDULED ON -20
IFN FTJSYS,<
WAITOU: MOVNI S1,OUTCNT ;Count of 8
MOVEM S1,.JWAIT(R) ;Save it in count word
WAIT.1: PUSH P,.JICNT(R) ;SAVE OUTPUT COUNTER
PUSHJ P,QTS ;OUTPUT RETURNED
PUSHJ P,IODISP ;WAIT FOR I/O, RETURN FOR MORE INPUT
POP P,S1 ;PLACE POINTER IN S1
CAMN S1,.JICNT(R) ;ANY OUTPUT HAPPEN?
JRST [PUSHJ P,WAIT.4 ;No, see if ok to continue
JUMPF .+1 ;No longer under batcon's control
JRST WAIT.1] ;Waiting for output, go try again
PUSHJ P,GJBSTS ;Yes, get latest status
$RETT ;Return true
WAIT.4: SKIPL .JJOBS+.JIJNO(R) ;Do we have a job number?
JRST [SKIPL .JJOBS+.JIBAT(R);Yes, is it under batch?
$RETF ;No
$RETT] ;Yes, try again.
AOSE .JWAIT(R) ;Times up?
$RETT ;No, try again
PUSHJ P,L$LSTP## ;Output the time stamp
$TEXT (L$OUT1,<%BATCON did not receive logout acknowledgement.>)
$RETF ;Yes
>;END FTJSYS
;HERE TO CHECK PTY OUTPUT FOR ERROR INDICATORS/QUOTES/DIALOGUE MODE
ERRCHK: CAIE CH,"?" ;STANDARD ERROR CHARACTER
JRST ERRC.2 ;NO, LOOK FOR ADDITIONAL CHARACTER
TLNE R,RL.LGI ;HERE DURING LOGIN SEQUENCE
JRST ERRLGI ;YES, GET LOGIN ERROR CODE
PUSHJ P,GJTIML ;GET SUBJOBS REMAINING TIME LIMIT
JUMPN S1,ERRC.1 ;JUMP IF NOT TIME LIMIT EXCEEDED
TLOA F,FL.TLE ;SET THE TIME LIMIT FLAG
ERRC.1: TLNN F,FL.NER ;IGNORE ERRORS ?
TLO R,RL.JIE ;NOPE (OR TIME LIMIT EXCEEDED), SET ERROR IN JOB
JRST ERRC.3 ;AVOID DUPLICATE WORK
ERRC.2: TLNE F,FL.NER ;IGNORE ERRORS ?
JRST ERRC.3 ;YES, LOOK FOR QUOTES, OPERATOR
LDB S1,LDERCH ;LOAD THE ERROR CHARACTER INTO S1
CAIN CH,(S1) ;IS THIS THE ONE
ERRC.4: TLO R,RL.JIE ;YES, SET ERROR FLAG
ERRC.3: LDB T1,LDOPCH ;GET THE DIALOGUE MODE SIGNAL
CAIN CH,(T1) ;IS THIS IT
TLO R,RL.DIA ;YES, SET JOB IN DIALOGUE MODE
CAIN CH,"""" ;IS IT A COMMENT TO THE OPERATOR
TLO R,RL.QTS ;YES, SET QUOTES MODE
SKIPN .JWTOF(R) ;WTO FLAG SET..IN MIDDLE OF WTO
TLNN R,RL.QTS!RL.DIA ;NEED TO IDENTIFY THE OUTPUT TO THE OPERATOR
POPJ P, ;NO, RETURN
PJRST STAWTO ;YES,,TYPE OUT SUBJOB INFORMATION NOW
;HERE TO GET THE ERROR CODE FROM LOGIN IN THE FORM ?(n)LGNxxx message
ERRLGI: PUSHJ P,L$PLOG## ;SEND THE ?
SETZ S1, ;EVENTUAL ERROR CODE
IFN FTJSYS,<
TRZN F,FR.JLI ;WAS JOB BEING SETUP FOR LOGIN
JRST ERRL.2 ;NO..JUST SET THE OTHER BITS
;*** TEMPORARY FIX FOR NOW
; MOVSI S1,JL.UDI ;GET USER DESIRES INPUT
; IORM S1,.JFLAG(R) ;SAVE AS HUNGRY TO FAKE FOR NOW
>;END FTJSYS
IFN FTUUOS,<
PUSHJ P,NXTPTY ;GET THE NEXT CHARACTER
CAIE CH,"(" ;ERROR CODE FOLLOWS?
JRST ERRSTO ;NO, STORE 0 AND RETURN
ERRL.1: PUSHJ P,L$PLOG## ;OUTPUT THE (
PUSHJ P,NXTPTY ;GET THE CODE NUMBER
MOVEI S2,-"0"(CH) ;CONVERT TO BINARY
CAILE S2,^D9 ;WAS IT A DIGIT
JRST ERRSTO ;NO, STORE ERROR SO FAR AND RETURN
IMULI S1,^D10 ;POSITION OTHER DIGITS
ADDI S1,(S2) ;INCLUDE THIS DIGIT
JRST ERRL.1 ;ECHO THIS DIGIT AND GET MORE
ERRSTO: CAIN S1,1 ;IS IT LOGIN ERROR # 1
POPJ P, ;YES, THATS A WARNING, EXIT NOW
> ;END OF IFN FTUUOS
ERRL.2: TLO R,RL.JIE ;INDICATE JOB IN ERROR
HRRM S1,.JERCD(R) ;STORE THE ERROR CODE
POPJ P, ;RETURN TO INLINE CODE
SUBTTL Job Processor - Error Analysis, Processing, and Reporting
;HERE TO INTERROGATE THE LOGIN FAILURE
ANALYZ:
IFN FTUUOS,<
TLNE R,RL.JNA ;DID A JOB NUMBER EVER GET ASSIGNED
JRST ANLY.1 ;YES, LOOK AT THE ERROR CODE
ANLY.0: TLNE J,JL.ULI ;USER LOGGED IN NOW
POPJ P, ;YES, THAT'S INCONSISTENT
JRST ANLY.4 ;OUR ERROR SEND SETUP RETRY
;GO REQUEUE THIS JOB
ANLY.1: HRRZ S1,.JERCD(R) ;GET THE ERROR CODE FROM LOGIN
CAIE S1,4 ;IS THE SYSTEM AVAILABLE
JRST ANLY.2 ;YES, LOOK FURTHUR
TLNE J,JL.ULI ;IS THE USER LOGGED IN NOW
POPJ P, ;THAT TOO IS INCONSISTENT
JRST ANLY.4 ;SETUP RETRY,,LATER
ANLY.2: CAIN S1,5 ;LOGMAX EXCEEDED
JRST ANLY.0 ;YES, TREAT AS "JOB CAPACITY EXCEEDED"
CAIN S1,2 ;IS IT JOB SEMI-FATAL
JRST ANLY.4 ;YES, REQUEUE THE JOB
PUSHJ P,SNDUPC ;SEND ^C TO KILL JOB SLOT
> ;END OF IFN FTUUOS
IFN FTJSYS,<
TLNE J,JL.ULI ;USER LOGGED IN NOW
POPJ P, ;YES..JUST RETURN
MOVX S1,EQ.IAS ;GET INVALID ACCOUNT FLAG
TDNN S1,.JQJBB+JIB.SQ(R) ;CHECK IF SET
PJRST ANLY.4 ;YES..ASSUME NO JOB SLOTS AND REQUEUE
>;END FTJSYS
ANLY3A: SETO S1, ;Not from CRJOB error so make -1
ANLY.3: STKVAR<CODVAL> ;Make room to save S1
MOVEM S1,CODVAL ;Save S1 to check for error code later
PUSHJ P,L$OUTP## ;OUTPUT PAGE OF DATA
JUMPF LOGEXT ;FAIL..EXIT AND FLUSH
TLNE J,JL.ULI ;ALL OTHERS KLUNK THE JOB, IS IT LOGGED IN NOW
JRST CLOSJB ;YES, LEAVE JIE SET AND KILL THE JOB
PUSHJ P,L$BLNK## ;LOG A BLANK LINE
MOVE S1,CODVAL ;S1 may contain an error code from CRJOB
JUMPL S1,[
;**;[6003]At ANLY.3:+9L change 1 line JYCW Oct-18-88
$QWTO(<Batch Login Error>,<BATCH Login Failed .. Job Canceled>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>) ;[6003]Login failure not due to CRJOB failing
JRST .+2 ] ;Place error message in the log file
;**;[6003]At ANLY.3:+10L change 1 line JYCW Oct-18-88
$QWTO(<Batch Login Error>,<BATCH Login Failed .. Job Canceled,
TOPS-20 Error - ^E/S1/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>) ;[6003]CRJOB failed
IDENT [ ASCIZ / BTNJBC Job has been Canceled -- LOGIN FAILURE
/]
MOVX S1,E.JLOF ;JOB LOGIN FAILURE
MOVEM S1,.JERRO(R) ;SAVE THE ERROR CODE
TLO F,FL.ERR ;MARK THE ERROR CONDITION
PUSHJ P,L$BLK1 ;CR,LF NO TIME-STAMP
JRST CLOS.1 ;AND DISMISS THE JOB
ANLY.4: PUSHJ P,L$BLNK## ;OUTPUT A BLANK LINE
IDENT [ASCIZ / BTNJRQ JOB REQUEUED
/]
MOVEI S1,E.NJOB ;NO JOBS AVAILABLE
MOVEM S1,.JERRO(R) ;SAVE THE ERROR CODE
PUSHJ P,L$BLK1 ;CR,LF NO TIME-STAMP
PUSHJ P,REQMSG ;PREPARE TO CLOSE JOB,,FOR REQUEUE
PUSHJ P,CLRSTR ;CLEAN UP THE STREAM
MOVX T1,%RSUNA ;SETUP UNAVAILABLE
MOVEI T2,E.NJOB ;NO JOBS AVAILABLE
MOVX T3,%SFULL ;SYSTEM FULL..NO JOB SLOTS
PUSHJ P,SETUPR ;SEND SETUP..RETRY
JRST STEXIT ;EXIT FROM STREAM
; SUBROUTINE TO CLOSE OUT JOB BEFORE REQUEUE OF JOB TO QUASAR
REQMSG: PUSHJ P,REMCTL ;REMOVE AND CTL ASSIGNMENTS
TLNE J,JL.ULI ;IS THE JOB LOGGED IN NOW
PUSHJ P,ATOKJB ;KILL THE JOB
TRNN F,FR.LFO ;WAS LOG FILE OPEN
POPJ P, ;NO LOG FILE..JUST RETURN
PUSHJ P,L$OUTP## ;OUTPUT PAGE OF DATA
$CALL ZFBBK0 ;Zero out word .FBBK0 of log file
MOVE S1,.JLJFN(R) ;GET LOG FILE IFN
$CALL F%REL ;RELEASE THE IFN
SKIPT ;O.K..SEND MESSAGE AND RETURN
PJRST CLOS.E ;NOTE ERROR AND CONTINUE
TRZ F,FR.LFO ;CLEAR LOG FILE OPEN
REQM.1: PJRST CLOS.M ;SEND END MESSAGE AND RETURN
SUBTTL Job Processor - Random Little Routines
;SUBROUTINE TO GET JOB STATUS AND SET BITS AS NEEDED
GJBSTS: PUSHJ P,JOBSTS ;GET JOB STATUS FOR JOB
MOVEM J,.JSTAT(R) ;SAVE FOR BATOPR IF IT WANTS IT
SKIPG .JJOBN(R) ;IS THERE A JOB NUMBER STORED
HRREM J,.JJOBN(R) ;NO, SAVE THIS ONE FOR RELEASE OPERATION
TLNE J,JL.UJA ;USER JOB NUMBER ASSIGNED
TLO R,RL.JNA ;YES, REMEMBER IT GOT AT LEAST THAT FAR
POPJ P, ;RETURN TO CALLER
;SUBROUTINE TO SEND 'SET TIME N' TO THE JOB
SETTIM: SKIPE .JRTIM(R) ;NEED TO ALIGN THE OUTPUT
PUSHJ P,L$LPER## ;YES, OUTPUT A DOT (OR SOMETHING)
$TEXT (LOGPTY,<^T/TIMSTR/^D/T3,RHMASK/^A>) ;Send command
PUSHJ P,SNDCLF ;SEND CR-LF AND FORCE BUFFER
JRST IODISP ;WAIT FOR NEXT INPUT BEFORE RETURNING
;SUBROUTINE TO ZERO OUT .FBBK0 WORD OF LOG FILE FDB
;**;[4304]At ZFBBK0:+0L replace 2 lines with 4 lines JCR 7/18/86
ZFBBK0: MOVE S1,.JLJFN(R) ;[4304]Get the log file's IFN
MOVEI S2,FI.CHN ;[4304]Get the log file's JFN
$CALL F%INFO ;[4304]Return the JFN in S1
HRLI S1,.FBBK0 ;[4304]Pick up the word to be changed
MOVE S2,[-1] ;All the bits will be changed
MOVEI T1,0 ;To zero
CHFDB ;Change the word
ERJMP .+1 ;Ignore any errors
$RET ;And return
SUBTTL SETLOC - SET JOB LOCATION FOR THE -20
;THIS ROUTINE WILL SET THE JOBS LOCATION IF IT IS NOT THE CENTRAL SITE
IFN FTJSYS,<
SETLOC: MOVE S1,.JQLOC(R) ;GET THE OUTPUT NODE
CAMN S1,MYNODE ;IS IT SAME AS MINE?
POPJ P, ;YES..JUST RETURN
SETZB T3,T4 ;CLEAR T3 AND T4
MOVE T1,[POINT 6,.JQLOC(R)] ;GET THE LOCATION
MOVE T2,[POINT 7,T3] ;PLACE TO STORE STRING
MOVEI P1,6 ;MAXIMUM LENGTH
SETL.1: ILDB S2,T1 ;GET A BYTE
JUMPE S2,SETL.2 ;O.K. SET THE LOCATION
ADDI S2,40 ;CONVERT TO ASCII CHARACTER
IDPB S2,T2 ;SAVE THE BYTE
SOJG P1,SETL.1 ;CHECK NUMBER OF CHARACTERS
SETL.2: MOVE S1,.JJOBN(R) ;GET THE JOB NUMBER
MOVX S2,.SJLLO ;SETUP LOCATION
HRROI T1,T3 ;GET STRING
SETJB ;SET IT UP
ERJMP .+1 ;IGNORE ERROR FOR NOW
POPJ P, ;RETURN
>;END FTJSYS
;SUBROUTINE TO PLACE A JOB IN OPERATOR WAIT
OPRRES: TLO R,RL.OPR ;MARK WAITING FOR THE OPERATOR
MOVX T1,%OREWT ;STATUS CODE TO QUASAR
PUSHJ P,QSRUPD ;UPDATE STATUS TO QUASAR
PUSHJ P,QTS ;WAIT FOR HIS(HER) RESPONSE
MOVX T1,%RESET ;RESET STATUS TO QUASAR
PUSHJ P,QSRUPD ;SEND IT TO QUASAR
JRST GJBSTS ;GET THE STATUS AND RETURN
;SUBROUTINE TO COPY A COMMENT LINE TO THE LOG FILE
CPYCMT: TLNE F,FL.SIL ;IS THE OUTPUT TO BE SUPPRESED
JRST CMNT.3 ;YES, DONT OUTPUT COMMENT LINES EITHER
CAIE CH,CHR.FF ;SEE IF THE FIRST CHARACTER IS FF OR VT
CAIN CH,CHR.VT ;IF SO, THEN A ONE CHARACTER COMMENT LINE
JRST [SETZM .JRTIM(R) ;CLEAR TIME STAMP NEEDED
JRST L$PLOG##] ;OUTPUT FORM FEED OR VERTICAL TAB AND RETURN
CMNT.0: PUSH P,CH ;SAVE FIRST CHARACTER
PUSHJ P,L$CMNT## ;PREPARE LOG FILE FOR A COMMENT
POP P,CH
CMNT.1: SKIPE .JRTIM(R) ;DID ONE OF CHARACTER MOVE PAPER
JRST CMNT.0 ;YES, START A FRESH COMMENT LINE
PUSHJ P,L$PLOG## ;DEPOSIT INTO THE LOG FILE
TLNN F,FL.PLS ;DOING A PLEASE COMMAND
JRST CMNT.2 ;NO, AVOID THE FOLLOWING
CAIE CH,CHR.A1 ;IS IT AN ALTMODE
JRST CMNT.5 ;NO, JUST OUTPUT THIS CHARACTER
TLZ F,FL.PLS ;YES, CLEAR PLEASE COMMAND
MOVEI CH,"$" ;ECHO THE ALTMODE AS A $
CMNT.5: MOVE S1,CH ;PUT CHARACTER IN S1
PUSHJ P,OUTDAT ;PLACE CHARACTER IN MESSAGE
CMNT.2: CAIN CH,CHR.LF ;END OF A LINE YET
POPJ P, ;YES, RETURN TO READING OF CTL FILE
PUSHJ P,GETCTL ;GET ANOTHER CHARACTER
JRST CMNT.1 ;CONTINUE COPYING
CMNT.3: CAIE CH,CHR.FF ;DOES THE LINE START WITH A FORM FEED
CAIN CH,CHR.VT ;OR A VERTICAL TAB
POPJ P, ;YES, THAT IS A ONE CHARACTER COMMENT LINE
CMNT.4: CAIN CH,CHR.LF ;END OF THE COMMENT LINE YET
POPJ P, ;YES, RETURN TO CALLER
PUSHJ P,GETCTL ;GET ANOTHER CHARACTER TO IGNORE
JRST CMNT.4 ;ANY SEE IF DONE YET
;SUBROUTINE TO PUT A JOB INTO MONITOR MODE
INMONM:
IFN FTJSYS,<
PUSHJ P,GJBSTS ;GET CURRENT STATUS
>;END FTJSYS
TLNE J,JL.UML ;IS IT ALREADY THERE
POPJ P, ;YES, RETURN
INMO.1: TLNN J,JL.ULI ;IS THE USER STILL LOGGED IN
POPJ P, ;NO..RETURN
TLNN J,JL.UDI ;NO, IS IT IN INPUT WAIT
INMO.2: PUSHJ P,SNDUPC ;NO, SEND 2 CONTROL C'S
PUSHJ P,SNDUPC
PUSHJ P,IODISP ;WAIT FOR RESPONSE
IFN FTJSYS,<
PUSHJ P,GJBSTS ;GET STATUS
>;END FTJSYS
TLNE J,JL.UML ;IS IT NOW AT MONITOR LEVEL
POPJ P, ;YES, RETURN
; PUSHJ P,SNDUPC ;JUST TO MAKE SURE
AOS INMONE ;BUMP MONITOR MODE ERROR COUNT
PUSHJ P,IODISP ;CONTEXT SWITCH
IFN FTJSYS,<
PUSHJ P,GJBSTS ;GET STATUS
>;END FTJSYS
TLNE J,JL.UML ;IS IT NOW AT MONITOR LEVEL
POPJ P, ;YES, RETURN
TRZE F,FR.TBL ;TROUBLE GETTING TO MONITOR LEVEL
JRST INMO.3 ;YES..BEEN HERE..CLEANUP
TRO F,FR.TBL ;SET IN TROUBLE FLAG
PUSHJ P,QTS ;STALL FOR TIME
JRST INMO.2 ;TRY AGAIN
;**;[6003]At INMO.3:+0L change 1 line JYCW Oct-18-88
INMO.3: $QWTO(<Job Can't Get to Monitor Level>,<^I/JIBTXT/Batch Job ^D/.JJOBN(R)/ May Be Hung
Retry Failed J = ^O/J/>,.JQOBJ(R)) ;[6003]
TLNN J,JL.ULI ;IS THE JOB STILL THERE
JRST CLOS.1 ;NO, DISMISS THE JOB
JRST INMONM ;YES, TRY TO DO IT AGAIN
;SUBROUTINE TO SKIP BLANKS(TABS) IN THE CTL FILE
SKPBL1: PUSHJ P,GETCTL ;ENTER HERE IF CH IS NOT SET AT THE FIRST
SKPBLK: CAIE CH," " ;A BLANK
CAIN CH,CHR.HT ;OR A TAB
JRST SKPBL1 ;SKIP OVER THEM
POPJ P, ;RETURN WITH THE FIRST NON-BLANK CHARACTER
SUBTTL CHANNEL RELEASE ROUTINES FOR PTYS
;HERE TO RELEASE THE A CHANNEL AND ASSIGNMENT
IFN FTUUOS,<
RELREL: MOVE S1,[RELEASE 0,0] ;RELEASE THE CHANNEL
IOR S1,.JPCHN(R) ;PUT CHANNEL NUMBER IN PLACE
XCT S1 ;EXECUTE RELEASE UUO
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
RELREL: MOVE S1,.JPCHN(R) ;PTY JFN
CLOSF ;CLOSE THE PTY AND RELEASE JFN
JRST ERRPRT ;PTY CLOSE ERROR
POPJ P, ;RETURN
> ;END OF IFN FTJSYS
IFN FTUUOS,<
SETSFD: SKIPN 1(T4) ;ANY SFD SPECIFICATION
JRST [MOVE T4,(T4) ;NO SET D TO PPN
TLNN T4,-1 ;IS PPN = XWD 0,#
HRLOI T4,377777 ;YES...SOMEONE MADE A BAD QUEUE FILE
POPJ P,] ;AND RETURN
HRLI T4,(T4) ;SOURCE OF THE PATH
HRRI T4,SFDPAT+2 ;TO THE PATH BLOCK
BLT T4,SFDPAT+7 ;MOVE THE WHOLE SPEC
MOVEI T4,SFDPAT ;POINT TO IT FOR UUOS
POPJ P, ;RETURN
>;END FTUUOS
GETCTL: TRNN F,FR.CTO ;IS CTL FILE OPEN
PUSHJ P,FNDCTL ;NO..OPEN IT
MOVE S1,.JCJFN(R) ;GET CTL JFN
$CALL F%IBYT ;GET A BYTE FROM FILE
JUMPF GETCT1 ;END OF CONTROL FILE..EXIT
JUMPE S2,GETCTL ;IGNORE NULLS
TLZ F,FL.XCC ; CLEAR XMIT CTL CHR FLAG
;**;[4301]Insert 1 line at GETCTL:+6L JCR 10/15/85
TLZ F,FL.ZXC ;[4301]CLEAR ZEROED FL.XCC BIT
MOVE CH,S2 ;PUT IN CH FOR COMPATIBILITY
JRST GETCT4 ;CHECK OTHER CONDITIONS
;**;[4303]At GETCT1:+0L replace 1 line with 4 lines JCR 6/11/86
GETCT1: TRZN F,FR.RER ;[4303]Looking for a %RERR:: ?
JRST CLOSJB ;[4303]No, end of CTL..end job
SETO CH, ;[4303]Indicate failed to find %RERR::
POPJ P, ;[4303]And return
;HERE TO CONVERT UPARROWS TO CONTROL CHARACTERS (MAYBE)
GETCT4: TLZN F,FL.UPA ;HERE THE SECOND TIME FOR THIS CALL
CAIE CH,"^" ;NO, IS THIS AN UPARROW
POPJ P, ;RETURN WITH THIS CHARACTER
TLO F,FL.UPA ;MARK RECURSIVE CALL
PUSHJ P,GETCTL ;GET THE NEXT AFTER THE UPARROW
CAIN CH,"^" ;TWO IN A ROW
POPJ P, ;YES, RETURN ONLY ONE
CAIG CH,172 ;CONVERT TO UPPER CASE
CAIGE CH,141
SKIPA ;NOT A LOWER CASE LETTER
SUBI CH," " ;MAKE UPPER CASE OUT OF IT
CAIG CH,"_" ;CAN THIS BE A CONTROL CHARACTER?
CAIGE CH,"@" ;... VALID ARE ^@ TO ^_
JRST GETCT5 ;NO, MUST BACK SOME STUFF UP
SUBI CH,"@" ;MAKE A CONTROL CHARACTER
TLO F,FL.XCC ;TRANSMIT THIS CONTROL CHARACTER
POPJ P, ;RETURN WITH IT
GETCT5: PUSHJ P,DECRBP ;BACK UP OVER THE OTHER CHARACTER
MOVEI CH,"^" ;GET THE ORIGINAL UPARROW
POPJ P, ;AND RETURN WITH IT
SUBTTL CONTROL FILE MANIPULATION ROUTINES
;SUBROUTINE TO PERFORM POST JOB DISPOSAL OF THE CTL FILE
CTLDIS: TRNN F,FR.CTO ;CONTROL FILE OPEN??
POPJ P, ;NO,,FORGET THIS
LOAD S1,.JQCFP(R),FP.DEL ;GET DELETE CTL FLAG
JUMPE S1,CPOPJ ;0..DO NOT DELETE..EXIT
MOVE S1,.JCJFN(R) ;GET JFN FOR CTL
$CALL F%DREL ;RELEASE JFN AND DELETE FILE
TRZ F,FR.CTO ;CLEAR CONTROL FILE OPEN FLAG
POPJ P, ;RETURN
;HERE TO REMOVE ANY OLD CTL FILE ASSIGNMENTS AT DISMISSAL OF THE JOB
REMCTL: TRNN F,FR.CTO ;CHECK IF CTL STILL OPEN
POPJ P, ;NO ,,,EXIT
MOVE S1,.JCJFN(R) ;GET THE FILE JFN
$CALL F%REL ;CLOSE AND RELEASE CTL FILE
TRZ F,FR.CTO ;CLEAR CONTROL FILE OPEN FLAG
POPJ P, ;RETURN
SUBTTL TOPS-20 POSITIONING ROUTINES
SAVPOS: TRNN F,FR.CTO ;CHECK IF FILE OPEN
JRST SAVP.1 ;NO SPECIAL CASE
MOVE S1,.JCJFN(R) ;GET CTL JFN
$CALL F%CHKP ;TAKE CHECKPOINT
MOVEM S1,.JCUSI(R) ;SAVE RELATIVE POSITION
POPJ P, ;RETURN TO PROCESSING
SAVP.1: TLO F,FL.UPA ;GET EXACTLY ONE CHARACTER
PUSHJ P,FNDCTL ;OPEN FILE
SETZM .JCUSI(R) ;POSITION TO BEGINNING
POPJ P, ;RETURN TO MAINLINE
REPOSI: MOVE S1,.JCJFN(R) ;GET JFN FOR CTL
MOVE S2,.JCUSI(R) ;GET RELATIVE POSITION
$CALL F%POS ;POSITION FILE TO PROPER PLACE
POPJ P, ;RETURN TO MAINLINE
DECRBP: MOVE S1,.JCJFN(R) ;GET CTL JFN
$CALL F%CHKP ;CHECKPOINT THIS POSITION
MOVE S2,S1 ;RELATIVE POSITION INTO S2
MOVE S1,.JCJFN(R) ;GET CTL JFN
SUBI S2,1 ;BACK UP 1 PLACE
$CALL F%POS ;POSITION FILE TO PROPER PLACE
POPJ P, ;RETURN
SUBTTL FNDCTL - OPEN CONTROL FILE ROUTINE
FNDCTL: MOVEI S1,.JQCFD(R) ;GET FD FOR CTL
MOVEM S1,.JCFOB+FOB.FD(R) ;STORAGE AREA
MOVX S1,FB.LSN ;NO LINE SEQ NUMBERS
ADDI S1,7 ;PLACE BYTE SIZE IN S1
MOVEM S1,.JCFOB+FOB.CW(R) ;SAVE CONTROL WORD
IFN FTJSYS,<
HRROI S1,.JQNAM(R) ;USER NAME FROM CREATE
HRROI S2,.JQCON(R) ;CONNECTED DIRECTORY
>;END FTJSYS
IFN FTUUOS,<
MOVE S1,.JQPPN(R) ;GET PPN FOR USER
MOVEI S2,0 ;MAKE ZERO FOR CONSISTENCY
>;END FTUUOS
MOVEM S1,.JCFOB+FOB.US(R) ;SAVE USER IN BEHALF
MOVEM S2,.JCFOB+FOB.CD(R) ;SAVE IN FOB
MOVEI S1,FOB.SZ ;SIZE OF THE BLOCK
MOVE T1,.JQJBB+JIB.SQ(R) ;GET WORD WITH POSSIBLE PRIV BIT
TXNE T1,EQ.PRV ;IS PRIV BIT SET?
MOVEI S1,FOB.MZ ;YES.. NO IN BEHALF NEEDED
MOVEI S2,.JCFOB(R) ;ADDRESS OF THE BLOCK
$CALL F%IOPN ;OPEN THE FILE
JUMPF FNDC.E ;ERROR EXIT
MOVEM S1,.JCJFN(R) ;SAVE CTL JFN
TRO F,FR.CTO ;TURN ON OPEN CTL BIT
POPJ P, ;AND RETURN FOR NORMAL READING
FNDC.E: PUSHJ P,L$BLNK## ;GET BLANK LINE
IDENT [ASCIZ / BATCFE /] ;IDENTIFY LINE
$TEXT (L$OUT1,<^E/[-1]/...^F/.JQCFD(R)/>) ;LAST ERROR
IDENT [ASCIZ / BATBJC Batch Job has been Canceled
/]
SETZM .JRTIM(R) ;NO TIME STAMP
PUSHJ P,L$CRLF## ;SEND CR AND LF
PJRST CLOSJB ;CLOSE THE JOB OUT
SUBTTL INPPTY - PTY INPUT ROUTINES
IFN FTUUOS,<
INPPTY: MOVE S1,[INPUT 0,0] ;SETUP FOR INPUT UUO
IOR S1,.JPCHN(R) ;PUT CHANNEL INTO INSTRUCTION
XCT S1 ;EXECUTE INPUT
POPJ P,
> ;END IFN FTUUOS
IFN FTJSYS,<
INPPTY: MOVE S1,.JPTTY(R) ;TTY FOR PTY
SOBE ;CHECK OUTPUT BUFFER
JRST INPP.1 ;YES..GET IT
$RETF ;NO RETURN
INPP.1: MOVEM S2,EE ;SAVE COUNT FOR SIN
MOVE S1,.JPLSO(R) ;LINK LIST NUMBER
$CALL L%LAST ;POSITION TO THE END
MOVE S1,.JPLSO(R) ;LIST NUMBER
MOVE S2,EE ;GET CHARACTER COUNT
IDIVI S2,5 ;CONVERT TO WORDS
ADDI S2,3 ;3 WORDS 2 HEADER 1 FOR TEXT
;MEMORY OPTIMIZATION BY USING MINIMUM SIZE BLOCK
CAIGE S2,ALCSIZ-3 ;GREATER OR EQUAL TO MINIMUM SIZE
MOVEI S2,ALCSIZ-3 ;ALLOW FOR LIB OVERHEAD
$CALL L%CENT ;CREATE ENTRY
MOVE S1,.JPCHN(R) ;PTY JFN
MOVE T2,S2 ;SAVE ADDRESS OF BLOCK
HRLI S2,440700 ;LEFT HALF BYTE POINTER
HRRI S2,2(T2) ;ADDRESS IN RIGHT HALF
MOVEM S2,(T2) ;SAVE POINTER IN WORD 0
MOVE T1,EE ;COUNT TO READ
MOVEM T1,1(T2) ;SAVE COUNT IN FIRST WORD
SIN ;READ THE DATA
;*** ERJMP
MOVE S1,.JPTTY(R) ;GET TTY NUMBER(PTY)
SOBE ;ANY MORE DATA
JRST INPP.1 ;YES GO GET IT
$RETT ;GIVE GOOD RETURN
> ;END OF IFN FTJSYS
SUBTTL SEND PTY OUTPUT TO JOB
SNDUPC: MOVEI CH,CHR.CC ;SET A ^C
PUSHJ P,PUTPTY ;SEND THE ^C AND FALL INTO FORCE THE BUFFER
IFN FTUUOS,<
PTYSND: MOVE S1,[OUTPUT 0,0] ;OUTPUT TO THE PTY
IOR S1,.JPCHN(R) ;PUT CHANNEL NUMBER IN PTY
XCT S1 ;EXECUTE THE OUTPUT
POPJ P,
> ;END IFN FTUUOS
IFN FTJSYS,<
PTYSND: PUSH P,S1 ;SAVE S1
PUSH P,S2 ;SAVE S2
PUSHJ P,HLFDUP ;INSURE LINE IS HALF-DUPLEX
MOVE S1,.JPCHN(R) ;PTY JFN
HRROI S2,.JPTYO(R) ;POINTER TO OUTPUT AREA
SKIPGE T1,.JPOUT+2(R) ;CHECK IF LESS THAN ZERO
SETZ T1, ;YES,,MAK ZERO
SUBI T1,PTYBLK*PTYBFR*5 ;GET NEGATIVE COUNT
JUMPE T1,PTYS.2 ;DON'T SEND AN EMPTY BUFFER
PTYSN1: SOUT ;OUTPUT TO THE PTY
ERJMP PTYSN2 ;OUTPUT FAILED ?
PTYS.2: MOVEI S1,PTYBLK*PTYBFR*5 ;LOAD BUFFER SIZE
MOVEM S1,.JPOUT+2(R) ;RESTORE BUFFER COUNT
MOVE S1,[POINT 7,.JPTYO(R)] ;BYTE POINTER FOR PTY OUT
MOVEM S1,.JPOUT+1(R) ;RESTORE POINTER
SETZM .JPTYO(R) ;CLEAR FIRST BUFFER WORD
POP P,S2 ;RESTORE S2
POP P,S1 ;RESTORE S1
POPJ P, ;RETURN
PTYSN2: PUSH P,S2 ;SAVE UPDATED POINTER
MOVX S1,.FHSLF ;GET OUR PROCESS HANDLE
GETER ;GET LAST ERROR CODE
HRRZS S2 ;KEEP ONLY THE ERROR CODE
CAIE S2,IOX33 ;OUTPUT FAILED BECAUSE PTY BUFFER FULL ?
$STOP (OPF,Output to PTY failed)
PUSHJ P,QTS ;YES - TRY AGAIN LATER
MOVE S1,.JPCHN(R) ;GET PTY JFN
POP P,S2 ;RESTORE POINTER
JRST PTYSN1 ;GO OUTPUT A BUFFER
> ;END OF IFN FTJSYS
SUBTTL GETPTY - GET A CHARACTER FROM PTY INPUT BUFFER
IFN FTUUOS,<
GETPTY: SOSGE .JPINP+2(R) ;IS THERE A CHARACTER
$RETF ;GIVE FALSE RETURN
ILDB CH,.JPINP+1(R) ;GET THE NEXT
JUMPN CH,[AOS .JICNT(R)
$RETT] ;DID WE GET THE CHAR?
JRST GETPTY ;IGNORE NULLS
> ;END IFN FTUUOS
IFN FTJSYS,<
GETPTY: MOVE S1,.JPLSO(R) ;LIST NUMBER
$CALL L%FIRS ;POSITION TO FIRST
JUMPF .POPJ ;ERROR..PASS SAME CODE
GETP.1: SOSGE 1(S2) ;DECREMENT COUNT IN BUFFER
JRST GETP.2 ;CHECK FOR MORE
ILDB CH,(S2) ;GET BYTE FROM BUFFER
JUMPE CH,GETP.1 ;SKIP NULLS
AOS .JICNT(R) ;NON NULL, BUMP COUNT
$RETT ;GIVE GOOD RETURN
GETP.2: MOVE S1,.JPLSO(R) ;LIST NUMBER
$CALL L%DENT ;DELETE THE ENTRY
MOVE S1,.JPLSO(R) ;GET NEXT ELEMENT
$CALL L%NEXT ;GET NEXT ENTRY
JUMPF .POPJ ;ERROR RETURN..PASS ERROR BACK
JRST GETP.1 ;GO GET CHARACTER
> ;END OF IFN FTJSYS
SUBTTL PUTPTY - PUT CHARACTERS INTO PTY OUTPUT BUFFER
PUTPTY:
IFN FTJSYS,<
TLNE F,FL.XCC ;IS THIS A GENERATED CONTROL CHAR?
JRST PUTP.0 ;YES, BYPASS CR-LF SUPPRESSION
CAIN CH,CHR.LF ;IS THIS A LF?
TRZN F,FR.SLF ;YES, DO WE IGNORE THIS LF?
TRZA F,FR.SLF ;NOT LF, OR NO IGNORE, CLEAR FLAG, SKIP
POPJ P, ;RETURN..(HAD A LINE FEED)
CAIN CH,CHR.CR ;IS IT A CARRIAGE RETURN
TRO F,FR.SLF ;YES SET FLAG TO SKIP LF TO PTY
PUTP.0:
>;END FTJSYS
SOSGE .JPOUT+2(R) ;IS BUFFER FULL
JRST PUTP.1 ;YES, SEND THE BUFFER
IDPB CH,.JPOUT+1(R) ;STORE IT
POPJ P,
PUTP.1: PUSHJ P,PTYSND ;SEND THIS BUFFER TO THE JOB
SETOM .JREOL(R) ;FAKE AN EOL SENT SO ANY ERRORS CAN BE FOUND
PUSH P,CH ;SAVE THE CHARACTER I WANT TO SEND
PUSH P,S1 ;SAVE OTHER REGS ALSO
PUSH P,S2 ;...
PUSHJ P,IOWAIT ;AND WAIT UNTIL THE JOB WANT'S MORE INPUT
SKIPE .JRTIM(R) ;IS TIME STAMP NEEDED?
TLNE F,FL.SIL ;YES, BUT ARE WE SILENCED
SKIPA ;DON'T OUTPUT A TIME STAMP
PUSHJ P,L$LSTP## ;OUTPUT ONE BEFORE RESTORING S1 AND S2
SETZM .JREOL(R) ;CLEAR THE FLAG JUST IN CASE IT'S LEFT ON
POP P,S2 ;RESTORE
POP P,S1 ;...
POP P,CH ;RESTORE THE CHARACTER TO SEND
JRST PUTPTY ;NOW STORE IT INTO THE BUFFER
;SUBROUTINE TO SEND A STRING POINTED TO BY 'S1' TO THE JOB
UUOSND: HRR T1,.JBUUO## ;ENTER HERE IF FROM UUO CALL
SNDSTR: HRLI T1,(POINT 7,0) ;MAKE A BYTE POINTER OUT OF IT
ILDB CH,T1 ;GET ONE
JUMPE CH,CPOPJ ;IS AN ASCIZ STRING
PUSHJ P,SNDCHR ;SEND IT AND ECHO
JRST SNDSTR+1 ;LOOP ON THE STRING
;SUBROUTINE TO SEND <CR>-<LF> AND FORCE OUT THE BUFFER
SNDCLF: MOVEI CH,CHR.CR ;A CARRIAGE RETURN
PUSHJ P,SNDCHR ;SEND THE CHARACTER
MOVEI CH,CHR.LF ;A LINE FEED
PUSHJ P,SNDCHR ;SEND IT TOO
JRST PTYSND ;SEND THE BUFFER AND RETURN
;SUBROUTINE TO SEND CH TO PTY AND JOB
SNDCHR: PUSHJ P,PUTPTY ;PUT INTO THE OUTPUT BUFFER
TLNE F,FL.XCC ;A GENERATED CTRL CHAR?
JRST SNDCH1 ;YES, DONT DO LF CHECK
CAIN CH,CHR.LF ;WAS THAT THE LINE FEED I SENT
SETOM .JREOL(R) ;YES, SET A FLAG FOR ERROR CHECKING
SNDCH1: TLNE F,FL.SIL ;IS THE LINE TO BE SILENCED
POPJ P, ;YES, EXIT NOW
JRST L$PLOG## ;ECHO IN THE LOG FILE
SUBTTL UUOCON - BATCON LUUO HANDLER
;BATCON UUO PROCESSOR
UUOCON: HLRZ IO2,.JBUUO## ;GET THE OPCODE
LSH IO2,-^D9 ;POSITION IT
CAILE IO2,UUOCNT ;NUMBER OF KNOWN UUOS
JRST UUOERR ;ILLEGAL UUO ?
JRST @UUOTBL-1(IO2) ;DISPATCH THE UUO
UUOTBL: JRST L$TXTL## ;OPCODE 001 - ASCIZ TEXT TO THE LOG FILE
JRST UUOSND ;OPCODE 002 - ASCIZ TEXT TO THE JOB
JRST L$SIXU## ;OPCODE 003 - SIXBIT TEXT TO THE LOG FILE
JRST L$IDEN## ;OPCODE 004 - IDENTIFIER TO THE LOG FILE
UUOCNT==.-UUOTBL ;NUMBER OF KNOWN UUOS
UUOERR: $STOP(IBU,ILLEGAL BATCON UUO)
;SUBROUTINE TO CREATE A MASK INTO AC B FOR THE COMMAND IN AC S1
MASKIT: MOVE S2,S1 ;COPY THE COMMAND
SETO T2, ;EVENTUAL MASK (COMPLEMENT FORM)
LSH T2,-6 ;SHIFT THE MASK
LSH S2,6 ;SHIFT THE COMMAND THE OTHER WAY
JUMPN S2,.-2 ;CONTINUE UNTIL HAVE SHIFTED ALL THE CHARACTERS
POPJ P, ;RETURN WITH MASK IN B
;SUBROUTINE TO CHECK IF CHARACTER IN CH IS A LINE TERMINATOR
COMTRM: CAIG CH,CHR.FF ;LOOK FOR PAPER MOTION CHARACTERS
CAIGE CH,CHR.LF
SKIPA ;NO, LOOK FOR OTHERS
POPJ P, ;GIVE TERMINATOR RETURN
CAIE CH,CHR.CG ;^G
CAIN CH,CHR.CZ ;^Z
POPJ P, ;RETURN
CAIN CH,CHR.CC ;^C
POPJ P, ;RETURN
JRST CPOPJ1 ;NOT ONE OF THE ABOVE, NOT A TERMINATOR
;SUBROUTINE TO GET A SIXBIT COMMAND INTO S1
GETSIX: MOVE P2,[POINT 6,P1] ;POINTER TO THE STRING
SETZ P1, ;EVENTUAL DESTINATION
GETS.1: PUSHJ P,GETONE ;GET A CHARACTER
JRST GETS.5 ;STOP ON LINE TERMINATOR
JRST GETS.2 ;SPECIAL, CHECK FOR BLANKS
JRST GETS.4 ;DON'T INCLUDE LEADING NUMBERS
GETS.3: SUBI CH," " ;CONVERT TO SIXBIT
TLNE P2,770000 ;ALREADY HAVE ENOUGH
IDPB CH,P2 ;NO, INCLUDE THIS CHARACTER
JRST GETS.1 ;GET MORE INPUT
GETS.2: CAIN CH," " ;IS IT A BLANK
JUMPE P1,GETS.1 ;YES, IGNORE LEADING BLANKS
TRNE F,FR.%SG ;ARE % SIGNS VALID CHARACTERS
CAIE CH,"%" ;YES, WAS IT ONE
JRST GETS.5 ;RETURN IF SPECIAL OR BLANK AS TERMINATOR
JRST GETS.3 ;INCLUDE THE % SIGN
GETS.4: JUMPE P1,GETS.5 ;STOP IF THE NUMBER IS FIRST
JRST GETS.3 ;INCLUDE IF AFTER THE FIRST
GETS.5: MOVE S1,P1 ;PLACE WORD IN S1
POPJ P, ;RETURN
;SUBROUTINE TO GET A CHARACTER FORM THE COMMAND LINE
;CALL IS:
; PUSHJ P,GETONE
; HERE IF A LINE TERMINATOR
; HERE IF A SPECIAL CHARACTER
; HERE IF A NUMBER
; HERE IF A LETTER
GETONE: TRZE F,FR.RSC ;CALLER ALREADY HAVE CH
JRST CLASSF ;YES, CLASSIFY IT AND GIVE IT BACK
PUSHJ P,GETCTL ;GET A CHARACTER FROM CONTROL FILE
JUMPE CH,GETONE ;THROUGH AWAY NULLS
;**;[4303]At GETONE:+3L add 1 line JCR 6/11/86
JUMPL CH,CPOPJ3 ;[4303]End of CTL file while looking for %RERR
CAIN CH,CHR.CR ;AND IGNORE CARRIAGE RETURNS
JRST GETONE
CAIN CH,CHR.HT ;A TAB
MOVEI CH," " ;YES, CONVERT TABS TO BLANKS
CLASSF: CAIE CH,CHR.CR ;CARRIAGE RETURN IF FROM BATCON LABEL PROCESSOR
PUSHJ P,COMTRM ;IS IT A LINE TRMINATOR
POPJ P, ;RETURN
CAIG CH,"9"
CAIGE CH,"0" ;IS IT A DIGIT
SKIPA
JRST CPOPJ2 ;YES, GIVE APPROPRIATE RETURN
CAIG CH,172 ;LOWER CASE "Z"
CAIGE CH,141 ;LOWER CASE "A"
SKIPA
SUBI CH," " ;MAKE UPPER CASE
CAIG CH,"Z"
CAIGE CH,"A" ;IS IT A LETTER
JRST CPOPJ1 ;NO, MUST BE A SPECIAL
CPOPJ3: AOS (P) ;LETTER EXIT
CPOPJ2: AOS (P) ;DIGIT EXIT
CPOPJ1: AOS (P) ;SPECIAL CHARACTER EXIT
CPOPJ: POPJ P, ;LOTS OF SKIP RETURNS
SUBTTL TABSRC - TABLE LOOKUP ROUTINE
;SUBROUTINE TO DO A TABLE LOOKUP FOR THE COMMAND IN S1
;ON CALL A = XWD -COUNT , TABLE ADDRESS
;RETURNS CPOPJ IF NOT FOUND
; CPOPJ1 IF AMBIGUOUS
; CPOPJ2 IF A GOOD COMMAND C = RELATIVE INDEX INTO THE TABLE
;CLOBBERS AC'S S2,A,B,C,D
TABSRC: PUSHJ P,MASKIT ;CREATE A MASK IN B
SETZ T3, ;CLEAR FOUND ONE INDICATOR
MOVEI T4,(T1) ;SAVE TABLE START ADDRESS
TABS.1: MOVE S2,(T1) ;GET ONE FROM THE TABLE
CAMN S1,S2 ;AN EXACT MATCH
JRST [MOVEI T3,(T1) ;YES, COMPUTE OFFSET
JRST TABS.3] ;AND EXIT NOW
ANDCM S2,T2 ;MASK TO AS MANY CHARS AS IN S1
CAME S1,S2 ;FOUND A MATCH
JRST TABS.2 ;NO, CONTINUE SEARCH
JUMPN T3,CPOPJ1 ;IF ALREADY FOUND ONE, GIVE AMBIGUOUS RETURN
MOVEI T3,(T1) ;SAVE ADDRESS OF THIS ONE
TABS.2: AOBJN T1,TABS.1 ;LOOK FOR A MATCH
JUMPE T3,CPOPJ ;RETURN IF NEVER FOUND ONE
TABS.3: SUBI T3,(T4) ;COMPUTE RELATIVE OFFSET
JRST CPOPJ2 ;GIVE LOTS OF SKIP RETURNS
SUBTTL System Dependent Subroutines
;TO AVOID EXCESSIVE FEATURE TESTING IN THE MAIN CODE FOR TOPS10 OR TOPS20,
; SYSTEM DEPENDENT SUBROUTINES ARE INCLUDED HERE, AS A SEPARATE SECTION.
; GJTIML GET SUBJOB (J) REMAINING TIME LIMIT INTO S1
; ONCECN SET UP ONCE ONLY CONSTANTS
; PREKJB SET UP FOR AUTO LOGOUT OF A JOB
; CHKCLS DETERMINE IF CLOSE/DUMP/UNHANDLED ERROR
; SYSPRG DETERMINE IF CURRENT PROGRAM CAME FROM SYS:. USED FOR
; %CERR:: OR %ERR:: DECISION
SUBTTL TOPS10 Subroutines
IFN FTUUOS,< ;A LARGE FEATURE TEST FOR TOPS10 VERSION
;ROUTINES NOT NEEDED ON TOPS10
DELSPL==CPOPJ ;NO SPOOLED FILES TO DELETE
;SUBROUTINE TO GET SUBJOB (J) REMAINING TIME LIMIT INTO S1
GJTIML: HRL S1,J ;GET THE JOB NUMBER
HRRI S1,.GTLIM ;THE LIMIT TABLE
GETTAB S1, ;GET THE JOB LIMIT WORD
JFCL ;BATCH NEEDS THAT TABLE
TLZ S1,777700 ;CLEAR ALL BUT TIME REMAINING
POPJ P, ;RETURN WITH REMAINING LIMIT
;SUBROUTINE TO SET UP FOR AUTO LOGOUT ABOUT TO HAPPEN
PREKJB: MOVE T1,[2,,T2] ;SET FOR JBSET. UUO
HRRZ T2,J ;ADD THE JOB NUMBER
MOVE T3,[.STTLM,,^D30] ;GIVE SOME EXTRA TIME FOR KJOB
JBSET. T1, ;TRY TO PREVENT TIME EST EXCEEDED DURING KJOB
JFCL
POPJ P, ;AND RETURN
;SUBROUTINE TO SET UP ONCE ONLY CONSTANTS
ONCECN: SETZ S1, ;CLEAR S1 TO BE SAFE IF NO WHERE
MOVSI T1,'OPR' ;TEST IF SYSTEM HAS REMOTE STATION FEATURE
WHERE T1, ;BY SEEING IF THIS WHERE UUO FAILS
SKIPA ;IT DID, NO LOCATE COMMAND FOR NEW JOBS
MOVX S1,<B.REMT> ;SET REMOTE LOGIC AVAILABLE
IORM S1,FLAGS ;TURN ON THE FLAG
SKIPN CORCHK ;WANT CORE CHECKING?
POPJ P, ;NO..RETURN
MOVE S1,[%CNMMX] ;FIND OUT THE VALUE OF MINMAX
GETTAB S1, ;SO JOBS WITH /CORE:1K DON'T CONFUSE BATCON
MOVEI S1,^D12*^D1024 ;THIS IS THE VALUE SUGGESTED FOR 507 MONITORS
LSH S1,-^D9 ;CONVERT TO PAGES
MOVEM S1,MINMAX ;SAVE FOR LATER
POPJ P, ;AND RETURN
;;;FTUUO CONDITIONAL CONTINUED ON NEXT PAGE
;SUBROUTINE TO CHECK IF A CLOSE/DUMP COMMAND IS NEEDED
CHKCLS: TLNN R,RL.JIE ;IS THE JOB IN ERROR STATE
POPJ P, ;NO, DON'T NEED THE CLOSE
TRO F,FR.UHE ;AN UNEXPECTED CONDITION
PUSHJ P,INMONM ;MAKE SURE THE JOBS IN MONITOR MODE
SKIPE .JRTIM(R) ;TIME STAMP NEEDED
PUSHJ P,L$LPER## ;YES, SEND A PERIOD, THAT WILL TIME STAMP IT
TXTJOB [ASCIZ/CLOSE/] ;SEND THE CLOSE COMMAND
PUSHJ P,SNDCLF ;END THE LINE AND SEND THE BUFFER
PUSHJ P,IOWAIT ;WAIT UNTIL COMPLETE
PUSHJ P,SYSPRG ;DID PROGRAM COME FROM SYS
POPJ P, ;YES, NO DUMP
HRL S1,J ;GET THE JOB NUMBER
HRRI S1,.GTPRG ;GET THE PROGRAM NAME
GETTAB S1,
POPJ P, ;DON'T KNOW, NO DUMP
JUMPE S1,CPOPJ ;RUN OR GET ERROR, NO DUMP
TXTJOB [ASCIZ/DCORE .DMP/] ;NOW SEND THE DUMP COMMAND
PUSHJ P,SNDCLF ;END THE LINE
PUSHJ P,IOWAIT ;WAIT FOR NEXT INPUT REQUEST
JRST INMONM ;MAKE SURE AGAIN THEN RETURN TO CALLER
;SUBROUTINE TO DETERMINE IF PROGRAM CAME FROM SYS
SYSPRG: HRL S1,J ;GET THE JOB NUMBER
HRRI S1,.GTLIM ;GET THE JBTLIM TABLE
GETTAB S1,
POPJ P, ;CAN'T GET IT, SAY YES
TLNE S1,(JB.LSY) ;CHECK GOTTEN FROM SYS BIT
POPJ P, ;IT DID
JRST CPOPJ1 ;A USER PROGRAM
;SUBROUTINE TO GET NEXT CHARACTER FROM THE PTY EVEN IF CROSSES A BUFFER
NXTPTY: PUSHJ P,GETPTY ;GET A CHARACTER
SKIPF ;BUFFER EMPTY REFILL IT
POPJ P, ;GOT ONE, TURN
PUSHJ P,QTS ;WAIT FOR NEXT WAKE-UP
PUSHJ P,INPPTY ;GET A FRESH BUFFER
JRST NXTPTY ;TRY NOW
> ;;;END OF IFN FTUUOS
SUBTTL TOPS20 Subroutines
IFN FTJSYS,< ;A LARGE FEATURE TEST FOR TOPS20 VERSION
;ROUTINES NOT NEEDED ON TOPS20
SYSPRG==CPOPJ1 ;ALL ERRORS TRAP TO %ERR::
;SUBROUTINE TO GET SUBJOB (J) REMAINING TIME LIMIT INTO S1
GJTIML: MOVEI S1,(J) ;GET THE JOB NUMBER
HRROI S2,S1 ;ONE WORD INTO S1 (E.G. -1,,S1)
MOVX T1,.JIRTL ;A = S2 + 1, WANT RUN TIME LIMIT
GETJI ;GET IT
SETO S1, ;OH WELL!
POPJ P, ;RETURN WITH TIME IN S1
;SUBROUTINE TO SET UP ONCE ONLY CONSTANTS
ONCECN: SETZM MINMAX ;THERE IS NO SYSTEM MINIMUM
MOVX S1,RC%EMO ;EXACT MATCH ONLY
HRROI S2,[ASCIZ /SPOOL:/] ;[6001]
RCDIR ;GET SPOOL DIRECTORY NUMBER
MOVEM T1,SPLNUM ;SAVE AWAY THE ANSWER
MOVE S1,[SIXBIT/PTYPAR/] ;GET NUMBER OF PTYS AVAILABLE
SYSGT ;GET THE VALUE
HRRM S1,FIRPTY ;SAVE FIRST PTY NUMBER
HLRM S1,NUMPTY ;SAVE NUMBER OF PTYS IN SYSTEM
HRRZI S1,.MSIIC ;BYPASS MOUNT COUNTS
MSTR ;DO THE FUNCTION
ERJMP .+1 ;IGNORE ERROR FOR NOW
SETOM S1 ;MY JOB
MOVX S2,JI.LOC ;GET MY LOCATION
PUSHJ P,I%JINF ;GET THE VALUE
MOVEM S2,MYNODE ;SAVE MY NODE
MOVEI S1,.FHSLF ;GET MY HANDLE
MOVEI S2,103 ;SET THE PROPER QUEUES
SPRIW ;SET THE PRIORITY WORD
ERJMP .+1 ;IGNORE THE VALUE
POPJ P, ;AND RETURN
;SUBROUTINE TO DETERMINE IF AN UNHANDLED ERROR OCCURRED
CHKCLS: TLNE R,RL.JIE ;DID AN ERROR OCCUR
TRO F,FR.UHE ;YES, AN UNEXPECTED CONDITION
POPJ P, ;NEVER DO CLOSE/DUMP
;HERE TO DELETE SPOOLED INPUT FILES:
;
;FILES ARE NAMED:
; DSK:<SPOOL>CDR-XXX.CDYYYY.*
;WHERE XXX IS THE USER'S DIRECTORY NUMBER
; YYYYY IS A STRING MADE OF THE JOBNAME CONCATENATED WITH A
; RANDOM 4 CHARS CURRENTLY PASSED BY SPRINT IN .JQSIS.
DELSPL: SKIPN .JQSIS(R) ;IS THERE A SPOOLED INPUT NAME?
POPJ P, ;NO, JUST RETURN
$TEXT (<-1,,.JQCFD(R)>,<^T/SPLTXT/^O/.JQJBB+JIB.US(R),RHMASK/.^W/.JQSIS(R)/.*^0>)
MOVX S1,GJ%OLD!GJ%IFG!GJ%SHT ;LOAD GTJFN BITS
LOAD S2,IPBBLK+IB.FLG,IB.NAC ;Get the access bit value
SKIPE DEBUGW ;Debugging?
SETZ S2, ;Yes, do not restrict
STORE S2,S1,GJ%ACC ;Store as value of JFN access
HRROI S2,.JQCFD(R) ;POINT TO FILE-NAME
GTJFN ;GET A JFN
POPJ P, ;FAILED, RETURN
MOVE T1,S1 ;SAVE THE JFN
JRST DELS.2 ;JUMP INTO THE LOOP
DELS.1: GNJFN ;GET THE NEXT FILE
JRST DELS.3 ;DONE EXPUNGE THE AREA
DELS.2: TLZ S1,-1 ;CLEAR LEFT HALF OF JFN WORD
TXO S1,DF%NRJ ;DONT RELEASE THE JFN
DELF ;DELETE THE FILE
JFCL ;IGNORE THE ERROR
MOVE S1,T1 ;RELOAD INDEXABLE JFN
JRST DELS.1 ;GET THE NEXT ONE
DELS.3: MOVEI S1,0 ;NO SPECIAL FLAGS
MOVE S2,SPLNUM ;GET DIRECTORY NUMBER OF <SPOOL>
DELDF ;EXPUNGE IT
ERJMP .POPJ ;IGNORE ERROR..
POPJ P, ;AND RETURN
SPLTXT: ASCIZ/SPOOL:CDR-/ ;[6001]
> ;;;END OF FTJSYS
SUBTTL JOBSTS - JOB STATUS ON STREAM
IFN FTUUOS,<
JOBSTS: AOS .JOBST(R) ;BUMP JOBSTS CALLED COUNT
MOVE J,.JPCHN(R) ;GET THE PTY CHANNEL NUMBER
LSH J,-^D23 ;PLACE AS INDEX IN AC
JOBSTS J, ;GET THE STATUS
HALT . ;;;BUG HALT
POPJ P, ;RETURN WITH J CONTAINING DATA
>;END FTUUOS
IFN FTJSYS,<
JOBSTS: AOS .JOBST(R) ;BUMP JOBSTS CALLED COUNT
MOVEI J,0 ;CLEAR STATUS FLAG
SETZM .JJOBS+.JIUNO(R);CLEAR THE USER NUMBER FIELD
SETZM .JJOBS+.JIT20(R);CLEAR THE MONITOR LEVEL FLAG
SETZM .JJOBS+.JIBAT(R);Clear batch job flag
MOVE S1,.JPTTY(R) ;TERMINAL NUMBER OF PTY
HRLI S2,-<.JIT20+1> ;COUNT OF ELEMENTS
HRRI S2,.JJOBS(R) ;LOCATION OF GETJI DATA
MOVEI T1,0 ;START WITH 0
GETJI ;GET JOB INFO
JRST [CAIE S1,GTJIX4 ;IS IT A NON EXISTANT JOB?
PUSHJ P,ERRPRT ;NO, SO PROCESS NORMALLY
POPJ P,] ;YES, SO IGNORE IT DSW 7/13/81
SKIPE .JJOBS+.JIUNO(R) ;IS USER LOGGED IN
TLO J,JL.ULI ;USER LOGGED IN SET
TLO J,JL.UML ;SET TO MONITOR LEVEL
SKIPN .JJOBS+.JIT20(R);CHECK MONITOR LEVEL FLAG
TLZ J,JL.UML ;MUST BE AT USER LEVEL
SETZ S1, ;SET FLAGS TO ZERO
EXCH S1,.JFLAG(R) ;GET THE CURRENT FLAGS AND RESET
; Since we can't trust the status returned on an interrupt, we have to ask
; the monitor if the PTY is really hungry.
;
JOBS.1: SKIPGE .JJOBS+.JIJNO(R) ;IS IT LOGGED IN
JRST [TLO J,JL.UML ;No, must be at monitor level
JRST JOBS.2] ;SKIP CHECKING PTY HUNGRY
TLZ J,JL.UDI ;PTY IS HUNGRY ALREADY
MOVE S1,.JPCHN(R) ;GET PTY JFN
MOVEI S2,.MOPIH ;CHECK IF PTY HUNGRY
MTOPR
SKIPE S2 ;0 NOTHING,,-1 HUNGRY
JOBS.2: TLO J,JL.UDI ;PTY HUNGRY
SKIPL S1,.JJOBS+.JIJNO(R) ;SKIP NO JOB NUMBER AVAILABLE
TLO J,JL.UJA ;JOB NUMBER AVAILABLE
HRR J,S1 ;PLACE JOB NUMBER IN J
TLZ J,JL.UOA ;ANY OUTPUT READY
MOVE S1,.JPTTY(R) ;GET PTY NUMBER
SOBE ;PTY HAVE OUTPUT FOR US
TLO J,JL.UOA ;YES OUTPUT AVAILABLE
MOVEM J,.JFLAG(R) ;SAVE NEW STATUS
MOVX S1,JL.UOA!JL.UDI ;GET INTERRUPT BITS
ANDM S1,.JFLAG(R) ;MAKE SURE THESE ARE ONLY ONES SET
POPJ P, ;RETURN FOR NOW
>;END FTJSYS
SUBTTL TSLEEP - SLEEP ROUTINE FOR DISPATCH LOOP
IFN FTUUOS,<
TSLEEP: MOVX S1,HB.IPC!HB.RPT ;SET IPCF AND PTY CONDITIONS
SKIPE CORCHK ;ARE WE CHECKING CORE
HRRI S1,^D60000 ;YES..CHECK ONCE A MINUTE
SKIPE STACTV ;ANY STREAMS ACTIVE
HRRI S1,^D15*^D1000 ;YES, SET A TIMER FOR THE SLEEP
HIBER S1, ;TAKE A NAP
JFCL ;NICE TRY
POPJ P, ;RETURN FROM SLEEP
>;END FTUUOS
IFN FTJSYS,<
TSLEEP: MOVEI S1,0 ;SET INFINITE SLEEP
SKIPE STACTV ;ANY STREAMS ACTIVE
MOVEI S1,15 ;YES..SLEEP FOR 15 SECONDS
PJRST I%SLP ;SLEEP AND WAKE ROUTINE
>;END FTJSYS
SUBTTL BATPSI - BATCON PSI ENABLE CODE
IFN FTJSYS,<
BATPSI: CIS ;CLEAR INTERRUPT SYSTEM
$CALL I%ION ;ENABLE INTERRUPT SYSTEM
MOVX S1,.FHSLF ;PROCESS HANDLE
MOVX S2,<77B5+17777> ;ACTIVATE 0-5 AND 23-35
AIC ;ACTIVATE THOSE CHANNELS
POPJ P, ;RETURN
>;END FTJSYS
IFN FTUUOS,<
BATPSI: MOVE S1,[VECTOR,,VECTOR+1] ;SETUP A BLT POINTER
SETZM VECTOR ;CLEAR THE FIRST WORD
BLT S1,ENDVEC ;CLEAR THE WHOLE THING
MOVEI S1,BATIPC ;GET ADDRESS OF IPCF INT RTN
MOVEM S1,VECIPC+.PSVNP ;SAVE IN VECTOR
HRREI T1,.PCIPC ;IPCF CONDITION CODE
MOVSI T2,<VECIPC-VECTOR> ;VECTOR OFFSET
SETZ T3, ;RESERVED WORD
MOVX S1,PS.FAC+T1 ;ADD THE CONDTION
PISYS. S1, ;DO IT!!
HALT
$CALL I%ION ;TURN ON INTERRUPT SYSTEM
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
SUBTTL BATIPC - BATCON IPCF INTERRUPT HANDLER
BATIPC: $BGINT INT.AL ;LEVEL 1 INTERRUPTS
$CALL C%INTR ;INTERRUPT OCCURED
$DEBRK ;EXIT INTERRUPTS
SUBTTL ERROR PRINT ROUTINE
IFN FTJSYS,<
ERRPRT: $STOP(GER,GETJI ERROR RETURN)
>;END FTJSYS
SUBTTL INTERRUPT PROCESSING ROUTINES
IFN FTJSYS,<
DEFINE BLDCHN(XX,YY,ZZ),<
PTYC'XX: $BGINT INT.IN ;LEVEL 1 INTERRUPTS
MOVEI S,ZZ ;INTERRPT LEVEL #
JRST PTYINP ;PTY INTER. PROCESSING
PTYC'YY: $BGINT INT.OU ;LEVEL 1 INTERRUPTS
MOVEI S,ZZ ;INTERRPT LEVEL #
JRST PTYOUT ;PTY INTER. PROCESSING
>;END BLDCHN
XX==0
YY==1
ZZ==0
REPEAT DEFMJB,<BLDCHN(\XX,\YY,ZZ)
XX==XX+2
YY==XX+1
ZZ==ZZ+1>
PTYINP: SKIPL R,BASTBL(S) ;LOAD UP BASE REGISTER
JRST PTYERR ;MARK AS AN ERROR
MOVSI T1,<JL.UDI> ;INPUT READY
IORM T1,.JFLAG(R) ;RESTORE VALUE IN MEMORY
AOS .JINPI(R) ;COUNT INPUT DESIRED INTERRUPTS
$DEBRK ;INTERRUPT EXIT
PTYOUT: SKIPL R,BASTBL(S) ;LOAD UP BASE REGISTER
JRST PTYERR ;MARK AS AN ERROR
MOVSI T1,<JL.UOA> ;USER HAS OUTPUT
IORM T1,.JFLAG(R) ;RESTORE VALUE IN MEMORY
AOS .JOUTI(R) ;COUNT OUTPUT READY INTERRUPTS
$DEBRK ;EXIT INTERRUPT
PTYERR: AOS INTERR ;KEEP TRACK OF PTY ERRORS
$DEBRK ;EXIT
> ;END OF IFN FTJSYS
SUBTTL PTY AND LOG OUTPUT ROUTINES
IFN FTUUOS,<
;THIS ROUTINE WILL CHECK FOR A " AND SEND AN EXTRA " IF ONE WAS
;SENT. IT WILL THEN LOG CHARACTER TO LOG FILE AND PTY
PTYSCN: MOVE CH,S1 ;SAVE CHARACTER IN CH
CAIN CH,CHR.QT ;CHECK IF A " FOR SCAN
PUSHJ P,LOGPT1 ;YES OUTPUT AN EXTRA " FOR SCAN
PJRST LOGPT1 ;OUTPUT THE CURRENT CHARACTER AND RETURN
>;END FTUUOS
PTYLOG: MOVE CH,S1 ;CHARACTER IN CH
PUSHJ P,PUTPTY ;OUTPUT TO PTY
PUSHJ P,L$PLOG## ;OUTPUT TO LOG
$RETT ;RETURN TRUE
LOGPTY: MOVE CH,S1 ;CHARACTER INTO CH
LOGPT1: PUSHJ P,PUTPTY ;PLACE IN PTY BUFFER
JRST L$OUTC## ;NOW ECHO IN LOG FILE
;PTYDAT - THIS ROUTINE JUST SEND DATA TO PTY
PTYDAT: MOVE CH,S1 ;PUT CHARACTER IN CH
PUSHJ P,PUTPTY ;OUTPUT CHARACTER AND RETURN
$RETT ;RETURN TRUE
IOERR: $STOP (FIO,FATAL I-O RETURN FROM LIBRARY)
OUTDAT: SOSLE .JWCNT(R) ;DECREMENT COUNT
IDPB S1,.JWPTR(R) ;PUT CHARACTER IN MESSAGE
$RETT ;RETURN TO TEXT
SUBTTL STAWTO - START WTO/WTOR MESSAGE
STAWTO: $CALL M%GPAG ;GET A PAGE
MOVE G,S1 ;SAVE THE PAGE ADDRESS
MOVEI S1,<WTOMAX-^D30>*5 ;MESSAGE SIZE ALLOWING FOR $ACK
MOVEM S1,.JWCNT(R) ;SAVE THE COUNT
HRRI S1,(G) ;POINT TO THE PAGE
HRLI S1,(POINT 7,) ;MAKE BYTE POINTER
MOVEM S1,.JWPTR(R) ;SAVE THE POINTER
MOVEM G,.JWADR(R) ;SAVE THE ADDRESS
SETOM .JWTOF(R) ;STARTING WTO..SET FLAG WORD
POPJ P,
SUBTTL OUTEXT - ROUTINE TO FINISH MESSAGE AND EXIT
;**;[6003]At OUTEXT:+0L change 1 line JYCW Oct-18-88
OUTEXT: $QWTO (<Message from Batch User>,<^I/JIBTXT/^T/@.JWADR(R)/>,.JQOBJ(R),<$WTJBN(.JJOBN(R)),$WTNOD(.JQLOC(R))>) ;[6003]
MOVE S1,.JWADR(R) ;GET THE ADDRESS
PUSHJ P,M%RPAG ;RELEASE THE PAGE
SETZM .JWTOF(R) ;CLEAR FLAG,,END OF WTO(R)
$RETT ;GIVE GOOD RETURN
MSGOUT: TLZN F,FL.SPL ;WAS SPECIAL BIT LIT
MOVEI S1,NULTXT ;NO..USE NULL TXT
MOVEI S2,NULTXT ;GET NULL ERROR TEXT
TLZE F,FL.ERR ;WAS ERROR SET
MOVEI S2,ERTEXT ;YES..USE ERROR TEXT
MOVE T1,.JERRO(R) ;GET THE ERROR CODE
;**;[6003]At MSGOUT:+6L change 1 line JYCW Oct-18-88
$QACK (<^T/@IPC.TX(T2)/>,<^R/.JQJBB(R)/^I/(S2)/^I/(S1)/>,<.JQOBJ(R)>,<IPC.DA+.MSCOD(T2)>) ;[6003]
$RETT ;RETURN
SUBTTL SNWTOR - SEND WTOR ROUTINE
SNWTOR: TLNE F,FL.NOP ;OPERATOR INTERVENTION ALLOWED?
JRST SNWT.E ;NO..GENERATE ERROR AND CANCEL JOB
$WTOR (<Message from Batch User>,<^I/JIBTXT/^T/@.JWADR(R)/>,.JQOBJ(R),.JQITN(R),<$WTJBN(.JJOBN(R)),$WTNOD(.JQLOC(R))>)
MOVE S1,.JWADR(R) ;GET THE ADDRESS
PUSHJ P,M%RPAG ;RELEASE THE PAGE
SETZM .JWTOF(R) ;CLEAR FLAG,,END OF WTO(R)
$RETT ;GIVE GOOD RETURN
SNWT.E: MOVX S1,E.NOPA ;NO OPERATOR INTERVENTION ALLOWED
MOVEM S1,.JERRO(R) ;SAVE THE ERROR CODE
TLO F,FL.ERR ;TURN ON ERROR FLAG
;**;[6003]At SNWT.E:+3L change 1 line JYCW Oct-18-88
$QWTO(<Canceling>,<^I/JIBTXT/ Job ^I/@ERRTAB(S1)/>,.JQOBJ(R),<$WTNOD(.JQLOC(R))>) ;[6003]
MOVEI T1,[ASCIZ/BTNOIN Operator Responses not allowed in this Stream JOB CANCELED/]
;**;[4303]At SNWT.E:+5L change 1 line JCR 6/11/86
PJRST SRCFIN ;[4303]Check error and return
ERTEXT: ITEXT (<
-- ^I/@ERRTAB(T1)/ -->) ;OUTPUT REASON
NULTXT: ITEXT(<>)
SUBTTL ERRTAB - EXPAND ERROR TABLE VALUES
DEFINE X(A,B),< EXP [ITEXT (<B>)]>
ERRTAB: MSGBLD ;BUILD MESSAGE TABLE
LSTOFF ;FORCE OUT LITERALS NOW
LIT
LSTON
END BATCON