.TITLE BAPFIL .IDENT /V3.02/ .ENABL LC .NLIST BEX ;************************************************************************** ; ; BAPFIL.MAC ; ; This routine performs all sub-job execution, apart ; from details concerned with constructing the logfiles. ; ; NB This routine should ideally be split into several overlays ; to reduce the size of BAP (eg. file processing, control ; card processing, etc) ; ;---------------------------------------------------------------------- ; ; The start-of-file packet sent by the Queue Manager has the ; following format (symbolic offsets are my own definitions, ; defined in the pre-assembly file): ; ; Location Offset Contents ; -------- ------ -------- ; ; Word 1 Q$FFUN Function code (QP.FIL) ; Word 2 Q$FDEV ASCII device name ; Word 3, byte 1 Q$FUNT Unit number ; byte 2 Q$FATT File attributes ; Word 4 Q$FUFD Binary UFD ; Word 5 Q$FNAM Radix-50 filename, word 1 of 3 ; Word 6 Q$FNAM+2 Radix-50 filename, word 2 of 3 ; Word 7 Q$FNAM+4 Radix-50 filename, word 3 of 3 ; Word 8 Q$FTYP Radix-50 filetype ; Word 9 Q$FVER Binary version number ; Word 10 - Unused ; Word 11 - Unused ; Word 12 - Unused ; Word 13 - Unused ; ; The following bits in the attributes byte are important to this ; routine: ; ; QF$DEL Delete file after sub-job has finished. ; ;---------------------------------------------------------------------- ; ; Each file is started by a *JOB card. The accepted format is ; as follows: ; ; *JOB TIME=nm,MEMORY=nk,PAGES=np ; ; where "nm" is the jobs' time limit in minutes, "nk" is ; the maximum memory requirement in K-words, and "np" is the ; output limit in pages. All three keywords may be ; omitted if desired, in which case the time limit defaults to ; the value of the global symbol $DFTIM, the memory defaults ; to the value of the global symbol $DFMEM, and the page ; count defaults to the value of $DFPAG (enforced by the ; batch processor only). All three quantities must ; be positive and less than the values of $MXTIM, $MXMEM ; and $MXPAG respectively. The keywords may be specified in ; any order. "nm" may be optionally followed by a letter M, ; and "nk" may optionally be followed by a letter K. Any text ; following a ! or ; character (inclusive) is treated as a ; comment and is ignored. ; ;-------------------------------------------------------------------------- ; ; Version: V3.02 (Version V3.00 April 1983) ; ; Modification History ; ==================== ; ; SMT306 29-JUL-83 Steve Thompson ; Add *WRITE control card. ; ; SMT307 9-SEP-83 Steve Thompson ; Make the *JOB card a JOB-class message ; rather than a SYS-class message; ; tidied up layout a little. ; ;-------------------------------------------------------------------------- ; ; Steve Thompson ; School of Chemical Engineering ; Olin Hall ; Cornell University ; Ithaca ; NY 14850 ; (607) 256 4616 (office) ; (607) 256 3895 (computer room) ; ;************************************************************************** .MCALL OFNB$R, GET$, DSAR$S, ENAR$S, STOP$S ; ; Macro to generate entries in Control Card table. ; .MACRO CCTAB LABEL .PSECT CCTABL LABEL: .ENDM .MACRO CCARD KEYWD,SUBR .PSECT CCKEYS $$$=. .ASCIZ ^KEYWD^ .PSECT CCTABL .WORD $$$ .WORD SUBR .ENDM .MACRO CCEND .PSECT CCTABL .WORD 0 .PSECT .ENDM ; ; Text messages. ; SOF: .ASCII /Start of sub-job / SOFF: .ASCIZ "DDNN:[GGG,MMM]FILENAME.TYPE;VERSION/DE" EOF: .ASCII /End of sub-job / EOFF: .ASCIZ /DDNN:[GGG,MMM]FILENAME.TYPE;VERSION/ PAUMSG: .ASCII /Job Pausing, Processor / PAUBAP: .ASCII /BAP0 / PAUSIZ=.-PAUMSG ; ; Error messages. ; EOJBX1: .ASCIZ /+++++++++++++++++++++++++++++++++++++++++++++++++++/ EOJBX2: .ASCIZ /+ +/ EROPEN: .ASCIZ /+ OPEN FAILURE ON COMMAND FILE, JOB TERMINATED +/ ERIOER: .ASCIZ "+ I/O ERROR ON COMMAND FILE, JOB TERMINATED +" ERJOBC: .ASCIZ /+ INVALID *JOB CARD +/ ERSPWN: .ASCIZ /+ FAILED TO DISPATCH COMMAND +/ ERREQU: .ASCIZ /+ JOB ABORTED BY REQUEST +/ .IF DF,B3$TIM ERTIME: .ASCIZ /+ TIME LIMIT EXCEEDED, JOB TERMINATED +/ .ENDC ; DF,B3$TIM .IF DF,B3$PAG ERPAGE: .ASCIZ /+ OUTPUT LIMIT EXCEEDED, JOB TERMINATED +/ .ENDC ; DF,B3$PAG ERCNTL: .ASCIZ /+ CONTROL CARD ERROR, JOB TERMINATED +/ ERSTAT: .ASCII /+ JOB TERMINATION DUE TO EXIT STATUS / ERSTA1: .ASCIZ /000000 +/ .EVEN ; ; Local data. ; SPSAVE: .BLKW 1 ; Saved stack pointer .PAGE .SBTTL CONTROL CARD TABLES ; ; Each control card table entry consists of two words: ; ; 1. The address of the ASCIZ control card keyword string, ; without the *. ; ; 2. The address of a service routine to execute the function ; requested by the string. ; ; CCTAB CTLTAB ; Start of table CCARD , FRCEOJ ; *EOJ forces an end-of-job CCARD , ECHO ; *ECHO echoes data records CCARD , NEWPAG ; *EJECT starts a new page CCARD , EXSCRD ; *EXSTAT specifies exit conditions CCARD , NOECHO ; *NOECHO turns off data echoes CCARD , NOISY ; *NOISY echoes command file records CCARD , NUMBER ; *NUMBER turns on page numbering CCARD , NONUMB ; *NONUMBER turns off page numbering CCARD , NEWPAG ; *PAGE starts a new page CCARD , PAUSE ; *PAUSE causes the job to pause CCARD , QUIET ; *QUIET turns off file echoes CCARD , WRICRD ; *WRITE writes text to logfile CCEND ; End of table ; ; Local data (control card). ; PAGCNT: .BLKW 1 ; Page count from *JOB card .PAGE .SBTTL MAIN LINE CODE ;+ ; **-$FILEP-File Processor. ; ; This routine performs the equivalent of what in a print ; spooler would be the printing of a file. That ; is, the file (sub-job) is executed. ; ;- $FILEP::MOV SP,SPSAVE ; Save stack pointer MOV #^RSYS,ORIGIN ; Set all SYS-class messages ; ; Copy the receive buffer to the process file buffer so that we can ; remember the information about this file (in the event of another ; receive data while this file is being processed). ; MOV #FILBUF,R0 ; Get file info. buffer address MOV #RCVBUF+4,R1 ; Get received info. address MOV #13.,R2 ; Number of words to copy 5$: MOV (R1)+,(R0)+ ; Move a word DEC R2 ; Done yet? BGT 5$ ; If GT no, loop ; ; Prepare FDB for opening command file. ; MOV #FILBUF,R1 ; Point to process file packet MOV #CMDFDB+F.FNB,R2 ; Point to sub-job filename block MOV Q$FDEV(R1),N.DVNM(R2) ; Insert device name CLR N.UNIT(R2) ; Insert unit number BISB Q$FUNT(R1),N.UNIT(R2) ; MOV Q$FNAM(R1),N.FNAM(R2) ; Insert filename (3 words) MOV Q$FNAM+2(R1),N.FNAM+2(R2); MOV Q$FNAM+4(R1),N.FNAM+4(R2); MOV Q$FTYP(R1),N.FTYP(R2) ; Insert filetype MOV Q$FVER(R1),N.FVER(R2) ; Insert version number DSAR$S ; Disable AST recognition MOV Q$FUFD(R1),R1 ; Get UFD for file CALL .WDFUI ; Write default UIC MOV #CMDFDB,R0 ; Put FDB address in R0 MOV R0,R1 ; Put filename block addr. in R1 ADD #F.FNB,R1 ; CALL .GTDID ; Enter directory info. in R1 ; ; Fill in text messages. ; MOV #SOFF,R0 ; Address for filespec. MOV #CMDFDB,R1 ; FDB address MOV FILBUF+Q$FUFD,R3 ; Get binary UFD for file CALL EXPFNM ; Expand filespec BITB #QF$DEL,FILBUF+Q$FATT ; Delete file at end of sub-job? BEQ 9$ ; If EQ no MOVB #'/,(R0)+ ; Yes, insert "/DE" MOVB #'D,(R0)+ ; MOVB #'E,(R0)+ ; 9$: CLRB (R0) ; Make it ASCIZ MOV #EOFF,R0 ; Get set to copy filespec MOV #SOFF,R1 ; 10$: MOVB (R1)+,(R0)+ ; Copy a byte BNE 10$ ; If NE not at end, loop ; ; Write start of sub-job message to history file. ; MOV #SOF,R1 ; CALL WRHIST ; ; ; Set the defaults for time, memory and output. ; .IF DF,B3$TIM MOV #$DFTIM,TIMLIM ; Set default time limit CLRB TIMERR ; Clear limit exceeded flag .ENDC ; DF,B3$TIM .IF DF,B3$MEM MOV #$DFMEM,MEMLIM ; Set default memory .ENDC ; DF,B3$MEM .IF DF,B3$PAG MOV #$DFPAG,PAGCNT ; Set default page count CLRB PAGERR ; Clear limit exceeded flag .ENDC ; DF,B3$PAG ; ; Open the command file. ; MOV JOBUIC,R1 ; Reset default UIC CALL .WDFUI ; OFNB$R #CMDFDB ; Open the file BCC 20$ ; If CC good MOV #EROPEN,R1 ; Get open failure message CALLR ERRPRO ; Process the error 20$: ; Ref. label ; ; Read the *JOB card and analyze it. ; GET$ R0,#CMDBUF,#CMDSIZ ; Read the *JOB card BCC 30$ ; If CC, good 22$: MOV #ERIOER,R1 ; Get I/O error message CALLR ERRPRO ; Go process the error 30$: MOV F.NRBD(R0),R1 ; Get record length BEQ 32$ ; If null, can't be *JOB CLRB CMDBUF(R1) ; Make it ASCIZ MOV #^RJOB,ORIGIN ; Make *JOB card a JOB class message MOV #CMDBUF,R1 ; Point to *JOB card CALL WRHIST ; Write to history file CALL JOBCRD ; Analyze *JOB card BCC 40$ ; If CC, all is well 32$: MOV #ERJOBC,R1 ; Error on *JOB card CALLR ERRPRO ; Process the error 40$: ; Ref. label .IF DF,B3$TIM!B3$MEM CALL SETUCB ; Set up UCB fields for MCR .ENDC ; DF,B3$TIM!B3$MEM .IF DF,B3$PAG MOVB SP,PAGFLG ; Switch on output limiting ADD PAGCNT,PAGLIM ; Include this sub-jobs' page limit .ENDC ; DF,B3$PAG ; ; Start the timer so that we can detect when the time limit has been ; exceeded. See the time limit AST routine in the root segment for ; details of how this works; also why the constant 545 appears below. ; .IF DF,B3$TIM .IF DF,B3$ACC CALL GETCPU ; Get CPU used so far MOV CPUTIM,CPUSOF ; Copy it for use by timer service MOV CPUTIM+2,CPUSOF+2 ; .IFTF MOV TIMLIM,R0 ; Get time limit in minutes MOV #<60.*K$$TPS>,R1 ; Number of ticks per minute CALL $MUL ; Convert to ticks MOV R0,TIMTIK ; Save the result MOV R1,TIMTIK+2 ; MOV TIMLIM,R0 ; Get time limit in minutes CMP R0,#545. ; Greater than 545 minutes? BLE 42$ ; If LE no MOV #545.,R0 ; Yes, set interval to 545 minutes 42$: MOV #60.,R1 ; Get number of seconds per minute CALL $MUL ; Convert minutes to seconds .IFT ADD #15.,R1 ; Allow 15 seconds overflow .ENDC ; DF,B3$ACC MOV R1,R2 ; Copy to R2 CALL SETTIM ; Start the timer .ENDC ; DF,B3$TIM ; ; Read subsequent cards from sub-job. ; 50$: DSAR$S ; Make sure AST recognition disbled 52$: TSTB CMDFLG ; Command already in buffer? BNE 62$ ; If NE yes, use it GET$ #CMDFDB,#CMDBUF,#CMDSIZ ; Read next command BCC 60$ ; If CC good CMPB #IE.EOF,F.ERR(R0) ; End of file? BNE 22$ ; If NE no, I/O error BR 90$ ; Normal end of file 60$: MOV F.NRBD(R0),R1 ; Get length of line BEQ 52$ ; If EQ, ignore null line CLRB CMDBUF(R1) ; Make it ASCIZ 62$: MOVB CMDBUF,R2 ; Get column 1 character CLRB EODFLG ; Show that data may be available CLRB CMDFLG ; Reset command buffer flag ; ; If this line is a data line, skip it without echoing in the history ; file. ; CMPB R2,#'* ; Control card? BEQ 64$ ; If EQ yes CMPB R2,#'$ ; CLI command? BNE 52$ ; If NE no, must be data 64$: ; Ref. label ; ; Echo lines in history file. Ignore command cards. ; TSTB QUIFLG ; *QUIET in effect? BEQ 66$ ; If EQ yes, don't echo MOV #^RJOB,ORIGIN ; Set JOB-class message MOV #CMDBUF,R1 ; Get card image address CALL WRHIST ; Write card image to history file 66$: CMPB CMDBUF+1,#SPA ; Comment card (space)? BEQ 52$ ; If EQ yes, don't try to execute it CMPB CMDBUF+1,#HT ; Comment card (tab)? BEQ 52$ ; If EQ yes TSTB CMDBUF+1 ; Comment card (EOL)? BEQ 52$ ; If EQ yes ; ; Look for control cards, and process if necessary. ; CMPB R2,#'* ; Control card? BNE 70$ ; If NE no CLRB ERRFLG ; Reset error flag CALL CTLCRD ; Yes, process it TSTB ERRFLG ; Invalid control card? BEQ 52$ ; If EQ no, get next command MOV #ERCNTL,R1 ; Yes, set message address CALLR ERRPRO ; and terminate the job 70$: ; Ref. label ; ; Dispatch command for execution. Wait for it to complete. ; ENAR$S ; Enable AST recognition MOV #CMDBUF+1,R0 ; Point R0 to ASCIZ command line ; (skip the $ sign in column 1) CALL GIVCLI ; Execute the command TSTB MCRERR ; Spawn error? BEQ 72$ ; If EQ no MOV #ERSPWN,R1 ; Failed to start the command CALLR ERRPRO ; Initiate error processing 72$: ; Ref. label ; ; Command may have been aborted if time limit was exceeded. We must ; check for this. ; .IF DF,B3$TIM TSTB TIMERR ; Time limit exceeded? BEQ 74$ ; If EQ no MOV #ERTIME,R1 ; Say time limit exceeded CALLR ERRPRO ; 74$: ; Ref. label .ENDC ; DF,B3$TIM ; ; Command may have been aborted because of too much output. ; .IF DF,B3$PAG TSTB PAGERR ; Output limit exceeded? BEQ 76$ ; If EQ no MOV #ERPAGE,R1 ; Say output limit exceeded CALLR ERRPRO ; 76$: ; Ref. label .ENDC ; DF,B3$PAG ; ; Command may have been aborted by request (user at terminal issued a ; command to cancel the job). ; TSTB ABOFLG ; Aborted by request? BEQ 78$ ; If EQ no MOV #ERREQU,R1 ; Yes, get message address CALLR ERRPRO ; 78$: ; Ref. label ; ; Check that the exit status satisfies the required conditions. ; CALL EXSCHK ; Check status BCC 50$ ; If CC, OK to continue MOV #ERSTA1,R0 ; Get place to stuff exit status MOV EXSBLK,R1 ; Get exit status MOV SP,R2 ; Include leading zeroes CALL $CBOMG ; Convert to octal MOV #ERSTAT,R1 ; Exit status caused an exit CALLR ERRPRO ; ; ; A normal end of sub-job was reached. ; 90$: CALL FCLOSE ; Close command file .IF DF,B3$TIM DIR$ #TIMOFF ; Cancel timer .ENDC ; DF,B3$TIM MOV #^RSYS,ORIGIN ; Set SYS origin code MOV #EOF,R1 ; Write end of sub-job message... CALL WRHIST ; ...to history file ENAR$S ; Enable AST recognition CALLR QMGEOF ; Send end-of-file to QMG... ; and return to await next file .PAGE .SBTTL *JOB CARD ANALYZER ;+ ; **-JOBCRD-*JOB card analyzer. ; ; This routine is called when a job starts to analyze the ; *JOB card, check for legality and extract the required ; information. ; ; Inputs: ; *JOB card is in CMDBUF buffer. ; ;- JOBCRD: MOV #CMDBUF,R0 ; Get address of *JOB card buffer MOV R0,R1 ; Copy it for in-place conversion MOV CMDFDB+F.NRBD,R2 ; Get length of line CALL $CVTUC ; Make it all upper case MOV #CMDBUF,R0 ; Get address of *JOB card buffer CMPB #'*,(R0)+ ; Does it start "*JOB"? BNE 78$ ; If NE no CMPB #'J,(R0)+ ; Maybe BNE 78$ ; If NE no CMPB #'O,(R0)+ ; Maybe BNE 78$ ; If NE no CMPB #'B,(R0)+ ; Maybe BNE 78$ ; If NE no .IF DF,B3$TIM!B3$MEM!B3$PAG ; ; Look for keyword on *JOB card. ; 50$: MOVB (R0)+,R1 ; Get next character BEQ 80$ ; If EQ, end of *JOB card CMPB R1,#SPA ; Was it a space? BEQ 50$ ; If EQ yes, ignore it CMPB R1,#HT ; Tab? BEQ 50$ ; If EQ yes, ignore it CMPB R1,#'! ; Start of comment? BEQ 80$ ; If EQ yes CMPB R1,#'; ; Comment? BEQ 80$ ; If EQ yes .IF DF,B3$TIM CMPB R1,#'T ; Time limit? BEQ 60$ ; If EQ yes .ENDC ; DF,B3$TIM .IF DF,B3$MEM CMPB R1,#'M ; Memory limit? BEQ 70$ ; If EQ yes .ENDC ; DF,B3$MEM .IF DF,B3$PAG CMPB R1,#'P ; Page limit? BEQ 75$ ; .ENDC ; DF,B3$PAG BR 78$ ; Otherwise error on *JOB card ; ; Extract time limit. ; .IF DF,B3$TIM 60$: MOVB (R0)+,R1 ; Get next character BEQ 78$ ; We were looking for "=" CMPB R1,#'= ; Equals sign? BNE 60$ ; If NE no, keep looking MOV #$MXTIM,R4 ; Set maximum allowed value CALL GETVAL ; Check value BCS 78$ ; If CS, error MOV R1,TIMLIM ; Save it CMPB #'M,R2 ; "minutes" unit? BNE 62$ ; If NE no MOVB (R0)+,R2 ; Yes, skip it 62$: TSTB R2 ; End of *JOB card? BEQ 80$ ; If EQ yes CALL ENDKEY ; End of keyword? BEQ 50$ ; If EQ yes BR 78$ ; No is error .ENDC ; DF,B3$TIM ; ; Extract memory limit ; .IF DF,B3$MEM 70$: MOVB (R0)+,R1 ; Get next character BEQ 78$ ; We were looking for "=" CMPB R1,#'= ; Equals sign? BNE 70$ ; If NE no, keep looking MOV #$MXMEM,R4 ; Set maximum allowed value CALL GETVAL ; Get and check the value BCS 78$ ; If CS, error MOV R1,MEMLIM ; Save it CMPB #'K,R2 ; "Kwords" unit? BNE 72$ ; If NE no MOVB (R0)+,R2 ; Yes, skip it 72$: TSTB R2 ; End of *JOB card? BEQ 80$ ; If EQ yes CALL ENDKEY ; End of keyword? BEQ 50$ ; If EQ yes BR 78$ ; Else error .ENDC ; DF,B3$MEM ; ; Validate page count. ; .IF DF,B3$PAG 75$: MOVB (R0)+,R1 ; Get next character BEQ 78$ ; We were looking for "=" CMPB R1,#'= ; Equals sign? BNE 75$ ; If NE no, keep looking MOV #$MXPAG,R4 ; Set maximum value CALL GETVAL ; Get and check the value BCS 78$ ; If CS, error MOV R1,PAGCNT ; Save it TSTB R2 ; End of *JOB card? BEQ 80$ ; If EQ yes CALL ENDKEY ; End of keyword? BEQ 50$ ; If EQ yes ; else fall through to 78$ .ENDC ; DF,B3$PAG .ENDC ; DF,B3$TIM!B3$MEM!B3$PAG 78$: SEC ; Show an error RETURN ; 80$: CLC ; *JOB card OK RETURN ; ;+ ; **-GETVAL-Get numeric value from *JOB card. ; ; Inputs: ; R0 Buffer pointer ; R4 Maximum allowable value ; ; Inputs: ; CC OK (value in R1) ; CS Error (value negative, zero or too big) ; ;- GETVAL: CALL $CDTB ; Get page limit TST R1 ; Sensible value? BLE 10$ ; Not if it's negative CMP R1,R4 ; Maybe too big BGT 10$ ; If GT, too big CLC ; Value OK RETURN ; 10$: SEC ; Value in error RETURN ; ;+ ; **-ENDKEY-Check for end of keyword on *JOB card. ; ; Inputs: ; R2 Character to check ; ; Outputs: ; Z-bit ;- ENDKEY: CMPB R2,#SPA ; End of keyword (space)? BEQ 10$ ; If EQ yes CMPB R2,#HT ; End of keyword (tab)? BEQ 10$ ; If EQ yes CMPB #',,R2 ; End of keyword (comma)? 10$: RETURN ; Return with Z-bit ;+ ; **-SETUCB-Set up UCB fields for MCR. ; ; This routine is called after the job card has been analyzed ; in order to set up the following fields in the batch stream ; UCB: ; ; 1. U.BMEM This 1-word field contains the memory limit ; for the job in 32-word blocks. ; ; 2. U.BPRI This 1-byte field contains the maximum priority ; that any task can execute with in this sub-job ; (unless it is privileged). ; ; Inputs: ; ; TIMLIM Time limit in minutes. ; MEMLIM Memory requirement in KW. ; ; ; The scheduling priority is calculated from the formula: ; ; $DXPRI ; Priority = --------------------- ; TIMLIM * MEMLIM ; ; The scheduling priority is never greater than 45. or less ; than 1. Note that this is very similar to the algorithm ; used to determine queueing priority when submitted. The ; constant $DXPRI is determined by the build command file. ; SETUCB: ; .IF DF,B3$TIM!B3$MEM MOV #$DXPRI,R0 ; Get constant value .IF DF,B3$TIM MOV TIMLIM,R1 ; Get time limit CALL $DIV ; Divide .ENDC ; DF,B3$TIM .IF DF,B3$MEM MOV MEMLIM,R1 ; Get memory requirement CALL $DIV ; Divide .ENDC ; DF,B3$MEM TST R0 ; Positive result? BGT 10$ ; If EQ yes MOV #1,R0 ; No, use priority of 1 BR 20$ ; 10$: CMP R0,#45. ; Greater than 45.? BLE 20$ ; If LE no MOV #45.,R0 ; Yes, use 45. 20$: MOV R0,R1 ; Copy to R1 .IFF MOV #5.,R1 ; All jobs run at priority 5 .IFTF MOV VTUCB,R0 ; Get UCB address MOVB R1,U.BPRI(R0) ; Save the result ; ; Set maximum partition size. ; .IF DF,B3$MEM MOV MEMLIM,R1 ; Get size in KW-blocks ASL R1 ; Convert to 32-word blocks ASL R1 ; ASL R1 ; ASL R1 ; ASL R1 ; MOV R1,U.BMEM(R0) ; Save in UCB .ENDC ; DF,B3$MEM RETURN ; Return to process job .ENDC ; DF,B3$TIM!B3$MEM .PAGE .SBTTL EXIT STATUS CHECKING ROUTINE ;+ ; **-EXSCHK-Check exit status. ; ; This routine is called after every MCR command to check the ; exit status returned. If it is OK according to the current ; values either defaulted or set up by the *EXSTAT card, the ; job is allowed to continue, otherwise it is terminated. ; ;- EXSCHK: TST EXSEQ ; *EXSTAT =n in effect? BEQ 10$ ; If EQ no, bypass check CMP EXSBLK,EXSEQ+2 ; Yes, does value match? BEQ 40$ ; If EQ yes, allow continuation 10$: TST EXSGT ; *EXSTAT >n in effect? BEQ 20$ ; If EQ no, bypass check CMP EXSBLK,EXSGT+2 ; Yes, good status? BGT 40$ ; If GT yes, allow continuation 20$: TST EXSLT ; *EXSTAT n ; *EXSTAT n", ; any exit status greater than "n" is OK, or less than for the ; "n and n CMPB (R0),#'> ; *EXSTAT >n? BEQ 10$ ; If EQ yes MOV #EXSLT,(SP) ; No, has to be