.MCALL .MODULE .MODULE KMOVLY, VERSION=147, COMMENT= ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only 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 except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. ;++ ; Facility: KMON Overlays ; ; Author: ; ; Abstract: ; ; ; Edit Who Date Description of modification ; ---- --- ---- --------------------------- ; 124 WFG 04-APR-90 Add support for SET CLI. ; ; 001 WLD 17-MAY-90 Added support for new monitor names. ; ; 128 WFG 2-AUG-90 .TRPSET in EXAMINE, DEPOSIT (OE:,OD:) ; ; 130 WFG 18-OCT-90 Shrink EXAM/DEP/BASE w/ common .TRPSET ; ; 131 WFG 19-OCT-90 Add command SET MOD [NO]SJ ; ; 136 WFG 31-MAY-91 Remove '.IF EQ SB' from .UNPROTECT ; in UNLOAD code routine UNLDIN ; 137 WFG 27-JUN-91 Action #7114, Prevent START cmd from ; starting a virtual job. ;-- .SbTtl Post Release Edit History ;+ ; ; (146/01) 23-Jun-95 Megan Gentry ; Corrections to DATE command to support RT epochs both in ; input and output. ; ; (146/02) 10-Sep-95 Megan Gentry ; More complete change so DATE command prints 4 digit year ; on output, accepts two- or four-digit year on input. Years ; below 1972 are invalid, as are years above 2099. Years ; 2000 and above must be specified using four-digit form. ; ; (147) 11-OCT-1997 Alan Frisbie ; One of the MBG changes broke the "No Date" message. This ; was fixed. ; ;- .IIF DF NLOVLY, .NLIST .NLIST CND .SBTTL ************************************** .SBTTL * Keyboard Monitor Overlays For The * .IF EQ .IF NE RTE$M .SBTTL * RT-11 Emulator (RTEM) Monitor * .IFF ;NE RTE$M .IF NE VENU$C .SBTTL * VENUS (VAX 8600) Console Monitor * .IFF ;NE VENU$C .IF NE SB .SBTTL * Single Background (SB) Monitor * .IFF ;NE SB .SBTTL * Foreground/Background (FB) Monitor * .ENDC ;NE SB .ENDC ;NE VENU$C .ENDC ;NE RTE$M .IFF ;EQ .IF EQ SUP$Y .IF NE SB .SBTTL * Extended Background (XB) Monitor * .IFF ;NE SB .SBTTL * Extended Memory (XM) Monitor * .ENDC .IFF ;EQ SUP$Y .IF NE SB .SBTTL * Supervisor and I-D Background (ZB) Monitor * .IFF ;NE SB .SBTTL * Supervisor and I-D (ZM) Monitor * .ENDC ;NE SB .ENDC ;EQ SUP$Y .ENDC ;EQ LE ,MESSAGE= .IRP N,<\OVLYN> OVSZ'N == < . - OVLYST > .ENDR . = OVLYST + < BK.BYT * OVLYSZ > .ENDC OVLYN = < OVLYN + OVLYSZ > .IRP N,<\OVLYN> .CSECT OVLY'N .ENDR OVLYST = . .ENDM OVERLAY ;+ ; This macro starts a KMON overlay command. ; It defines N.CMD to be the block number of the Monitor File ; in which the command resides, and O.CMD to be the (word) ; offset in the block at which the command starts ;- .MACRO OVCMD CMD N.'CMD = OVLYN O.'CMD = < . - OVLYST > CMD:: .ENDM OVCMD ;+ ; This macro generates a call from an overlay to the outside world. ; It computes the PC-relative offset from where the JSR would ; be if this block were actually in the KMON overlay area ;- .MACRO OJSR R,DEST,AT .IF B AT JSR R,-<.+4-OVLYST>(PC) .IFF JSR R,@-<.+4-OVLYST>(PC) .ENDC .ENDM OJSR .MACRO OCALL DEST,AT OJSR PC,DEST,AT .ENDM OCALL .MACRO OCALLR DEST JMP -<.+4-OVLYST>(PC) .ENDM OCALLR ;+ ; This macro is used to access locations outside the overlay ; region. The PC-relative address is set up as if the instruction ; were in the KMON overlay area. The first argument is the PDP-11 ; instruction to be executed followed by the general operands, then ; followed by outside section indicators. ; EX: ; OINST CLR @.BLKEY,,* ; OINST MOV #<2>,FORCEP,,* ; OINST MOVB FORCEP,R0,* ;- .MACRO OINST INST,OP1,OP2,FLG1,FLG2 .IF B FLG1 .IF B FLG2 .IF B OP2 INST OP1 .ERROR ;No cross section reference .IFF INST OP1, OP2 .ERROR ;No cross section reference .ENDC .IFF INST OP1, OP2-OVLY+OVLYST .ENDC .IFF .IF B OP2 INST OP1-OVLY+OVLYST .IFF .IF B FLG2 INST OP1-OVLY+OVLYST, OP2 .IFF INST OP1-OVLY+OVLYST, OP2-OVLY+OVLYST .ENDC .ENDC .ENDC .ENDM OINST ;+ ; This performs an ADDR macro from an overlay block of an address ; out in the real world ;- .MACRO OADDR ADR,REG,PUSH .IF IDN REG,SP MOV PC,-(SP) ADD #< - <.-OVLYST> >,@SP .IFF .IF B PUSH MOV PC,REG .IFF .IF IDN PUSH, ADD PC,REG .IFF JSR REG,@PC .ENDC .ENDC ADD #< - <.-OVLYST> >,REG .ENDC .ENDM OADDR ;+ ; This macro allows access to the INTON and INTOFF routines ; located in RMON, permitting overlays to enable and disable ; interrupts. ;- .MACRO OINTON ABC CLR -(SP) CALL ABC .ENDM OINTON .MACRO OINTOF ABC MOV #,-(SP) CALL ABC .ENDM OINTOF ;+ ; Comment for whats in next macro ; JSR R1,LAB ;Get address of COPY init params ; .WORD $NOFFS ;Offset to NO entry of current switch ; .WORD $SWTAD-SWTBAS ;Offset to switch table for command ; .WORD $SYN-STRBAS ;Offset to syntax table for command ; .WORD OPTXN-OPTBAS ;Offset to option text for command ; .BYTE $NONUM ;Highest 'NO' legal switch number ; .BYTE NUM ;Max number of legal file names for cmd ;- .MACRO ITBLE NUM,?LAB JSR R1,LAB .WORD $NOFFS .WORD < $SWTAD - OVLYST > + < OVLY - SWTBAS > .WORD < $SYN - OVLYST > + < OVLY - STRBAS > .IF EQ $$$1 .WORD 0 .IFF .IRP N,<\$OPTX> .WORD < OPTX'N - OVLYST > + < OVLY - OPTBAS > .ENDR .ENDC .BYTE $NONUM .BYTE NUM LAB: .ENDM ITBLE ;+ ; Macro to change priority from an overlay only ;- .IF EQ MMG$T .MACRO OSPL PRIO .IF NE PRIO MOV #,-(SP) .IFF CLR -(SP) .ENDC OCALL .$MTPS,* .ENDM OSPL .IFF ;EQ MMG$T .MACRO OSPL PRIO .IF NE PRIO MOVB #,@#PS .IFF CLRB @#PS .ENDC .ENDM OSPL .ENDC ;EQ MMG$T .SBTTL KMON Error Message Overlay OVERLAY .CSECT OVLYE ;Special error message overlay . = STADDR OVLYST = . OVCMD ERRCOD ;+ ; Modified for V4 to provide KMON messages with error levels ; On Entry: R5 = relative pointer to the error level byte for the message ; R5 + 1 = relative pointer to error message text ;- .ENABL LSB STADDR: .ADDR #,R5,ADD ;Point at the error message information BISB @R5,@#$USRRB ;Set the message error level MOVB (R5)+,R1 ;Get the error level .ADDR #,R0 ;Point at the level list 10$: TSTB (R0)+ ;Point at the next level ROR R1 ;Is this the correct level BCC 10$ ;No, go try the next MOVB @R0,KMLEV ;We've sought our own level .ADDR #,R0 ;Point at the FATAL text message .RCTRLO ;Turn on echo .PRINT ;Print message header MOV R5,R0 ;Get relative pointer to text OCALLR MSGKM1 ;Print the error and check levels ............ .DSABL LSB KMTXT: .ASCII "?KMON-" KMLEV: .ASCII "F-"<200> ;Prefix text string LEVLST: .ASCII "IWEFU" ;Error levels I,W,E,F,U OERBEG: ;Start of the error messages ............ .SBTTL KMON Runtime Error Message Overlay OVERLAY .CSECT OVLYE2 ;Special runtime error message overlay . = STADD2 OVLYST = . OVCMD RTERR ;+ ; Modified for V4 to provide KMON messages with error levels ; On Entry: R5 = relative pointer to the error level byte for the message ; R5 + 1 = relative pointer to error message text ; R4 = 0 provide DEV:FILENAME.EXT with message ; R4 <> 0 provide DEV: with message ;- .ENABL LSB STADD2: TST R4 ;Print just DEV: ? BNE 10$ ;No, print DEV:FILENAME.EXT OINST CLR INPFN+2,,* ;Clear the second word 10$: OADDR INPFN,R0 ;Point at the input filename .ADDR #,R1 ;Point at the output buffer CALL FNASC ;Convert this filename or device CLRB (R1)+ ;Close it off for the print BR OUTMSG ;Now output message ............ .DSABL LSB .ENABL LSB OVCMD BRTERR .ADDR #,R0 ;Point at the output ASCII block INC R4 ;Let's get loop straight 10$: MOVB -(R4),@R0 ;Straighten out harris's messages CMPB @R0,#<'a> ;convert it to UPPER case BLO 20$ CMPB @R0,#<'z> BHI 20$ BICB #40,@R0 20$: TSTB (R0)+ BNE 10$ ;Get that ASCIZ terminated too OUTMSG: .ADDR #,R5,ADD ;Point at the error message info BISB @R5,@#$USRRB ;Set the message error level MOVB (R5)+,R1 ;Get the error level .ADDR #,R0 ;Point at the error levels 30$: TSTB (R0)+ ;Get the next error level ROR R1 ;Is this the requested level ? BCC 30$ ;No keep searching MOVB @R0,KMLEV2 ;We've sought our own level .ADDR #,R0 ;Point at the fatal text message .RCTRLO ;Turn on echo .PRINT ;Print message header MOV R5,R0 ;Get relative pointer to text .RCTRLO ;Turn on echo .PRINT ;Print the message .ADDR #,R0 ;Point at the ASCII information OCALLR MSGKM1 ;Print the error and check levels ............ OUTFN: .BYTE <' > ;Output ASCII DEV:FILENAME.EXT .BLKB 14. .BYTE 0 .EVEN ............ .DSABL LSB .SBTTL FNASC - RAD50 Filename To ASCII Routine ;+ ; FNASC - Convert File Name to ASCII ; ; Convert RAD50 device/file name to "DDD:FILNAM.TYP" with blank suppression ; ; R0 -> file name ; R1 -> output buffer ; ; CALL FNASC ; ; R1 updated past the end of the converted file name ;- .ENABL LSB FNASC: MOV R1,R4 ;Copy pointer to buffer MOV R0,R3 ;Copy pointer to file name CALL 20$ ;Convert a word with blank suppression MOVB #<':>,(R1)+ ;Put in the ":" 10$: TST @R3 ;File name present? BEQ 40$ ;Nope, all done CALL 20$ ;Convert the file name CALL 20$ ; both words TST @R3 ;File extension present? BEQ 40$ ;No, skip rest MOVB #<'.>,(R1)+ ;Put in the "." 20$: MOV (R3)+,R0 ;Get the RAD50 word OCALL R50ASC ;Convert it to ASCII 30$: CMPB #<' >,-1(R1) ;Was the last character blank? BNE 40$ ;No, done DEC R1 ;Back over the blank CMP R1,R4 ;Done? BNE 30$ ;No, more trailing blanks 40$: RETURN ............ .DSABL LSB .ENABL LSB OVCMD RADERR OADDR INPFN,R3 ;Point at the input filename .ADDR #,R1 ;Point at the output buffer MOV (R3)+,R0 ;Get the RAD50 word OCALL R50ASC ;Convert it to ASCII MOV (R3)+,R0 ;Get the RAD50 word BEQ 10$ ;If nothing there just get out OCALL R50ASC ;Convert it to ASCII 10$: CLRB (R1)+ ;Close it off for the print CALLR OUTMSG ;Now output message ............ KMTXR: .ASCII "?KMON-" KMLEV2: .ASCII "F-"<200> ;Prefix text string LEVLT2: .ASCII "IWEFU" ;Error levels I,W,,E,F,U OERBG2: ;Start of the error messages ............ .DSABL LSB .IF NE CLOS$$!DATE$$!TIME$$ .SBTTL CLOSE/DATE/TIME Overlay OVERLAY .IF NE CLOS$$ ;If CLOSE command OVCMD CLOSE CALLR CLOSEO ............ .ENDC ;NE CLOS$$ .IF NE DATE$$ ;If DATE command .SBTTL DATE Command ;+ ; "Thirty days hath September, April, June, and November; ; All the rest have thirty-one, excepting February alone, ; And that has twenty-eight days clear ; And twenty-nine in each leap year." ; - Richard Grafton,"Abridgement of the Chronicles of England" ;- .ENABL LSB OVCMD DATE .ADDR #,R3 ;Point to list MOV R3,R0 ;Copy pointer to .GTIM area MOV R3,-(R0) ;Put in address TST -(R0) ;Point to parameter block EMT ...GTI ;Do .GTIM EMT .ADDR #,R4 ;Point to ASCII month names MOV @#$SYPTR,R0 ;Point to monitor TSTB @R5 ;Want to print it? BEQ 50$ ;Yah CMPB @R5,# ;In case he left off space BEQ 10$ ;Ok INC R5 ;No space, don't lose first digit 10$: CLR R1 ;Clear date accumulator JSR R3,NUMK ;Get day in R1 .BYTE <0.>, <31.-0.> SWAB R1 ;Put it in place ASR R1 ASR R1 ASR R1 INC R5 ;Fix and MOV R5,R3 ;Save ptr to -MON-YY 20$: ADD #<2000>,R1 ;Bump date to next month TSTB 1(R4) ;End of list ? BEQ 120$ ; Drat MOV R3,R5 ;Point R5 to given -MON- MOV R4,R2 ;Copy ptr into list CMP (R4)+,(R4)+ ;Advance for next time 30$: MOVB (R2)+,-(SP) ;Push character from table BICB #,@SP ;Make it uppercase MOVB -(R5),-(SP) ;Push given character BICB #,@SP ;Make it uppercase CMPB (SP)+,(SP)+ ;Are they the same? BNE 20$ ;Branch if not - try next month 40$: CMP R2,R4 ;Done 5? BLOS 30$ ;Keep trying CALL YEARK ;Get the year TSTB @R5 ;End of line? BNE 120$ ;No, error .ADDR #,R0 ;Point to list MOV #,@R0 ;Don't set the time MOV R1,-(R0) ;Do set the date MOV R0,SDTM+A.DTTM-(R0) ;Point argument block at list ADD #>,R0 ;Point to argument block EMT ...SDT ;Set the date, but not the time RETURN ............ ;+ ; Print the date ;- 50$: MOV DATES-$RMON(R0),R2 ;Get date from monitor data base BEQ 110$ ;If zero, give "No Date" ;147 MOV R2,R1 ;Make a copy of it BIC #^C,R1 ;Isolate the month field ASR R1 ; and right justify it ASR R1 ; ... SWAB R1 ; ... BEQ 120$ ;If zero, invalid month CMP R1,#12. ;Is it within range? BGT 120$ ;Nope... DEC R1 ;Make month range 0-11 (not 1-12) MOV R2,R0 ;Make another copy BIC #^C,R0 ;Isolate the day ASL R0 ; and right justify it ASL R0 ; ... ASL R0 ; ... SWAB R0 ; ... BEQ 120$ ;If zero, invalid day MOV R2,-(SP) ;Make another (temp) copy BIC #^C,@SP ;Isolate the RT epoch BIC #^C,R2 ;Isolate the year SWAB @SP ;Right justify ASL @SP ; ... ASL @SP ; ... SWAB @SP ; ... BEQ 70$ 60$: ADD #32.,R2 ;Increase by an epoch 70$: DEC @SP BGT 60$ TST (SP)+ ;Discard count... ADD R1,R4 ;Add in month offset MOVB (R4),-(SP) ;Get the month's length SUB R1,R4 ;Restore R4... CMP R1,#1 ;Is this february? BNE 80$ ;Nope, leave length alone ; ** NOTE ** Leap years are those years divisible by 4, but not ; by 100, unless they are also divisible by 400. ; In the range supported by RT (1972 - 2099), all years ; divisible by 4 are leap years (including 2000) BIT #^B<11>,R2 ;Is this a leap year? BNE 80$ ;Nope... INC @SP ;Yes, bump length 80$: CMPB R0,(SP)+ ;Is the day number valid? BGT 120$ ;Nope... CALL R10ONF ;Print the day ASL R1 ;Shift for month string ASL R1 ; ... ADD R1,R4 ;R4 -> month string MOV #5,R1 ;R1 = Length of string to print 90$: .TTYOU (r4)+ ;Print a month character SOB R1,90$ ; and loop if more to print... MOV #19.,R0 ;R0 = First two digits of year MOV R2,-(SP) ;@SP = Year - 1972 ADD #72.,@SP ;Adjust for RT base year (year - 1900) CMP @SP,#100. ;Is it into 2000? BLT 100$ ;Not yet... INC R0 SUB #100.,@SP ;Yes, so reduce by 100 100$: CALL R10OUT ;Print the first two digits MOV (SP)+,R0 ;Get the last two digits CALL R10OUT ; and print them K0CRLF: OCALLR KCRLF ;Print CR LF and exit ............ ;+ ;ERROR 110$: KMEROR ,,WARN$ ;Non-fatal ............ 120$: .IF EQ CONT$N KMEROR ;Fatal ............ .IFF ;EQ CONT$N KMEROR ,,WARN$ ;Non-fatal ............ .ENDC ;EQ CONT$N ;- NUMK: OCALL DECNUM ;Get a number from the command string MOVB (R3)+,R2 ;Get low limit SUB R2,@SP ;Decrease number BLE 120$ ;Too bad, below low limit MOVB (R3)+,R2 ;Get upper limit CMP @SP,R2 ;Too big? BGT 120$ ;Error if so ADD (SP)+,R1 ;Add it in to date word RTS R3 ............ YEARK: OCALL DECNUM ;Get a number from the command string CMP @SP,#100. ;Is it a two-digit year? BLT 130$ ;Yes... CMP @SP,#1972. ;No, is it a valid year? BLT 120$ ;Nope... CMP @SP,#2099. ;Maybe, check upper limit BGT 120$ ;Nope... SUB #1900.,@SP ;Reduce for epoch/year determination 130$: SUB #72.,@SP ;Reduce by RT base year BMI 120$ ;Anything below 1972 is invalid 140$: SUB #32.,@SP ;Deduct an epoch BMI 150$ ;We've found the correct one... ADD #^O<40000>,R1 ;Not in this one, try again... BR 140$ 150$: ADD #32.,@SP ;Correct the year ADD (SP)+,R1 ; and add it in RETURN ............ .DSABL LSB .ENDC ;NE DATE$$ .IF NE TIME$$ ;If TIME command (for next page) .SBTTL TIME Command .ENABL LSB OVCMD TIME OTIME: MOV @#$SYPTR,R0 ;Point to monitor ADD #,R0 ;Point to configuration word TST @R0 ;Did the bootstrap find a clock? BPL 130$ ;No, tell him so BIT #,@R0 ;Is it a 50-cycle clock? BEQ 10$ ;No, 60 cycles MOVB #,90$ ;Yes, set 50 cycles ... MOVB #,CLKFRQ ; ... to use for time conversion 10$: .ADDR #,R3 ;Point to list MOV R3,R0 ;Copy pointer to .GTIM area MOV R3,-(R0) ;Put in address TST -(R0) ;Point to parameter block EMT ...GTI ;Do .GTIM EMT TSTB @R5 ;Want to print it? BEQ 80$ ;Yah CMPB @R5,#<' > ;In case he left off space BEQ 20$ ;Ok INC R5 ;No space, don't lose first digit 20$: CMP (R3)+,(R3)+ ;Bump time pointer CLR R1 ;Clear timer accumulator CLR -(SP) ; in R1/@SP 30$: OCALL DECNUM ;Get next value MOVB (R3)+,R4 ;Get maximum for it CMP R4,@SP ;Too big? BLOS 120$ ;Yes, error CMPB @R5,(R3)+ ;Proper delimiter? BEQ 40$ ;Yes, okay TSTB @R5 ;Is it the null byte? BNE 120$ ;If not, bad syntax INC R5 ;Keep using null for other fields 40$: ADD (SP)+,@SP ;Add low order time into accumulator ADC R1 ;Carry into high order MOVB @R3,R4 ;End of time? BEQ 60$ ;Yes, go store it MOV R1,R2 ;No, multiply time by factor MOV @SP,R0 ;Copy time to R2/R0 50$: DEC R4 ;Done multiply? BEQ 30$ ;Yes ADD R0,@SP ;No, add multiplier to low order ADC R1 ;Carry to high order ADD R2,R1 ;Add high order multiplier BR 50$ ;Loop for more ............ 60$: MOV @#$SYPTR,R0 ;Point to the RMON base .IF NE TIME$R SUB TMRLST+TIM.LO,@SP ;Subtract current time of day ... SBC R1 ; ... from newly set time of day to ... SUB TMRLST+TIM.HI,R1 ; ... get amount by which time changes ADD (SP)+,$TIME+TIM.LO-$RMON(R0) ;Add change in time to ... ADC R1 ; ... time additive factor ... ADD R1,$TIME+TIM.HI-$RMON(R0) ; ... in RMON .IFF ;NE TIME$R OSPL 7 ;Prevent interrupts MOV (SP)+,$TIME+TIM.LO-$RMON(R0) ;;; Put new time ... MOV R1,$TIME+TIM.HI-$RMON(R0) ;;; ... into monitor OSPL 0 ;;; Allow interrupts .ENDC ;NE TIME$R RETURN ............ 80$: MOV (R3)+,R1 ;Get time of day MOV (R3)+,R2 ;Low order in R2 JSR R4,DIVIDE ;First divide out the ticks/second 90$: .WORD HZ.60 MOV R5,R0 ;Put -1 in R0 for flag MOV #<3>,R3 ;Loop 3 times 100$: MOV R0,-(SP) ;Save remainder (or flag) JSR R4,DIVIDE ;Divide by 60. .WORD 60. SOB R3,100$ ;Loop until division done 110$: CALL R10OUT ;Print the number in R0 MOV (SP)+,R2 ;Get next value BMI 140$ ;If negative, done .TTYOUT #<':> ;Put out a separator MOV R2,R0 ;Copy value BR 110$ ;Loop ............ 120$: ;+ ;ERROR .IF EQ CONT$N KMEROR ;Fatal ............ .IFF ;EQ CONT$N KMEROR ,,WARN$ ;Non-fatal ............ .ENDC ;EQ CONT$N 130$: KMEROR ,,WARN$ ;Non-fatal ;- ............ 140$: OCALLR KCRLF ;Print CR LF ............ .DSABL LSB .ENDC ;NE TIME$$ .IF NE DATE$$!TIME$$ .SBTTL R10OUT - Decimal Output And Conversion .ENABL LSB R10ONF: CMP #<10.>,R0 ;Is the number one digit? BHI 20$ ;Yes, put it out as one R10OUT: SWAB R0 ;Put number in high byte 10$: ADD (PC)+,R0 ;Subtract 10 from high, add 1 to low .BYTE <1>,<-10.> BPL 10$ ;Loop until overflow ADD (PC)+,R0 ;Fix both bytes, ASCIIfy the low .BYTE <<'0>-1>,<10.> .TTYOUT ;Print high digit SWAB R0 ;Get other digit 20$: ADD #<'0>,R0 ;ASCIIfy it .TTYOUT ;Print low digit RETURN ............ .DSABL LSB .SBTTL DIVIDE - 32-bit Division Routine .ENABL LSB DIVIDE: CLR R0 ;Clear remainder MOV #<31.>,R5 ;32. bits to shift 10$: ASL R2 ;Double precision divide ROL R1 ;Double shift ... ROL R0 ; ... left by 1 CMP R0,@R4 ;Does it go into dividend? BLO 20$ ;No SUB @R4,R0 ;Yes, subtract divisor INC R2 ;Increment quotient 20$: DEC R5 ;Done loop? BPL 10$ ;No TST (R4)+ ;Push over radix RTS R4 ............ .DSABL LSB SDTM: .BYTE ..SDTT, .SDTTM ;Area block for .SDTTM call .WORD 0 ;Pointer to date and time list ............ .NLIST BEX ..MNTH ==: < . > ;**PATCH** "-Jan-Feb-..." Month names in ASCII MONTHS: .ASCIZ "-Jan-Feb-Mar-Apr-May-Jun-Jul-Aug-Sep-Oct-Nov-Dec-" .EVEN MONTAB: .BYTE 31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31. .LIST BEX ............ .BYTE ..GTIM, .GTIM ;Area block for .GTIM call .WORD 0 ;Pointer to area to receive time TMRLST: .WORD 0, 0 ;Area for time ............ .BYTE 24., <':>, 60., <':>, 60., <'.> CLKFRQ: .BYTE HZ.60, 377, 0 .EVEN ............ .ENDC ;NE DATE$$!TIME$$ .IF NE CLOS$$ ;If CLOSE command (for next page) .SBTTL CLOSE Command .ENABL LSB CLOSEO: TSTB @R5 ;End of line? BNE 120$ ;No, invalid command CLR R2 ;Clear action flag CLR R4 ;Clear maximum handler size to fetch 10$: MOV @#$SYPTR,R3 ;Point to RMON ADD #<$CSW-$RMON>,R3 ;Point to channel table MOV (PC)+,R5 ;Set up Channel 0 CLOSE .CLOSE 0 ;Prototype CLOSE 20$: MOV @R3,R0 ;Test if a file exists on channel BPL 60$ ;Skip ICHANNEL if no file there BIC #^c,R0 ;Isolate handler index ADD @#$SYPTR,R0 ;Point to permanent name ADD #<$PNAME-$RMON>,R0 ; in monitor table OINST MOV @R0,INPFN,,* ;Save the device name in case of error TST R2 ;Action flag set? BNE 40$ ;Yes, time to do the actual CLOSE OADDR DEVSTS,SP ;No, find size of handler EMT ...DST ;V1 .DSTAT (must do this way or expnsion wrng) BCS 110$ ;Error, no device (??) TST 4(R0) ;Is device resident? BNE 30$ ;Yes, don't need size MOV 2(R0),R0 ;No, get handler size CMP R0,R4 ;Is this larger than previous largest? BLOS 30$ ;No, ignore it MOV R0,R4 ;Yes, remember the largest handler size 30$: BR 60$ ;Go bump channel counter ............ ;+ ; Second pass thru actually FETCHes drivers for CLOSEs ;- 40$: MOV R0,-(SP) ;Save pointer to device name OADDR DEVSTS,SP ;Get device status again EMT ...DST BCS 110$ ;Invalid device error MOV R0,R1 ;R1->Device status info TST 4(R1) ;Is the handler resident? BNE 50$ ;Yup, no need to fetch it .SERR ;Nope, do SERR to catch fatal FETCH error MOV @SP,R0 ;Point to device name .FETCH R4 ;FETCH it into block we got BCS 100$ ;Error in FETCH .HERR ;Back to normal error processing 50$: MOV R5,@PC ;Move '.CLOSE X' in line HALT ;(gets a .CLOSE EMT) BCS 130$ ;Error, protected file MOV (SP)+,R0 ;Point to device name again TST 4(R1) ;Was the handler fetched? BNE 60$ ;No, it was resident, don't release it .RELEASE ;Release the driver 60$: INC R5 ;Bump channel number in CLOSE ADD #,R3 ; and pointer into channel area CMP R5,(PC)+ ;Done channels 1-17? .CLOSE 20 BLO 20$ ;No, do more TST R2 ;Yes, what pass are we on? BNE 80$ ;If second, we're done now MOV R4,R0 ;First pass, so get largest handler size BEQ 70$ ;Zero means no FETCHes required OINST MOV SP,@.EXTFL,,* ;Turn off ^C while we get memory OCALL GETBLK ;Get a block of memory for handlers BCC 70$ ;KMON didn't move SUB R0,@SP ;KMON moved, relocate return address 70$: OINST CLR @.EXTFL,,* ;Re-enable ^C MOV SP,R2 ;Indicate we're on second pass BR 10$ ;Loop back to FETCH drivers and do CLOSEs ............ ;+ ; Done second pass-clean up and exit ;- 80$: TST R4 ;Any memory gotten? BEQ 90$ ;No, none to give back OINST MOV SP,@.EXTFL,,* ;Yes, disable ^C for time being OCALL PUTBLK ;Put back the memory BCC 90$ ;KMON didn't move ADD R0,@SP ;KMON moved, relocate return address 90$: OINST CLR @.EXTFL,,* ;Re-enable ^C .SRESET ;Clear out all handlers again RETURN ............ ;+ ; FETCH error detected, determine which one ;- 100$: OCALL PUTBLK ;Return to free core list TSTB @#$ERRBY ;Is it a fatal FETCH error? BPL 110$ ;No, just invalid device OCALLR BADFET ;Yes, give proper message ............ 110$: OCALLR BADHAN ............ 120$: OCALLR BADCOM ;Invalid command ............ ;+ ;ERROR 130$: KMEROR ,,WARN$ ;- ............ .DSABL LSB .ENDC ;NE CLOS$$ .ENDC ;NE CLOS$$!DATE$$!TIME$$ .SBTTL LOAD Overlay OVERLAY .ENABL LSB .IF NE FRUN$$!SRUN$$ OVCMD FSR3 CALLR FSRU3 ............. .ENDC ;NE FRUN$$!SRUN$$ .IF NE LOAD$$ .SBTTL LOAD Command ;+ ; LOAD command ;- SYNTAX LOAD PROMPT $DEVICE REQBLNK END ............ SWITS LOAD ENDNO NOS ENDS ............ OVCMD LOAD ITBLE 0 ;Set maximum number of file specs OCALL INITIT ;Do the parse MOV R5,R2 ;R2 -> old string pointer MOV R5,R3 ;R3 -> new string pointer 10$: MOVB -(R2),-(R3) ;Get character in buffer BEQ OLOAD ;End of line - branch out CMPB #<' >,@R2 ;Space character? BNE 10$ ;No, get next character TSTB (R3)+ ;Adjust new string pointer - skip space BR 10$ ;Branch to get next character ............ ;+ ; Get device info from the command line ;- OLOAD: OADDR DEVSTS,R2 ;Point to buffer area OCALL GETNAM ;Get device name OCALL OPTCOL ;Check for optional colon .ENDC ;NE LOAD$$ OVCMD OL1 CALL MAPIT1 ;Map user name to physical name CLR FTEMP ;No memory allocated to handler yet ;+ ; Get ownership info from the command line ;- .IF NE OWN$ER .IF EQ SYT$K CLR R3 ;Initialize job to not owned CMPB #<'=>,@R5 ;Owner assignment coming up? BNE 70$ ;No, set to unowned BICB #,-(R5) ;Convert F or B to uppercase CMPB #<'B>,@R5 ;Background? BEQ 20$ ;Yes, owner is 0+1 CMPB #<'F>,@R5 ;Foreground job? BNE IMSG3 ;No, error TST (R3)+ ;Foreground, set owner to 2+1 20$: INC R3 ;Set up job number + 1 to ensure non-0 value DEC R5 ;Skip over B or F .IFF ;EQ SYT$K MOV #<-1>,R3 ;Initialize job to not owned CMPB #<'=>,@R5 ;Owner assignment coming up? BNE 70$ ;No, leave it unowned MOV R2,-(SP) ;Save R2 (CKLJN1 ruins it) CALL CKLJN1 ;Check out logical job name BNE 30$ ;Good, job exists DEC R5 ;Skip over "=" MOV R5,R4 ;Point to invalid name to print CLRB @R3 ;Make job name ASCIZ for KMRTMG ;+ ;ERROR KMRTMG ,, ;- ............ 30$: MOV (SP)+,R2 ;Restore R2 .ENDC ;EQ SYT$K .ENDC ;NE OWN$ER ;+ ; Check to be sure that handler is not already resident ;- 70$: MOV @R2,-(SP) ;Save device name OINST MOV @R2,INPFN,,* ;Save for error reporting too .DSTAT R2,R2 ;Get device status BCS IMSG1 ;Error TST DS.ADR(R2) ;Already resident? BNE 130$ ;Yes, check ownership if we have owner support MOV (SP)+,@R2 ;Put device name in work area ;+ ; Get size of the handler, then allocate memory and FETCH it ;- MOV DS.HSZ(R2),R0 ;Pick up handler size (in bytes) MOV R2,-(SP) ;Save work area address MOV R3,-(SP) ;Save job number MOV SP,@<.EXTFL-OVLY>-<.+4-OVLYST>(PC) ;Inhibit CTRL/C OCALL GETBLK ;Get memory for handler MOV (SP)+,R3 ;Restore job number BCC 80$ ;Did the KMON move? SUB R0,R5 ;Yes, relocate command string address ... SUB R0,2(SP) ; ... and return address from command ... SUB R0,@SP ; ... and work area address 80$: .SERR ;Catch fatal FETCH errors MOV @SP,R0 ;Point to device name again .FETCH R4 ;Get handler into memory BCS IMSG0 ;Error, no handler (or hardware error) .HERR ;Turn off .SERR MOV R4,FTEMP ;Save handler location for error recovery ;+ ; Protect the vectors of the newly-LOADed device handler ;- CLR -(SP) ;Assume fixed vector(s) MOV (R4)+,R2 ;Get vector address BPL 110$ ;No vectors or one fixed vector ASL R2 ;Multi-vectors, make a word offset ADD R2,R4 ;Point to table of vectors MOV (R4)+,R2 ;Get a vector (or vector offset) BPL 100$ ;Branch if a list of fixed vectors MOV (R4)+,@SP ;Get hardware ID for PRO option slot device MOV @#$SYPTR,R2 ;R2 -> $RMON CALL @GETVEC-$RMON(R2) ;@SP = vector A of option slot device BCS IMSG0X ;If cannot find device, take error exit 90$: MOV (R4)+,R2 ;Get a vector (or vector offset) 100$: ADD @SP,R2 ;Add in base vector (0 if fixed vector(s)) 110$: BLE 120$ ;Branch if no more vectors MOV R4,-(SP) ;Save vector table address MOV #<1>,R4 ;Protect two words MOV @#$SYPTR,R0 ;Point to map of permanently protected vectors ADD #,R0 ; in the RMON OCALL SETBT2 ;Call SETBIT to protect vector MOV (SP)+,R4 ;Restore vector table address CMP (R4)+,(R4)+ ;Point to next vector or vector offset BR 90$ ;Do another vector ............ 120$: TST (SP)+ ;Get rid of base vector from stack MOV (SP)+,R2 ;Point to buffer again BR 70$ ;Get status again and do ownership ............ IMSG3: OCALLR BADCOM ; ............ IMSG0X: TST (SP)+ ;Get rid of base vector from stack MOV FTEMP,R4 ;R4 -> start of handler IMSG0: OCALL PUTBLK ;Return memory to the monitor TSTB @#$ERRBY ;Is it fatal FETCH error? BPL IMSG1 ;No, just invalid device OCALLR BADFET ;Yes, give proper message ............ IMSG1: OCALLR BADHAN ............ ;+ ; Handler is already in memory. ; ; Use this routine if there's an error now. ;- ;>>> THIS CODE IS UNREFERENCED!!!!!!! MOV FTEMP,R4 ;R4 -> allocated memory (if any) BEQ IMSG3 ;None, just issue error OCALL PUTBLK ;Return the handler memory BR IMSG3 ;Issue invalid command error ............ 130$: .IF NE OWN$ER MOV LDUNIT,R4 ;R4 = unit number specified in command MOV LDINDX,R1 ;R1 = $PNAME index of handler to load ;+ ; Got unit number in R4. Now check to see if it is the system ; unit of the system device type, which cannot be attached. ;- 140$: MOV @#$SYPTR,R0 ;Point to the RMON CMP R1,SYINDX-$RMON(R0) ;Is this load of the system device? BNE 150$ ;No, go on TST R3 ;Are we attempting ownership? .IF NE SYT$K BMI 150$ ;No, continue ... .IFF ;NE SYT$K BEQ 150$ ;No, continue ... .ENDC ;NE SYT$K CMPB SYUNIT+1-$RMON(R0),R4 ;Yes, system unit? BEQ IMSG1 ;Yes, can't attach ;+ ; Unit number is known. Set up mask and prepare ; job ID for insertion in $OWNER table. ;- 150$: .IF NE SYT$K INC R3 ;Bump job number .ENDC ;NE SYT$K BIT #,@R2 ;File-structured device? BEQ 160$ ;No, assign all units MOV #<17>,FTEMP ;Set mask for low nibble for even unit CLC ;Rotate a zero bit in ROR R4 ;Unit#/2 = byte number within $OWNER BCC ESRCH ;Even unit, all set ASL R3 ;Odd unit, so ... ASL R3 ; ... move job ID ... ASL R3 ; ... code to ... ASL R3 ; ... high half byte COMB FTEMP ;Set mask for high half byte BR ESRCH ;Go do assignment ............ ;+ ; For Non-File-Structured devices, assign ALL units to this job ;- 160$: TST R3 ;Make all units unassigned? BEQ ESRCH ;Yes, go on .IF EQ SYT$K DEC R3 ;Assign to whom: F or B? BEQ 170$ ;Must be B MOV #^b<0010001000100010>,R3 ;Assign all units 170$: ADD #^b<0001000100010001>,R3 ;Set mask to 4 F or B nibbles .IFF ;EQ SYT$K MOV R3,R0 ;Copy job number + 1 SWAB R0 ;Move it to the high byte BIS R0,R3 ;Job number in high and low bytes MOV R3,R0 ;Copy low/high ASL R3 ;Shift low and high bytes left ... ASL R3 ; ... to put job number ... ASL R3 ; ... in high nibbles ... ASL R3 ; ... of low and high bytes BIS R0,R3 ;Merge for four nibbles .ENDC ;EQ SYT$K ;+ ; Now search $ENTRY for all entries matching the specified device entry ; and assign ownership to them. If needed, find extended $OWNER table in ; the memory-resident handler and fill it in. ;- ESRCH:: MOV LDINDX,R1 ASL R1 ;Index*2 for $OWNER index OINST ADD .$OWNE,R1,* ;Point into $OWNER table for this unit .IF NE UNI$64 CMP @R1,# ;Is it a 64-unit handler? BNE 180$ ;No MOV 2(R1),R1 ;Point to 64-unit owner table MOV #<16.>,R0 ;Set all 64. units owned BR 190$ 180$: .ENDC ;NE UNI$64 MOV #<2.>,R0 ;Set all 8. units owned 190$: BIT #,@R2 ;File structured device? BEQ 200$ ;No, assign all units ADD R4,R1 ;Index up to byte to modify BICB FTEMP,@R1 ;Clear old owner BISB R3,@R1 ;Insert new owner BR 210$ ;Done with this entry ............ 200$: MOV R3,(R1)+ ;Fill in ownership table ... SOB R0,200$ ; ... for all units of device 210$: .ENDC ;NE OWN$ER .BR 215$ ............ 215$: TST (SP)+ ;Done with this device. Clear stack CLR @<.EXTFL-OVLY>-<.+4-OVLYST>(PC) ;Enable CTRL/C .IF NE LOAD$$ CMPB @R5,#<',> ;More devices coming? BEQ 220$ ;Yes, go do it .IF EQ OWN$ER CMPB @R5,#<'=> ;Owner assignment coming up? BEQ 230$ ;Yes, go warn the user that no ownership ;table exists .ENDC ;EQ OWN$ER .ENDC ;NE LOAD$$ TSTB @R5 ;No, end of command string? BNE IMSG4 ;No, syntax error RETURN ............ .IF NE LOAD$$ 220$: CALLR OLOAD ............ .ENDC ;NE LOAD$$ ;+ ;ERROR .IF EQ OWN$ER 230$: KMEROR ,,WARN$ .ENDC ;EQ OWN$ER ;- FTEMP: .WORD 0 ;Temporary store ............ .DSABL LSB ;+ ; MAPIT1 - Map user's device name to assigned physical device name, if any ; ; R2 -> device name from user (RAD50) ; ; CALL MAPIT1 ; ; R1 = undefined ; R2 -> physical name if user's name was logical ; R3 = undefined ;- .ENABL LSB MAPIT1: OINST MOV @R2,INPFN,,* ;Save for error reporting too MOV R5,-(SP) ;Save R5 MOV R2,-(SP) ;Save R2 MOV R2,R0 ;Point at name CLC ;Indicate doing logical translation OJSR R4,.LK4DV,@ ;Do the translation BR IMSG4 ;Error return ...... .IF NE OWN$ER MOV R1,LDUNIT ;Save unit # MOV R3,LDINDX ;Save index .ENDC ;NE OWN$ER MOV (SP)+,R2 ;Restore R2 MOV (SP)+,R5 ;Restore R5 RETURN ............ IMSG4: OCALLR BADCOM ;Invalid command ............ .IF NE OWN$ER LDUNIT: .WORD 0 ;Device unit specified (numeric) LDINDX: .WORD 0 ;Index of device specified in $PNAME table ............ .ENDC ;NE OWN$ER .DSABL LSB .IF NE SYT$K ;+ ; CKLJN1 - Check an entry in the command string for being logical job name ; ; R5 -> command string ; ; CALL CKLJN1 ; ; R2 -> impure area of job ; R3 = job # (if job exists) ; R4 -> job's impure pointer if job exists ; = 0 if job doesn't exist ; R5 = current command string pointer ; ; Condition codes set based on contents of R4 ;- .ENABL LSB CKLJN1: MOV R5,(PC)+ ;Save command text pointer R5STA1: .WORD 0 .ADDR #,R0 ;Point to work space for fwd ASCII name CLR -(R0) ;Zero out the ... CLR -(R0) ; ... forward ASCII ... CLR -(R0) ; ... work space MOV R0,-(SP) ;Save the pointer MOV #,R1 ;R1 = maximum number of characters in name TSTB -(R5) ;Check first character BNE 20$ ;Non-null is ok BR IMSG4 ;Null name is an error ............ 10$: TSTB -(R5) ;All done with command string? BEQ 30$ ;Yes CMPB #<',>,@R5 ;No, are we at a comma? BEQ 30$ ;Yes, we're done with the name 20$: MOVB @R5,(R0)+ ;Move character to work space SOB R1,10$ ;Loop to do all 6 characters yet DEC R5 ;Move command pointer past last character MOV R5,R3 ;R3 -> after name 30$: MOV (SP)+,R0 ;Point R0 to job name text MOV R5,-(SP) ;Save command text pointer (FNDJOB uses it) MOV @#$SYPTR,R5 ;Point to RMON ADD #<$IMPUR-$RMON>,R5 ; at start of impure table MOV R5,(PC)+ ;Save for later IMSTA1: .WORD 0 ;Impure table start address CLR R4 ;Initially, assume no job CALL FNDJOB-$IMPUR(R5) ;Check out job name BEQ 40$ ;No such job, return R4=0 MOV R5,R4 ;Copy job's $IMPUR table pointer SUB IMSTA1,R5 ;Calculate job number MOV R5,R3 ;Return it in R3 BR 50$ ;Merge... ............ 40$: MOV R5STA1,@SP ;No such job, reset command text pointer 50$: MOV (SP)+,R5 ;Restore text pointer TST R4 ;Set condition code bits RETURN ............ NBUFF1: .BLKW L.LJNM/2 ;Fwd ASCII job name work area ............ .DSABL LSB .ENDC ;NE SYT$K .IF NE FRUN$$!SRUN$$ ;+ ; We come here as the next to last stop in processing FRUN/SRUN commands. ; This code won't fit in the other two FRUN/SRUN overlays so that's why it's ; here. The code here checks that the job isn't trying to context switch ; BPT, IOT, or TRAP vectors when they are protected in LOWMAP. This isn't ; actually necessary for virtual jobs since the context switch code for ; them calls FIXTRP to forward these vectors to the job's virtual vectors. ; But, it doesn't harm anything. ; ; Don't modify the stack because data is needed by next code at STRTPG ; ; Contents of the stack: ; ; SP -> STMPUR ; Job number ; Job low limit ; Job high limit ; Load address ; /PAUSE switch (load addr) ;- FSRU3: MOV @SP,R3 ;R3 -> job's impure area MOV @#$SYPTR,R2 ;R2 -> $RMON MOV (R2),R2 ;Get LOWMAP bytes for BPT, IOT, and TRAP .IF EQ MMG$T MOV I.SP(R3),R3 ;Get saved SP of job .IF EQ MTT$Y ADD #30,R3 ;R3 -> just above BPT save area on stack .IFF ;EQ MTT$Y ADD #32,R3 ;R3 -> just above BPT save area on stack .ENDC ;EQ MTT$Y .IFF ;EQ MMG$T ADD #,R3 ;R3 -> just above BPT save area in impure area .ENDC ;EQ MMG$T JSR R1,10$ ;Get PIC pointer to data table in R1 .WORD V.BPT, ^B0000000000000010 .WORD V.BPT+2, ^B0000000000000001 .WORD V.IOT, ^B1000000000000000 .WORD V.IOT+2, ^B0100000000000000 .WORD V.TRAP, ^B0000001000000000 .WORD V.TRAP+2,^B0000000100000000 .WORD 0 ......... 10$: MOV (R1)+,R4 ;Get vector address BEQ 20$ ;Branch if no more in data table TST -(R3) ;R3 -> corresponding saved context for vector BIT (R1)+,R2 ;Is vector protected by LOWMAP? BEQ 10$ ;Branch if it isn't MOV @R4,@R3 ;Else change saved context to current value BR 10$ ;Loop to finish processing table 20$: MOV (SP)+,R1 ;Restore R1 OVLINK STRTPG .............. .ENDC ;NE FRUN$$!SRUN$$ .IF NE UNLO$$ .SBTTL UNLOAD Overlay OVERLAY .SBTTL UNLOAD Command ;+ ; UNLOAD Command ;- SYNTAX UNLOAD PROMPT $DEVICE REQBLNK END ............ SWITS UNLOAD ENDNO NOS ENDS ............ OVCMD UNLOAD ITBLE 0 ;Set maximum number of file specs OCALL INITIT ;Do the parse .BR UNLDIN ............ .ENABL LSB UNLDIN: ;+ ; Check to see if a system job name was specified ;- .IF NE SYT$K MOV R5,(PC)+ ;Save command text in case of error ERPTR: .WORD 0 ;Text pointer DEC ERPTR ;Bump saved pointer past delimiter CALL CKLJN2 ;Are we unloading a system job? BEQ 10$ ;Unloading a device CALLR 260$ ;Yes, not a device. Go do it ............ .ENDC ;NE SYT$K ;+ ; Set up info from the command line ;- 10$: OADDR DEVSTS,R2 ;Point to work area OCALL GETNAM ;Get device name BNE 20$ ;Continue, if there is one 15$: OCALLR BADCOM ; ............ 20$: OCALL OPTCOL ;Ignore optional colon OINST MOV @R2,INPFN,,* ;Save device name in case of error MOV R5,-(SP) ;Save command text pointer MOV @#$SYPTR,R5 ;Point to RMON ;+ ; Check to see if the foreground job was specified ;- .IF EQ ;If no system jobs AND not SB/XB MOV SP,(PC)+ ;Assume no FG FGRUN: .WORD 0 ;0 if FG running, <>0 if no FG or not running MOV FCNTXT-$RMON(R5),R4 ;Get foreground context pointer BEQ 30$ ;No FG job in memory MOV I.BLOK(R4),FGRUN ;Get FG blocking bits BIC #^c,FGRUN ;Clear all but NORUN$ bit, leave 0 if FG 30$: CMP @R2,#<^rF > ;Is it a special UNLOAD FG? BNE 40$ ;No TST FGRUN ;Yes, is FG running? BEQ FJERR ;Yes, error TST R4 ;Does it even exist? ;;; BNE 260$ ;Yes, and we can UNLOAD it BEQ NOFERR ;No, we can't take away what isn't there CALLR 260$ ;Yes, and we can UNLOAD it ............ ;+ ;ERROR NOFERR: KMEROR ............ FJERR: KMEROR ;- ............ .ENDC ;EQ ;+ ; A device handler was specified ; Check to be sure the handler can be unloaded ;- HS2.KU = 10 ; NO KMON LOAD support bit 40$: .PURGE #CHOVLY ;Purge channel CHOVLY MOV R2,R0 ;R0 must point to device name for call CLC ;Say do logical translation OJSR R4,.LK4DV,@ ;Find the handler in tables BR 42$ ;No such handler (or job) OINST ADD .$PNAM,R3,* ;Make index into pointer for PNAME table MOV @R5,R4 ;Get handler entry point BEQ 125$ ;If not resident, nothing to do for unload MOV @#$SYPTR,R1 ;Get start of RMON one more time TST -(R0) ;Point to beginning of block again MOV R0,R2 ;R2 points to block also MOV #<^rSY >,(R2)+ ;Lookup the handler on the sy: device MOV @R3,@R2 ;Save physical device name (w/o unit) (RAD50) ADD HSUFFX-$RMON(R1),(R2)+ ;But make it 'HHX.SYS' for XM CLR (R2)+ ;Clear second word of file name MOV #<^rSYS>,@R2 ;Extension is ".SYS" .LOOKUP CHOVLY,R0 ;Look up the handler file BCC 50$ ;Okay OCALLR NOTFND ;Error - it isn't there 42$: .IF EQ SYT$K ;If no system jobs OCALLR BADHAN ;Bad handler name .IFF CLRB @(SP)+ ;Terminate string at current position MOV ERPTR,R4 ;Point to invalid name to print ;+ ;ERROR KMRTMG ,, ;- .ENDC ;EQ SYT$K 50$: OINST MOV .USRBUF,R5,* ;Point to USR buffer CLR @<.BLKEY-OVLY>-<.+4-OVLYST>(PC) ;We will clobber directory CLR R0 ;Indicate block 0 .READW CHOVLY,R5,#256. ;Read block 0 into USR buffer BCC 60$ ;Okay, got it OCALLR FIPERR ;Error- file input 60$: BIT #,H.STS2(R5) ;Does it support KMON UNLOAD? BEQ 70$ ;Yes, no problem OCALLR BADHAN ;Invalid device ;+ ; Find the device in the monitor tables ; Check to be sure that handler is not already resident ;- 70$: BIS #,CONFG2-$RMON(R1) ;Indicate unload to LD MOV #$ENTRY-$RMON,R0 ;-> ADD R1,R0 ; $ENTRY with R0 CLR R1 ;Initialize index into $OWNER 80$: CMP R4,@R0 ;Entries match? BEQ 90$ ;No, try the next CMP (R1)+,(R1)+ ;Bump owner index by 4 bytes TST (R0)+ ;Point to next entry CMP R1,#<$SLOT*4> ;At end of table? BLT 80$ ;No, continue searching through table ;+ ; Check if handler is owned by other jobs. ; The actual handler owner assignment is handled later. ;- 90$: MOV SP,@<.EXTFL-OVLY>-<.+4-OVLYST>(PC) ;Inhibit CTRL/C .IF NE OWN$ER OINST ADD .$OWNE,R1,* ;R1 -> this device's slot in $OWNER MOV R1,R2 ;Copy $OWNER index .IF EQ SYT$K TST FGRUN ;Is FG running? BNE 120$ ;No, unload anything MOV (R1)+,-(SP) ;Yes, get owner bits for this device .IF NE UNI$64 CMP #,@SP ;Is it 64-unit? BNE 110$ ;Nope MOV @R1,R1 ;Yup, point to real owner table in handler MOV (R1)+,@SP ;Get the owner bits ... MOV #<14.>,R3 ; ... and merge words for all but 8 units 100$: BIS (R1)+,@SP ; SOB R3,100$ ; 110$: .ENDC ;NE UNI$64 BIS @R1,@SP ;Now merge words for all/last 8 units BIT #<21042>,(SP)+ ;Does FG own any units of this device? BNE FJERR ;Yes, error - FG is active .IFF ;EQ SYT$K CALL OWNRNM ;Check if any active owners ...... ;Won't come back if there are any! .ENDC ;EQ SYT$K .ENDC ;NE OWN$ER ;+ ; Handler was found in list. Eliminate it from memory if not a system ; or special device, returning memory to free list. ;- 120$: MOV R0,R3 ;Save $ENTRY pointer for DRCALL MOV @#$SYPTR,R5 ;Point to RMON CMP R5,R4 ;System device? BLOS 190$ ;Yes, leave it in memory! MOV #,R1 ;Indicate $UNLOAD CALL DRCALL-$RMON(R5);Call the handler is required on UNLOAD BCC 130$ ;Branch if no errors TST R0 ;Was there an I/O error? BEQ 250$ ;Branch if yes print a message of the fact .PRINT R0 ;Else print the handler's message 125$: BR 190$ ;Don't unload ............ ;+ ; Remove any ownership assignment ;- 130$: CLR @R3 ;Zero $ENTRY value .IF NE OWN$ER CLR (R2)+ ;Clear $OWNER table entry (ownership or ... CLR @R2 ; ... 64-unit flag and Ext. owner table ptr.) .ENDC ;NE OWN$ER 140$: SUB #,R4 ;Back up to first word of handler CLR -(SP) ;Assume fixed vector(s) MOV R4,R1 ;Use R1 for vector pointer MOV (R1)+,R5 ;Get handler vector address BPL 170$ ;No vectors or one fixed vector ASL R5 ;Multi-vector, get word offset ADD R5,R1 ;Point to table of vectors MOV (R1)+,R5 ;Get vector or vector offset BPL 160$ ;Branch if fixed vector list MOV (R1)+,@SP ;Get hardware id # of PRO option slot device MOV @#$SYPTR,R5 ;R5 -> $RMON CALL @GETVEC-$RMON(R5) ;@SP = vector A of PRO option slot device BCS 180$ ;Just get rid of handler if error 150$: MOV (R1)+,R5 ;Get vector or vector offset 160$: ADD @SP,R5 ;Add in base vector (0 if fixed vector) 170$: BLE 180$ ;Branch if no more vectors MOV R5,-(SP) ;Push vector address on stack CLR -(SP) ;Reserve space for code word .UNPROT SP ;Issue the unprotect CMP (SP)+,(SP)+ ;Clean stack CLR (R5)+ ;Clear the vector CLR @R5 ; and priority CMP (R1)+,(R1)+ ;Advance to next vector BR 150$ ;Loop for more ............ 180$: TST (SP)+ ;Get rid of base vector from stack OCALL PUTBLK ;Return handler's memory BCC 190$ ;Did the KMON/USR move? ADD R0,@SP ;Yes, relocate command text pointer ADD R0,2(SP) ; and return address ;+ ; Done with this device - is there another? ;- 190$: MOV (SP)+,R5 ;Restore command line pointer 200$: CLR @<.EXTFL-OVLY>-<.+4-OVLYST>(PC) ;Enable CTRL/C CMPB @R5,#<',> ;More coming? BNE 210$ ;Branch if not CALLR UNLDIN ;Yes, so go process ............ 210$: TSTB @R5 ;No, end of line? BEQ 230$ ;If so, just return 220$: OCALLR BADCOM ; ............ 230$: RETURN ;Done ............ ;+ ;ERROR 250$: KMEROR ;- ............ .IF EQ SB ;+ ; This code unloads an inactive foreground job that has aborted and ; is just laying around. It clears out the necessary RMON pointers ; and reclaims the memory for use by the system. ;- 260$: MOV SP,@<.EXTFL-OVLY>-<.+4-OVLYST>(PC) ;Inhibit CTRL/C .IF EQ SYT$K CLR FCNTXT-$RMON(R5) ;Make the FG vanish BIC #,CONFIG-$RMON(R5) ;Say no FG job .IFF ;EQ SYT$K MOV R4,R2 ;Save job's $IMPUR pointer MOV @R4,R4 ;Point to impure area BIT #,I.BLOK(R4) ;Job active? BNE 270$ ;No, it can go MOV R5,R3 ;R3 -> end of err text MOV ERPTR,R5 ;R5 -> beg of err text MOV R5,R4 ;Point to invalid name to print CLRB @R3 ;Make job name ASCIZ for KMRTMG ;+ ;ERROR KMRTMG ,, ;- ............ 270$: CLR @R2 ;Job vanishes from system tables MOV R5,-(SP) ;Save command text pointer .ENDC ;EQ SYT$K .IF NE ERL$G OCALL ERLCHK ;Check for ERRLOG task BNE 280$ ;Branch if no MOV @#$SYPTR,R5 ;Point to the RMON CLR $ELHND-$RMON(R5) ; and disable error logging 280$: .ENDC ;NE ERL$G OCALL PUTBLK ;Throw the bum out BCC 290$ ;KMON didn't move ADD R0,2(SP) ;Fix return address to monitor ... ADD R0,@SP ; ... and command text pointer 290$: .IF NE OWN$ER CALL CLEANO ;Clean references to this job out of the ... ; ... $OWNER tables (kills registers) .ENDC ;NE OWN$ER .IF NE SYT$K MOV #,R3 ;R3 = maximum valid job number MOV @#$SYPTR,R5 ;Point to $RMON ADD #<$IMPUR-$RMON+FJOBNM+2>,R5 ; past end of impure table 300$: TST -(R5) ;Job installed here? BNE 190$ ;Yes, leave FG active indicator on SUB #<2>,R3 ;No, get next job number BNE 300$ ;Look at another system job entry BIC #,(R5) ;Indicate no FG jobs installed .ENDC ;NE SYT$K BR 190$ ;Continue command for more devices ............ .ENDC ;EQ SB .DSABL LSB .IF NE OWN$ER LONIBL =: 017 HINIBL =: 0360 ;+ ; CLEANO - Go through the system $OWNER table and its extensions and ; clear any references to this job. ; ; R3 = Job # (if monitor has system job support) ; ; CALL CLEANO ; ; R3 = Job # +1 ; R0,R1,R2,R4,R5 destroyed ;- .ENABL LSB CLEANO: .IF EQ SYT$K MOV #<2>,R3 ;Use non-system job support FG job number .ENDC ;EQ SYT$K INC R3 ;Get job number +1 for $OWNER table masks MOVB R3,R4 ;Use R4 for mask of high nibble ASL R4 ; ASL R4 ; ASL R4 ;R3 = low nibble mask ASL R4 ;R4 = high nibble mask OINST MOV .$OWNER,R0,* ;Start at the beginning of the $OWNER table MOV #<$SLOT>,R2 ;Get number of device slots for loop count 10$: .IF NE UNI$64 CMP @R0,# ;Is this an extended unit entry? BNE 20$ ;No MOV #<32.>,R5 ;R5 = # bytes to check (extended ownership) MOV R0,-(SP) ;Save R0 pointer into real $OWNER table MOV 2(R0),R0 ;Point to the extended ownership table CALL 40$ ;Clean out the extended ownership table MOV (SP)+,R0 ;Restore R0 CMP (R0)+,(R0)+ ;Point R0 at next entry BR 30$ ;And move onto next entry ............ 20$: .ENDC ;NE UNI$64 MOV #<4.>,R5 ;R5 = # of bytes to test in regular entry CALL 40$ ;Clean out this ownership table entry 30$: SOB R2,10$ ;Do the next entry, if there is one RETURN ;Otherwise, return ............ ;+ ; Clean references to the unloaded job out of a given device's owner bytes ;- 40$: MOVB @R0,R1 ;R1 = byte to check BICB #,R1 ;Clear out the high nibble CMPB R1,R3 ;Compare low nibble to job # +1 BNE 50$ ;It doesn't match BICB R1,@R0 ;It does match, clear out the job # +1 50$: MOVB (R0)+,R1 ;R1 = byte to check BICB #,R1 ;Clear out the low nibble CMPB R1,R4 ;Compare high nibble to job # +1 BNE 60$ ;It doesn't match BICB R1,-1(R0) ;It does match, clear out the job # +1 60$: SOB R5,40$ ;Do the next byte, if there is one RETURN ;Go back to process next device ............ .DSABL LSB .ENDC ;NE OWN$ER .IF NE SYT$K ;+ ; CKLJN2 - Check an entry in the command string for being logical job name ; ; R5 -> command string ; ; CALL CKLJN2 ; ; R2 -> impure area of job ; R3 = job # (if job exists) ; R4 -> job's impure pointer if job exists ; = 0 if job doesn't exist ; R5 = current command string pointer ; ; Condition codes set based on contents of R4 ;- .ENABL LSB CKLJN2: MOV R5,(PC)+ ;Save command text pointer R5STA2: .WORD 0 .ADDR #,R0 ;Point to work space for fwd ASCII name CLR -(R0) ;Zero out the ... CLR -(R0) ; ... forward ASCII ... CLR -(R0) ; ... work space MOV R0,-(SP) ;Save the pointer MOV #,R1 ;R1 = maximum number of characters in name TSTB -1(R5) ;Check first character (don't move pointer) BEQ 30$ ;If no character then give error 10$: TSTB -1(R5) ;Check next character (done twice 1st time ; to save a word) BEQ 50$ ;End of line - command string complete 20$: OCALL ALPHNT ;Check for alpha-numeric character BCS 40$ ;Got a valid character - go process it CMPB @R5,#<',> ;Was the character a comma? BEQ 60$ ;Yes, then assume we're done with the name CLR R4 ;Assume no job CMPB @R5,#<':> ;Was the character a colon? BEQ 70$ ;Yes - not a job - process as handler 30$: OCALLR BADCOM ;Null name is an error ............ 40$: MOVB @R5,(R0)+ ;Move character to work space SOB R1,10$ ;Loop to do all 6 characters 50$: DEC R5 ;Move command pointer past last character 60$: MOV R5,R3 ;R3 -> after name MOV (SP)+,R0 ;Point R0 to job name text MOV R5,-(SP) ;Save command text pointer (FNDJOB uses it) MOV @#$SYPTR,R5 ;Point to RMON ADD #<$IMPUR-$RMON>,R5 ; at start of impure table MOV R5,(PC)+ ;Save for later IMSTA2: .WORD 0 ;Impure table start address CLR R4 ;Initially, assume no job CALL FNDJOB-$IMPUR(R5) ;Check out job name BEQ 70$ ;No such job, return R4=0 MOV R5,R4 ;Copy job's $IMPUR table pointer SUB IMSTA2,R5 ;Calculate job number MOV R5,R3 ;Return it in R3 BR 80$ ;Merge... ............ 70$: MOV R5STA2,@SP ;No such job, reset command text pointer 80$: MOV (SP)+,R5 ;Restore text pointer TST R4 ;Set condition code bits RETURN ............ NBUFF2: .BLKW ;Fwd ASCII job name work area ............ .DSABL LSB .IF NE OWN$ER ;+ ; OWNRNM - Subroutine to check device owner run status ; ; Input: R2 -> $OWNER table entry for this device ;- .ENABL LSB OWNRNM: MOV R3,-(SP) ;Save ... MOV R5,-(SP) ; ... registers .IF NE UNI$64 CMP #,@R2 ;Is it a 64-unit handler? BNE 10$ ;Nope MOV 2(R2),R2 ;Yes, point to real owner table in handler MOV #<32.>,R3 ;Check all 32 bytes of the owner table BR 20$ .ENDC ;NE UNI$64 10$: MOV #<4>,R3 ;Check four bytes of ownership table 20$: MOVB @R2,R5 ;Get byte (has 2 job #s) CALL 40$ ;See if low order nibble's job is running ...... ;Won't come back if it's running! MOVB (R2)+,R5 ;Get same byte ASRB R5 ;Shift ASRB R5 ; hi order ASRB R5 ; job to ASRB R5 ; low order CALL 40$ ;See if running ...... ;Won't come back if it's running! SOB R3,20$ ;Loop for another byte CMP -(R2),-(R2) ;Fix $OWNER table pointer MOV (SP)+,R5 ;Restore MOV (SP)+,R3 ; registers 30$: RETURN ............ 40$: BIT #<1>,R5 ;Unowned unit? BEQ 30$ ;Yes, no problem BIC #^c<16>,R5 ;Extract job number BEQ 30$ ;Ok to unload if BG owner ADD @#$SYPTR,R5 ;Relocate into monitor MOV $IMPUR-$RMON(R5),R5 ; and get job's impure area address BEQ 30$ ;No job installed, all is well ! BIT #,I.BLOK(R5) ;Job running? BNE 30$ ;No, everything's ducky ;+ ;ERROR KMRTMG ;- ............ .DSABL LSB .ENDC ;NE OWN$ER .ENDC ;NE SYT$K .ENDC ;NE UNLO$$ .IF NE FRUN$$!SRUN$$ ;Over the next two overlays .SBTTL FRUN/SRUN Overlay I OVERLAY ;+ ; SRUN Command ;- SYNTAX SRUN PROMPT $FILE SCALL GSWIT,<1> REQBLNK ROUTINE FSP SCALL RINSPC,<1> END ............ SWITS SRUN ENDNO SWIT PAUSE 1 - - PAU SWIT TERMINAL 1 - - TTY SWIT BUFFER 1 - - BUF SWIT NAME 1 - - NAM SWIT LEVEL 1 - - LEV NOS ENDS ............ .SBTTL FRUN/SRUN Commands (Part 1) ;+ ; NOTES: FRUN/SRUN has been removed from the LOAD/UNLOAD overlay. ; The call to 'GETHAR' has been moved to the KMON root, and links back ; to this overlay via a dummy overlay command - 'FSR2'. ; ; FRUN/SRUN are now recognizable from DCL. ; Therefore all switch processing is done via action routines, ; and therefore the switch values must be saved somewhere outside the overlay ; region (in case 'GETHAR' causes the LOAD overlay to be brought in). ; Since there is only 1 filespec for FRUN/SRUN, the 2nd entry in the DCL file ; table is used as a 'switch work space' (see offset definitions below). ;- ;+ ; Offset into 2nd entry of the DCL file table (scratch area) ;- OFLEV =: FSIZ ;/LEVEL:n value OFPSW =: OFLEV+2 ;/PAUSE switch OFLJN =: OFPSW+2 ;/NAME:ljobnm text OFBUF =: OFLJN+6 ;/BUFFER:n value OFTTY =: OFBUF+2 ;/TERMINAL:n value OFTCB =: OFTTY+2 ;BG & FG TCB (for MTT$Y) .ENABL LSB .IF NE FRUN$$ ;If FRUN command OVCMD FRUN MOV #,(PC)+ ;Force level of FG job .ENDC ;NE FRUN$$ JLVL: .WORD 0 ;*** IMPURE DATA *** .IF NE SYT$K BR FSRUN ;Go to common code ............ .IF NE SRUN$$ ;If SRUN command OVCMD SRUN CLR JLVL ;Initialize task priority level .ENDC ;NE SRUN$$ .ENDC ;NE SYT$K .BR FSRUN ............ FSRUN: MOV #,R2 ;Initialize save area in DCL file table OADDR FILST+OFLEV,R3 ;R3 -> save area (2nd entry in table) .IF NE SYT$K MOV R3,-(SP) ;Save parameter pointer for later .ENDC ;NE SYT$K 10$: CLR (R3)+ ;Clear out an entry SOB R2,10$ ;Loop until done ITBLE 1 ;Tell DCL there's 1 file spec OCALL INITIT ;Do parse to force switch action(s) MOV @#$SYPTR,R5 ;R5 -> RMON .IF NE SYT$K MOV (SP)+,R0 ;R0 -> switch save area ADD #,R0 ;R0 -> logical job name entry TST @R0 ;Logical job name given? BNE 20$ ;Yes, use it SUB #,R0 ;No, use physical file name 20$: CALL FNDJOB-$RMON(R5) ;See if another job exists with same name BEQ 30$ ;No, go check out job number BIT #,I.BLOK(R2) ;Duplicate name. Other job active? BEQ BADNAM ;Yes, error CALL DEADJB ;No, go remove dead job and reclaim memory 30$: MOV @#$SYPTR,R5 ;R5 -> RMON again MOV JLVL,R3 ;Was /LEVEL:n specified? BNE 50$ ;Yes, use specified level MOV #,R3 ;Try to assign highest job level ADD #<$IMPUR-$RMON+FJOBNM>,R5 ;Point to end of impure table 40$: SUB #<2>,R3 ;Down to next job number (skip FG job) BEQ MAXACT ;Oops, no more jobs available, error TST -(R5) ;Is the impure table slot empty? BEQ 70$ ;Yes, use it MOV @R5,R2 ;Point to existing job's impure area BIT #,I.BLOK(R2) ;It this job active? BNE 60$ ;No, remove it, reclaim memory, use this slot BR 40$ ;Active job, try another ............ 50$: ADD R3,R5 ;/LEVEL:n given. Point to job's ADD #<$IMPUR-$RMON>,R5 ; impure table entry .IFF ;NE SYT$K MOV #,R3 ;Get foreground job number ADD #,R5 ;Point to FG impure table entry .ENDC ;NE SYT$K TST @R5 ;Job installed? BEQ 70$ ;No, home free MOV @R5,R2 ;Yes, point to existing job's impure area BIT #,I.BLOK(R2) ;Is it active? BNE 60$ ;No, remove it and reclaim space .IF NE SYT$K CMP #,R3 ;Trying to install FG? BNE BADLVL ;No, invalid priority level (in use) .ENDC ;NE SYT$K ;+ ;ERROR KMEROR ;FG error msg ;- ............ 60$: CALL DEADJB ;Reclaim memory from existing dead job 70$: MOV R5SAV,R5 ;Restore original pointer to file spec MOV R3,-(SP) ;Save the job number MOV (PC)+,R3 ;Get default device name ..FRDK:: .RAD50 /DK / ;**PATCH** FRUN Default Device Name .IF NE SYT$K CMP #,@SP ;Are we an 'FRUN'? BEQ 80$ ;No, use filetype of .REL MOV (PC)+,R3 ;Get default device name ..SRDK:: .RAD50 /SY / ;**PATCH** SRUN Default Device Name OCALL SFILE ;Get file descriptor (.SYS default type) BR 90$ ............ 80$: .ENDC ;NE SYT$K OCALL RFILE ;Get file descriptor (.REL default type) 90$: OADDR FILST+OFLEV,R4 ;Point to job number entry in save area MOV (SP)+,@R4 ;Save job number in safe place .IF NE MTT$Y ADD #,R4 ;R4 => /terminal LUN in save area MOV (R4)+,R2 ;Get specified LUN MOV @#$SYPTR,R0 ;Point to RMON MOV BKCNSL-$RMON(R0),@R4 ;Initialize BG console TCB address MOV (R4)+,@R4 ; and FG console address (in save area) TST R2 ;Was /TERMINAL:n given? BEQ 100$ ;No, skip all this COM R2 ;Convert value to LUN ;(It was COM'ed to differentiate ;A LUN of 0 and no /TER: switch ADD #,R0 ;R0 => table of TCB pointers ADD R2,R0 ;Point to TCB address MOV @R0,R0 ;Get address of specified unit's TCB BEQ ILLUN ;Non-existent TCB TST T.CSR(R0) ;Is the device installed? BEQ ILLUN ;No, can't use it TST T.OWNR(R0) ;Is it owned already? BNE ILLUN ;Yes, can't use it BIT #,T.STAT(R0) ;Is it being used as a console? BNE ILLUN ;Yes, can't use MOV R0,@R4 ;All is well, save FG TCB pointer 100$: .ENDC ;NE MTT$Y MOV R5SAV,R5 ;Restore R5 (command text pointer) ??? MOV R3,R0 ;Copy FD pointer for GETHAR OCALLR FSGHAR ;Go to KMON root to get handler (if needed) ............ OVCMD FSR2 ;*CAUTION* May be fresh copy if root brought in 'LOAD' MOV (SP)+,R0 ;Get FD addr for LOOKUP (stacked by FSGHAR) OCALL COPYFN ;Save file name in case of error .LOOKUP CHOVLY ;LOOKUP file on overlay channel BCC 110$ ;Got it OCALLR NOTFND ;File not found, error ............ 110$: OINST CLR @.BLKEY,,* ;No directory in memory now! OVLINK FSRU2 ;Link to second part of FRUN/SRUN ............ BDCMND: OCALLR BADCOM ;Bad KMON Command/Switch ............ ;+ ;ERROR ILLUN: KMEROR ............ .IF NE SYT$K BADNAM: KMEROR ............ BADLVL: KMEROR ............ MAXACT: KMEROR ............ .ENDC ;NE SYT$K ;- .DSABL LSB .SBTTL FRUN/SRUN Commands (Part 3 - STRTPG) ;+ ; The last part of FRUN/SRUN comes back here to do the 'STRTPG' code ; previously scattered about in the 'EXAMINE/DEPOSIT' overlay, under ; the auspices of 'FRU3' ; ; Set up job limits and impure pointers in RMON ; Return to KMON will cause context switching to activate the job ; ; Contents of the stack: ; ; SP -> STMPUR ; Job number ; Job low limit ; Job high limit ; Load address ; /PAUSE switch (load addr) ;- .ENABL LSB OVCMD STRTPG MOV (SP)+,R4 ;Point to start of impure area MOV @#$SYPTR,R3 ;R3 -> RMON .IF NE MTT$Y OADDR FILST+OFTTY,R2 ;R2 -> /TER:n save area MOV (R2)+,R1 ;Get LUN specified, if any BEQ 10$ ;None specified, share BG console COM R1 ;Convert back to LUN ASR R1 ; and make it unit*1 BR 20$ ;Merge ............ 10$: MOV BKGND+I.CLUN-$RMON(R3),R1 ;Get BG console unit number 20$: MOV R1,I.CLUN(R4) ;Set up console LUN in impure area MOV (R2)+,R0 ;R0 -> BG console TCB MOV @R2,R1 ;R1 -> FG console TCB MOV R1,I.CNSL(R4) ;Set up FG console TCB pointer CMP R0,R1 ;Are they the same? BEQ 30$ ;Yes, BG console is still shared BIS #,T.STAT(R1) ;Set console bit in FG console's TCB MOV R4,T.OWNR(R1) ;This job is the terminal owner .IF NE SYT$K DEC T.CNT(R0) ;BG console TCB has one fewer owner CMP #<1>,T.CNT(R0) ;Down to one (BG private)? BNE 30$ ;No, leave it shared .ENDC ;NE SYT$K MOV BCNTXT-$RMON(R3),T.OWNR(R0) ;BG console is now owned by BG BIC #,T.STAT(R0) ; and is no longer a shared console ;+ ; Set up I.TERM word from $JSW OR'ed them with TCB CONFIG word ;- 30$: BIC #^c,I.TERM(R4) ;Get only good bits BIC #,@R1 ;Clear those bits in TCB status BIS @R1,I.TERM(R4) ;Set up I.TERM word in impure area .ENDC ;NE MTT$Y .BR 40$ ............ 40$: BIS #,CONFIG-$RMON(R3) ;Indicate FG active in system MOV R3,R2 ;Copy RMON pointer .IF NE MMG$T MOV @SP,R5 ;Get job number (LEVEL*2) ADD R3,R5 ;Add in Start of RMON CLR SCCATB-$RMON(R5);Clear possible old value in SCCA table .ENDC ;NE MMG$T MOV (SP)+,R5 ;Get job number (LEVEL*2) ADD R5,R2 ;Calculate offset for impure table slot ;- to be used later ASL R5 ;Get JOB # * 2 for limits table entries ADD R5,R3 ;Calculate job limits address MOV (SP)+,$JBLIM+2-$RMON(R3) ;Set up job low limit ... MOV (SP)+,$JBLIM-$RMON(R3) ; ... and job high limit MOV R4,R3 ;Copy impure pointer ADD #,R3 ;R3 -> job id save area MOV (PC)+,(R3)+ ;Begin setting up job id .ASCII ;With a CR,LF .IF NE SYT$K OADDR FILST+OFLEV,R5 ;R5 -> logical job name save area MOV @R5,R1 ;Save for later ADD #,R5 ;R5 -> logical job name, if any TST @R5 ;Was logical name specified? BNE 50$ ;Yes, use it SUB #,R5 ;No, use physical file name 50$: MOV R5,-(SP) ;Save name pointer for later CMP #,R1 ;Is this a FG job? BEQ 80$ ;Yes, job id = 'F>' MOV #,R1 ;No, get size of name area 60$: CALL UCNAMC ;MOV (R5)+,(R3)+ (Convert to upper case) TSTB @R5 ;Short name? BEQ 70$ ;Yes SOB R1,60$ ;Loop until done 70$: MOVB #<'>>,(R3)+ ;Terminate name MOVB #,(R3)+ ; with new MOVB #,(R3)+ ; line CLRB @R3 ;Make ASCIZ BR 90$ ;Now set up logical job name ............ 80$: .ENDC ;NE SYT$K MOV (PC)+,(R3)+ ;Use default FG job id ('F>') .ASCII "F>" MOV (PC)+,(R3)+ .ASCII CLR @R3 ;Make it ASCIZ! .IF NE SYT$K 90$: MOV (SP)+,R5 ;Restore -> "logical" job name in save area MOV R4,R3 ;Point to impure area ... ADD #,R3 ; ... at logical job name area MOV #,R1 ;Set up loop count 100$: CALL UCNAMC ;Move/convert @R3 to @R5 (UPPER case) SOB R1,100$ ;Loop until done .ENDC ;NE SYT$K .BR 120$ ............ ;+ ;.IF NE CONT$N ;Removed for V4. ;OINST CLR CTNUFG,,* ;Clr flag for Continue @File errors ;.ENDC ;NE CONT$N ;- 120$: MOV @#$SYPTR,R3 ;R3 -> RMON MOV (SP)+,R1 ;Get load address of job BIT #,@R4 ;Is this a virtual job? BEQ 130$ ;No MOV R3,$SYPTR(R1) ;Yes, tell him the true RMON base TST V.EMT(R1) ;Does he have an EMT vector set? BNE 130$ ;Yes, leave it alone MOV @#V.EMT,V.EMT(R1) ;No, tell him where the monitor's is 130$: ;I&D+ .IF NE MMG$T BIS #,@R4 ;Make sure that mapping is set up on ; first context switch .ENDC ;NE MMG$T ;I&D- TST (SP)+ ;/PAUSE switch given? BNE 140$ ;Yes, print information and pause MOV R4,$IMPUR-$RMON(R2) ;Install job in RMON's table CLR @<.EXTFL-OVLY>-<.+4-OVLYST>(PC) ;Enable ^C .IF NE ERL$G CALL ERLOAD ;Check for EL task, install it .ENDC ;NE ERL$G MOVB #,INTACT-$RMON(R3) ;Set up full sched pass .EXIT ;Then leave this way to do one ............ 140$: BIS #,I.BLOK(R4) ;/PAUSE means suspend the job MOV R4,$IMPUR-$RMON(R2) ;Install job in RMON's table CLR @<.EXTFL-OVLY>-<.+4-OVLYST>(PC) ;Enable ^C .IF NE ERL$G CALL ERLOAD ;Install EL, if this is EL .ENDC ;NE ERL$G JSR R0,150$ ;Point to and go print load message .ASCII "Loaded at "<200> .EVEN ............ 150$: TST (SP)+ ;Pop return address .PRINT ;+ ; This is the Octal Value Print Routine from EXAMINE/DEPOSIT/BASE ; Value is in R1... ;- MOV #<30>,R0 ;Convert word to octal and print it SEC 160$: ROL R1 ;Don't try to understand this routine ROLB R0 ; just use it & love it .TTYOUT MOV #<206>,R0 170$: ASL R1 ;Done yet ? BEQ 180$ ;Yes ROLB R0 BCS 170$ BR 160$ ............ 180$: OCALLR KCRLF ;Print CR LF, return to KMON ............ .DSABL LSB .IF NE ERL$G ;+ ; ERLOAD - Check to see if job is error logger, install in monitor if so ; ; R1 -> first word of new job (see the first word of ELCOPY.MAC) ; R3 -> RMON ; R4 -> impure area ; ; CALL ERLOAD ;- .ENABL LSB ERLOAD: OCALL ERLCHK ;Is this the error logger? BNE 10$ ;No MOV R4,$ELIMP-$RMON(R3) ;Stuff its impure pointer MOV @R1,$ELHND-$RMON(R3) ; and the pointer to the copy routine 10$: RETURN ............ .DSABL LSB .ENDC ;NE ERL$G ;+ ; DEADJB - Remove a dead job and reclaim its memory ; ; R2 -> impure area of dead job ; R5 -> impure area pointer of dead job ; SP -> return address to KMON ; ; CALL DEADJB ; ; R2,R4 = undefined ; NOTE: KMON may slide around ;- .ENABL LSB DEADJB: MOV SP,@<.EXTFL-OVLY>-<.+4-OVLYST>(PC) ;Disable ^C MOV R2,R4 ;Copy impure pointer for PUTBLK .IF NE ERL$G OCALL ERLCHK ;Is this the error logger? BNE 10$ ;No MOV @#$SYPTR,R2 ;Yes, point to RMON CLR $ELHND-$RMON(R2) ; and tell RMON that EL is gone 10$: .ENDC ;NE ERL$G CLR @R5 ;Make job vanish from impure tables MOV R3,-(SP) ;Save R3 OCALL PUTBLK ;Reclaim memory MOV (SP)+,R3 ;Restore R3 BCC 20$ ;Just leave if KMON didn't move ADD R0,R5SAV ;Relocate original filespec pointer, ADD R0,@SP ; our return address, ADD R0,2(SP) ; and the one to KMON 20$: CLR @<.EXTFL-OVLY>-<.+4-OVLYST>(PC) ;Enable ^C RETURN ............ .DSABL LSB .SBTTL FRUN/SRUN Action Routines ;+ ; DCL action routines for FRUN/SRUN ;- OVAFSP: MOV R5,(PC)+ ;Save reverse ASCII filespec pointer in line R5SAV: .WORD 0 ;Pointer to text *** IMPURE DATA *** RETURN ;Continue ............ OVANAM: ;Pull out logical job name .IF EQ SYT$K BR BDSWIT ;No logical names in FB ............ .IFF ;EQ SYT$K .ENABL LSB CMPB #<':>,@R5 ;Is there a delimiting colon? BNE BDSWCH ;Error if not OADDR FILST+OFLJN,R2 ;Point to 2nd entry in DCL file table MOV R2,-(SP) ;Save for later MOV #,R3 ;Maximum length of name is 6 characters 10$: OCALL ALPHNT ;Check if alphanumeric BCC BDNAM ;Oops...it's not! MOVB @R5,(R2)+ ;Copy a character DEC R3 ;6 characters yet? BEQ 20$ ;Yes...we're done TSTB -(R5) ;Next character a null? BEQ 30$ ;Yes...we're done CMPB #<'/>,@R5 ;How about a slash? BEQ 30$ ;Yes...we're done CMPB #<' >,(R5)+ ;Ok, a space then? BNE 10$ ;No...keep going 20$: DEC R5 ;Point at delimiter for DCL 30$: MOV (SP)+,R2 ;Point to beginning of name CMP #<'F>,@R2 ;Can't have name of 'F' (default FG name) BEQ BDNAM ;Error if so CMP #<'B>,@R2 ;Same for name 'B' (default BG name) BEQ BDNAM ;If it is, it's an error RETURN ;Back to DCL ............ .DSABL LSB .ENDC ;EQ SYT$K OVALEV: .IF EQ SYT$K BR BDSWIT ;Level switch is invalid if no system tasking ............ .IFF ;EQ SYT$K CMP #,JLVL ;Is this an FRUN? BEQ BDSWIT ;Sorry, /LEVEL is invalid for FRUN CMPB #<':>,@R5 ;Do we have a colon (most people do)? BNE BDSWCH ;No, exit stage left CALL SWVAL ;Get value of job level TST @SP ;Check it out BLE BDLVL ;Can't be negative or 0 (0 = BG job) CMP #,@SP ;Too big? BLE BDLVL ;Yes (that includes FG job, too) MOV (SP)+,JLVL ;Save level as job number RETURN ............ .ENDC ;EQ SYT$K OVABUF: CMPB #<':>,@R5 ;Process /BUFFER:n - colon there? BNE BDSWCH ;No, error CALL SWVAL ;Get value of extra buffer space OINST MOV (SP)+,FILST+OFBUF,,* ;Save extra buffer alloc value RETURN ;Continue ............ OVAPAU: OINST INC FILST+OFPSW,,* ;Set /PAUSE switch RETURN ;Continue ............ OVATTY: .IF NE MTT$Y CMPB #<':>,@R5 ;Proper delimiter? BNE BDSWCH ;No, error CALL SWVAL ;Get console terminal LUN CMP @SP,# ;Legal LUN? BGE BDSWCH ;No OADDR FILST+OFTTY,R2 ;Get address of LUN save area MOV (SP)+,@R2 ;Save LUN COM @R2 ;'COM' it to differentiate LUN 0 ;From no LUN - F/SRUN fixes later RETURN ;Back to DCL ............ .ENDC ;NE MTT$Y BDSWCH: OCALLR BADCOM ;Bad command ............ BDSWIT: OCALLR ILSWIT ;Bad switch ............ .IF NE SYT$K BDNAM: CALLR BADNAM ;Bad name ............ BDLVL: CALLR BADLVL ;Bad level ............ ; UCNAMC - Move next character at @R5 to @R3; Convert to UPPER case ; and advance pointers UCNAMC: MOVB (R5)+,@R3 ;Copy a byte at a time CMPB @R3,#<'a> ;Less than lowercase a? BLO 50$ ;Branch if yes - no conversion CMPB @R3,#<'z> ;Greater than lowercase z? BHI 50$ ;Branch if yes - no conversion BICB #<40>,@R3 ;Convert lowercase alpha to uppercase 50$: INC R3 ;Advance pointer RETURN .ENDC ;NE SYT$K ;+ ; Subroutine to Compute Switch Value ;- .ENABL LSB SWVAL: MOV @SP,-(SP) ;Save return addr & make room for value MOV R5,-(SP) ;Save scan pointer OCALL DECNUM ;Try conversion as decimal DEC R5 ;Point past delimiter CMPB 1(R5),#<'.> ;Was it a decimal point? BEQ 10$ ;Yes, we guessed right TST (SP)+ ;No, throw away value MOV @SP,R5 ;Restore text pointer OCALL OCTNUM ;Convert as octal 10$: MOV (SP)+,@SP ;Throw away saved pointer BCS BDSWCH ;Too big! ASL @SP ;Needs to be *2 MOV (SP)+,2(SP) ;Stack the value RETURN ............ .DSABL LSB .SBTTL FRUN/SRUN Option Text Table ;+ ; Option Text for FRUN/SRUN ;- .IRP NUM,<\$OPTX> OPTX'NUM:: .ENDR .BYTE -1 .DSABL CRF $SCNT=0 SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT .EVEN .ENABL CRF NEXTL ............ .SBTTL FRUN/SRUN Overlay II OVERLAY .SBTTL FRUN/SRUN Commands (Part 2) OVCMD FSRU2 .ENABL LSB ;+ ; Recover switch values saved by DCL switch action routines... ;- OINST MOV FILST+OFLEV,(PC)+,* ;Get job/task number NWJBNM: .WORD 0 ;New job number OINST MOV FILST+OFPSW,-(SP),* ; and the /PAUSE switch OINST MOV FILST+OFBUF,(PC)+,* ;Get extra memory request (if any) NVAL: .WORD 0 ;Extra memory requested ;+ ; Read block 0 of the REL file - the pseudo CCB for REL files ;- OINST MOV .USRBU,RELBUF,* ;Use USR buffer for reading file CALL RDBUF ;Read block 0 of program into USR buffer MOV R4,R5 ;Point to first block of file ;+ ; Set up $VLY for later call to $VRAW if /V overlays are in program ;- .IF NE MMG$T CMP #<^rHAN>,@R4 ;Is this a runnable handler? BEQ 10$ ;Branch if yes OINST MOV RL.SEG(R4),$VLY,,* ;Save start of virtual segment info in tble BEQ 10$ ;No virtual overlays, leave $VLY flag as 0 OINST MOV RL.OVR(R4),$VLY,,* ;If /V overlays, save addr. of overlay tble 10$: .ENDC ;NE MMG$T ;+ ; Compute total program core requirements and allocate space ;- MOV R5,R3 ;Point to size of ... ADD #,R3 ; ... root in first block MOV (R3)+,R4 ;Get size of root segment .IF EQ MMG$T MOV $JSW(R5),OVFLG ;Set up OVFLG from $JSW flag BIC #^c,(PC)+ ;Isolate overlay bit OVFLG: .WORD 0 ;Non-0 => overlaid .IFF ;EQ MMG$T MOV $JSW(R5),-(SP) ;Get task $JSW MOV @SP,OVFLG ;Copy it into the overlay flag BIC #^c,(PC)+ ;Isolate overlay flag bit OVFLG: .WORD 0 ;Non-0 => overlaid BIT #,(SP)+ ;Is it a virtual job? BEQ 20$ ;Not virtual CLR @R3 ;Virtual, stack size is 0 ADD #,R4 ;Root size is a block bigger CLR NVFLG ;Don't unbias for base of 1000, flag 0 => Virt 20$: .ENDC ;EQ MMG$T MOV (R3)+,R0 ;Get stack size of fjob TST (R3)+ ;Bump over size of overlays MOV #,R2 ;Get size of impure area MOV $USRSP(R5),-(SP) ;Get user's stack pointer SUB (PC)+,@SP ;Relocate stack NVFLG: .WORD 1000 ;Link address of REL file .IF EQ MMG$T BNE 40$ ;Don't allocate a stack if he supplied one .IFF ;EQ MMG$T BEQ 30$ ;No stack supplied, allocate one TST NVFLG ;Virtual task? BEQ 40$ ;Yes, don't relocate stack ADD R2,@SP ;No, add length of impure area BR 40$ ; to user specified stack location ............ 30$: .ENDC ;EQ MMG$T ADD R0,R2 ;Add stack size 40$: MOV R2,-(SP) ;Save offset from FG memory area to code start MOV R2,R1 ;R1 = size of impure area + stack ... SUB NVFLG,R1 ; ... - Link base MOV R1,FBASE ;Save in FBASE CMP #<^rREL>,(R3)+ ;Is this a REL file? BEQ 60$ ;Yes .IF NE MMG$T TST NVFLG ;No, is this a virtual job? BEQ 50$ ;Yes, virtual jobs are ok to FRUN .ENDC ;NE MMG$T ;+ ;ERROR KMRTMG ,,PFILE ;- ............ .IF NE MMG$T ;+ ; FRUN/SRUN of a Virtual .SAV image ;- 50$: MOV $USRTO(R5),R4 ;R4 = last used addr for Root + /O overlays ADD #<2>,R4 ;Convert last address used to size CLR @R3 ;No REL info -> blk = 0 (override any .ASECT) CMP #<^rVIR>,@R5 ;Is it a /V job? BNE 60$ ;No, just a virtual .SAV job CLR NVAL ;/V jobs can not use /N (normal virtual can) MOV $VIRTO(R5),(PC)+ ;Save virtual high limit of job (loc 2) VHGH: .WORD 0 ;Virtual high limit of job (0 if not /V job) .ENDC ;NE MMG$T 60$: MOV @R3,RELBLK ;Save block number of start of REL information ADD R4,R2 ;R2 = offset to overlay region ROR R4 ;Convert root size to words MOV R4,OVSIZ ; and set in I/O block MOV R2,-(SP) ;Save offset for ovly I/O block ADD RL.OSZ(R5),R2 ;Size of overlay region ;R2 = prog. high limit MOV NVAL,R0 ;Get requested free memory ADD R2,R0 ;Add impure area & prog size .IF NE MMG$T TST NVFLG ;Virtual task? BNE 70$ ;No, privileged MOV #,R3 ;Use to round values to 32. words MOV R0,R1 ;Copy size of region required SUB #,R1 ;Make it program size (including extra space) ADD R3,R1 ;Round up to nearest 32 word block BIC R3,R1 ; multiple MOV R1,(PC)+ ;Save size that we must map PVSIZ: .WORD 0 ;Program virtual size in bytes ADD #,R0 ;Round up to nearest 32 word block BIC R3,R0 ; ADD #<100>,@SP ;Adjust stack work space address 70$: .ENDC ;NE MMG$T MOV SP,@<.EXTFL-OVLY>-<.+4-OVLYST>(PC) ;Inhibit CTRL/C OCALL GETBLK ;Allocate some core BCC 80$ ;Was KMON/USR moved? SUB R0,R5 ;Yes, relocate pointer to USR buffer, SUB R0,10(SP) ; stack for RTS PC from STRTPG, SUB R0,RELBUF ; and buffer to read REL blocks into 80$: .IF NE MMG$T MOV R4,R0 ;Copy region address ADD #,R0 ;Add impure area offset ADD #,R0 ;Round up to nearest 32 word block, BIC #,R0 ; giving the program load point MOV R0,STOVL ;Save for later ADD PVSIZ,R0 ;R0 = program high physical limit MOV R0,(PC)+ ;Save for later RHLIM: .WORD 0 ;High physical address .ENDC ;NE MMG$T ;+ ; Clear impure area before initialization ;- MOV #,R0 ;R0 = number of words in impure area MOV R4,R1 ;R1 => impure area 90$: CLR (R1)+ ;Clear a word SOB R0,90$ ;Loop until done ;+ ; Save contents of CCB 34-50 on stack for later use ;- ADD R4,FBASE ;FBASE=load point+size of impure area ; +stack size-link base ADD R4,@SP ;Relocate overlay area offset MOV (SP)+,(PC)+ ;Save it as FRJOOF: .WORD 0 ; overlay load address MOV (SP)+,R0 ;Get program base offset MOV (SP)+,R1 ;Stack specified? BNE 100$ ;Yes MOV R0,R1 ;No, set up stack pointer at bottom of program 100$: .IF EQ MMG$T ADD R4,R1 ;Relocate the stack pointer MOV R1,R3 ;Copy it .IFF ;EQ MMG$T TST NVFLG ;Virtual job? BNE 110$ ;No, go relocate SP BIS #,@R4 ;Set virtual flag in Job State Word in impure SUB #,R2 ;R2 = actual size of virtual job MOV VHGH,I.VHI(R4) ;Save virtual high limit in impure area CLR FBASE ;Relocation constant = 0 CLR R0 ;Relocation constant is 0 BR 120$ ;Merge ............ 110$: ADD R4,R1 ;Relocate the stack .ENDC ;EQ MMG$T ADD R4,R2 ;R2 = top of program ADD R4,R0 ;Relocate program physical base address MOV R0,STOVL ;Save physical address to load root SUB NVFLG,R0 ;Subtract Link base of REL file 120$: ;MOV PSWICH,-(SP) ;Insert /P switch MOV STOVL,-(SP) ; and load addr MOV R1,-(SP) ;Save user stack address 130$: MOV R5,R1 ;Copy pointer to block 0 .IF EQ MMG$T ADD #,R1 ;Point to job's BPT vector in block 0 CLR -(R3) ;Put dummy PSW on stack MOV $USRPC(R5),-(R3) ;Set FG job PC to program start address ADD R0,@R3 ; and relocate it SUB #<6*2>,R3 ;Advance past save area for R0-R5 on stack .IFF ;EQ MMG$T ADD #,R1 ;Start with MMU vector MOV R4,R3 ;Copy impure area pointer ADD #,R3 ;R3 -> saved PSW MOV $USRPC(R5),-(R3) ;Set FG job PC to program start address ADD R0,@R3 ; and relocate it MOV #,-(R3) ;Put initial PS in save area MOV #,-(R3) ;Initial KERNEL PAR1 value CALL MOVVEC ;Save MMU fault vector ADD #V.BPT-,R1 ;Point to BPT vector .IFTF ;EQ MMG$T CALL MOVVC2 ;Move & relocate BPT vector and IOT vector ADD #V.TRAP-,R1 ;Point to TRAP vector .IFF ;EQ MMG$T MOV @SP,I.SP(R4) ;Save user stack pointer MOV @SP,I.SPSV(R4) ;Say nothing is saved on stack .ENDC ;EQ MMG$T CALL MOVVC2 ;Move & relocate TRAP vector and 40-42 MOV (SP)+,@R3 ;Put user sp value in loc 42 MOV (R1)+,-(R3) ;Save FG $JSW .IF NE MTT$Y MOV @R3,I.TERM(R4) ;Save FG $JSW for later I.TERM setup .ENDC ;NE MTT$Y CALL MOVVEC ;Move and relocate USR SWAP area address MOV R2,@R3 ;Store job's High Limit (loc 50) SUB #<2>,@R3 ;Adjust to last used address MOV R2,-(SP) ;Save for STRTPG (GTJOB High Limit, nxt avail) ADD NVAL,@SP ;Add free space CLR -(R3) ;Clear User Error Byte .IF NE MTT$Y OADDR FILST+OFTCB+2,R2 ;R2 -> FG TCB save area MOV @R2,R2 ;R2 -> TCB MOV T.TFIL(R2),-(R3) ;Copy fill char & count .ENDC ;NE MTT$Y .IF EQ MMG$T MOV R3,I.SP(R4) ;Save user stack in impure area .ENDC ;EQ MMG$T .DSABL LSB ;+ ; Impure Area Initialization ; ; Set up the TTY ring buffers, I/O queue elements, ; I/O channels and context information. ;- .ENABL LSB MOV R4,(PC)+ ;Save start of impure area STMPUR: .WORD 0 .ADDR #,R1 ;Point to the table of self-relative locations 10$: MOV (R1)+,R2 ;Get first impure offset to load ADD R4,R2 ;Point into impure area MOV (R1)+,@R2 ;Load impure word with pointer into impure ADD R4,@R2 ; and relocate the pointer TST @R1 ;End of table? BNE 10$ ;Loop for more MOV #,I.SYCH(R4) ;Make sys chan active with "SY" index MOV #,I.CNUM(R4) ; and number of channels ADD #+IMP.SZ-I.CSW,R2 ;R2 -> Overlay channel MOV R2,R0 ;Copy pointer to overlay channel MOV #$CSW+-$RMON,R1 ;Get displacement to CH 15 ADD @#$SYPTR,R1 ;Point to Background Channel 15 .REPT MOV (R1)+,(R2)+ ;Move Channel 15 to FG (for overlays) .ENDR TST OVFLG ;Was job overlaid? BNE 20$ ;Yes, leave channel open CLR @R0 ;No, close the overlay channel 20$: MOV R2,-(SP) ;Save job low limit = top of channel area ;I&D+ MOV NWJBNM,R1 ;Get job # (2, 4, 6, 10, 12, 14, or 16) MOV R1,I.JNUM(R4) ;Set up job number in impure area ;I&D- .IF NE MMG$T ;I&D+ .IF NE SUP$Y MOV #,I.CMAP(R4) ;Initial .CMAP state .ENDC ;NE SUP$Y ASR R1 ;Get job level (1, 2, 3, 4, 5, 6, or 7) MUL #,R1 ;Calculate chunk offset into MCA region ADD #,R1 ;Add in base of MCA region MOV R1,I.MPTR(R4) ;Save chunk pointer to job's MCA MOV R1,@#UISAR6 ;Map job's MCA MOV #,R2 ;R2 = word size of job's MCA MOV #,R0 ;R0 = virtual addr past end of job's MCA 21$: CLR -(R0) ;Clear a word... .ASSUME M.RGN EQ 0 SOB R2,21$ ; ...until all clear .IF NE SUP$Y ; CLR @# ;Initial state of job's MMR3 ; ; is cleared by clear loop above .ENDC ;NE SUP$Y ;I&D- TST NVFLG ;Virtual task? BNE 40$ ;No, privileged, don't initialize RCBS or WCBS CLR @SP ;Change low limit of virtual job to 0 ;I&D+ OCALL TEM$P ;Temporarily stuffed in KMON TEM$P1==:OVLYST ;I&D- 30$: INCB W.BNPD-W.BLPD(R2) ;Bump number of PDRs SUB #,R0 ;Another PDR needed? BGT 30$ ;Yes, loop SWAB R0 ;Unused size to high byte CLRB R0 ;Clear low bits ADD #,R0 ;Convert to PDR contents MOV R0,@R2 ;Save contents of last PDR 40$: ;I&D+ MOV #,@#UISAR6 ;Remap normal user PAR6 ;I&D- OINST TST $VLY,,* ;Do we Create a Region? BEQ 60$ ;No OCALL $VRAW ;Create Region and init windows ;I&D+ MOV I.MPTR(R4),R1 ;Save job's MCA chunk pointer MOV @#$SYPTR,R0 ;Get base of RMON MOV (R0),@#UISAR5 ;Map KMON's MCA MOV R1,@#UISAR6 ;Map job's MCA MOV #,R0 ;Point to KMON's second RCB ;I&D- MOV #<3>,R2 ;Loop counter 50$: MOV @R0,(R0) ;Give region to job CLR (R0)+ ; and release it from KMON SOB R2,50$ ;Decrement counter and continue ;I&D+ MOV #,@#UISAR5 ;Remap normal user PAR5 MOV #,@#UISAR6 ;Remap normal user PAR6 ;I&D- 60$: .ENDC ;NE MMG$T OINST MOV @.CNTXT,R1,* ;R1 -> background impure area .IF NE SYT$K CMP #,I.JNUM(R4) ;Is it a system job? BNE 70$ ;Yes, don't set up message channel .ENDC ;NE SYT$K MOV I.MSG(R1),I.MSG(R4) ;Copy message channel CSW from BG 70$: MOV #,R2 ;Get offset to job name ADD R2,R1 ;Point to BG I.NAME (from 'RFILE') ADD R4,R2 ;Point to new I.NAME field .REPT 4 ;Copy it to our impure area... MOV (R1)+,(R2)+ .ENDR .DSABL LSB ;+ ; Read Root Program Section Into Memory ;- .ENABL LSB .ADDR #,R0 ;R0 -> I/O block MOV R0,-(SP) ;Save on stack .IF NE MMG$T TST NVFLG ;Virtual job? BEQ 10$ ;Yes, start reading with block 0 .ENDC ;NE MMG$T INC @R0 ;Root always in block 1 10$: MOV (PC)+,-(R0) ;Set function code to READ overlay channel .BYTE ,<.READ> EMT ...REA ;Read the root BCS FRERR ;Error reading root ;+ ; Set up to relocate the root segment now in core ; On entry STOVL=address at which the root is loaded ;- RELSET: MOV (PC)+,R1 ;Get program relocation base FBASE: .WORD 0 ;= load pt.+impure area+stack-link base(1000) MOV STOVL,R4 ;Get start of root area (linked @ 1000) .IF NE MMG$T TST NVFLG ;Virtual task? BNE 20$ ;No MOV (PC)+,(R4)+ ;Move a BIC and BIC R0,R0 MOV (PC)+,(R4)+ ; an .ASTX into virtual 0 and 2 .ASTX ADD #<1000-4>,R4 ;Point to location 1000 within job TST RELBLK ;Is there any REL information? BEQ 60$ ;No, it's easy 20$: .ENDC ;NE MMG$T MOV R4,(PC)+ ;Save program load address SAVLOD: .WORD 0 ;Program root load address CLR R5 ;Force a buffer read the first time .BR RLROOT ............ ;+ ; Relocate the Root Segment ;- RLROOT: MOV SAVLOD,STOVL ;Start at program load address CALL RELSEG ;Relocate the root MOV FRJOOF,STOVL ;Store the load address of overlays ;+ ; Read each overlay segment, relocate it, and rewrite it in the file ;- 30$: TST FLG2 ;End of all REL blocks? BNE 60$ ;Yes, it's time to start it up CALL GET2WD ;No, get next overlay's block & size MOV @SP,R0 ;Point to IOB to read overlay MOV R3,@R0 ;Save overlay block number in IOB MOV R2,OVSIZ ;Save the size in words BEQ RLROOT ;0 => LINK is passing LIBR info ;So switch back to the root MOV (PC)+,-(R0) ;Set function code to READ overlay channel .BYTE ,<.READ> EMT ...REA ;Read the overlay into the overlay area BCS FRERR ;If error, free memory and report it CALL RELSEG ;Relocate an overlay segment MOV @SP,R0 ;R0 -> I/O block MOV (PC)+,-(R0) ;Set function code to WRITE overlay channel .BYTE ,<.WRIT> EMT ...WRI ;Write the overlay BCC 30$ ;Success, go do another overlay MOV 2(SP),R4 ;Point to job's memory area BEQ 40$ ;No memory allocated OCALL PUTBLK ;Release memory ;+ ;ERROR 40$: KMRTMG ,,PFILE ;- ............ FRERR: MOV 2(SP),R4 ;Point to job's memory area BEQ 50$ ;None allocated yet OCALL PUTBLK ;Release the allocated memory 50$: OCALLR FIPERR ;Report an input error ............ ;+ ; Done loading, go start up the program ;- 60$: MOV NWJBNM,@SP ;Save STMPUR & job number for MOV STMPUR,-(SP) ; crossing KMON overlay OVLINK FSR3 ;Go fixup protected vectors and start program ............ .DSABL LSB ;+ ; RELSEG - Relocate a Program Segment (Root or Overlay) ; ; R1 = program relocation bias ; R4 -> current buffer position ; R5 -> end of buffer ; ; CALL RELSEG ; ; R0,R2,R3 = undefined ; R4,R5 updated ;- .ENABL LSB 10$: SUB R1,@R0 ;Do subtractive relocation RELSEG: CALL GET2WD ;Get 2 words to relocate BCS 20$ ;No more, return MOV R3,R0 ;Copy offset to location ASL R0 ;Adjust to word boundary, dump direction bit ADD STOVL,R0 ;Relocate pointer to word to relocate MOV R2,@R0 ;Set up location's original contents ASL R3 ;Extract relocation sign BCS 10$ ;Go do negative relocation ADD R1,@R0 ;Do additive relocation BR RELSEG ;Do another ............ ;+ ; RDBUF - Read Next Two Blocks of REL Information into USR Buffer ; ; RLIOBK = set up to read ; ; CALL RDBUF ; ; R0 = number of bytes read (0, 1000, or 2000) ; R4 -> start of buffer ; R5 -> past end of buffer ; RELBLK updated by 2 ; ; Error if EOF encountered (before -2 found in REL information) ;- RDBUF: .ADDR #,R0 ;Point to IOB with current REL block to read EMT ...REA ;Do the read BCS FRERR ;Error ADD #<2>,RELBLK ;Bump block number by two MOV RELBUF,R4 ;Point at buffer MOV R4,R5 ;Copy pointer ASL R0 ;Convert word count read to byte count ADD R0,R5 ;Point past end of buffer 20$: RETURN ............ .DSABL LSB ;+ ; GET2WD - Get Next Two Words of REL Information ; ; R4 -> current buffer position ; R5 -> end of buffer ; ; CALL GET2WD ; ; R2 = second word of REL information ; R3 = first word of REL information ; R4 -> next word ; ; C=1 if -1 or -2 encountered ; FLG2<>0 if -2 encountered ;- .ENABL LSB GET2WD: CALL 10$ ;Get a word CMP #-2,R2 ;Check for -1 or -2 BHI 10$ ;Not -1 and not -2 BLO 50$ ;If -1, c=1 -- return with carry set INC (PC)+ ;Set -2 flag non-zero FLG2: .WORD 0 ;End of REL flag (if non-zero) BR 40$ ;Flag it with c=1 ............ 10$: MOV R2,R3 ;Return first word in R3 20$: CMP R4,R5 ;End of buffer? BLO 30$ ;No CALL RDBUF ;Yes, read a new buffer load 30$: MOV (R4)+,R2 ;Get a word TST (PC)+ ;Clear carry and skip 'SEC' 40$: SEC 50$: RETURN ............ .DSABL LSB ;+ ; MOVVEC - Move and Relocate a Vector Pair ; ; R0 = relocation bias ; R1 -> pair ; R3 -> destination + 4 ; ; CALL MOVVEC ;- .ENABL LSB MOVVC2: MOV PC,-(SP) ;Do the following twice MOVVEC: MOV (R1)+,-(R3) ;Move vector PC into place BEQ 10$ ;None specified, ignore it ADD R0,@R3 ;Relocate the vector address 10$: MOV (R1)+,-(R3) ;Move vector PS into place .IF NE MMG$T BIS #,@R3 ;Make sure user mode bits are set .ENDC ;NE MMG$T RETURN ............ .DSABL LSB ;+ ; Impure Area Initialization Table ;- IMPINI: .WORD I.QHDR, I.QUE ;Initial queue element .WORD I.TID, I.JID ;Job id string pointer .WORD I.SCHP, I.SYCH ;System channel pointer .WORD I.IRNG, .WORD I.IPUT, .WORD I.IGET, .WORD I.ITOP, .WORD I.OPUT, .WORD I.OGET, .WORD I.OTOP, .IF NE MMG$T .IF NE FPU$11 .WORD I.FPSA, I.FSAV ;Pointer to FPU save area .ENDC ;NE FPU$11 .ENDC ;NE MMG$T .WORD I.CSW, IMP.SZ ;CSW area is after impure area (must be last) .WORD 0 ............ ;+ ; I/O Block for Reading REL Blocks ;- RLIOBK: .BYTE CHOVLY, 10 ;Channel CHOVLY / READ code RELBLK: .WORD 0 ;Current REL block RELBUF: .WORD 0, , 0 ;Current Buffer Ptr, 2 blocks, WAIT I/O ............ ;+ ; Overlay I/O Block for READ/WRITE I/O ;- OVIOBK: .BYTE CHOVLY, 10 ;Channel CHOVLY / READ=10, WRITE=11 OVBK: .WORD 0 ;Current overlay block # STOVL: .WORD 0 ;Start of overlay region OVSIZ: .WORD 0 ;Current overlay word size .WORD 0 ;Wait I/O ............ .ENDC ;NE FRUN$$!SRUN$$ ;Runs over last 2 overlays .IF NE DISM$$!MOUN$$ .SBTTL DISMOUNT/MOUNT Overlay OVERLAY .IF NE DISM$$ ;If DISMOUNT command (for next page) .SBTTL DISMOUNT Command ;+ ; DISMOUNT Command ;- SYNTAX DISMOUNT PROMPT $DEVICE REQBLNK SETSWIT K END ............ SWITS DISMOUNT ENDNO NOS ENDS ............ .ENABL LSB OVCMD DISMOUNT MOV R5,-(SP) ;Save command line pointer ITBLE 0 ;Maximum number of file specs OCALL INITIT ;Do the parse MOV (SP)+,R5 ;Restore command line pointer CALL MGTNM ;Get device name BCS 10$ ;Branch if error - Invalid command TSTB @R5 ;End of command string? BNE 10$ ;Branch if error - invalid command CLR R5 ;Flag common code that this is a DISMOUNT BR LDCOM ;Go use common code to look for LD ............ 10$: OCALLR BADCOM ;End of line-illegal command ............ .DSABL LSB .ENDC ;NE DISM$$ .IF NE MOUN$$ ;If MOUNT command (for next page) .SBTTL MOUNT Command ;+ ; MOUNT Command ;- SYNTAX MOUNT PROMPT $DEVICE SCALL GSWIT,<1> REQBLNK INSPEC SCALL GSWIT,<1> PROMPT $FILEE SCALL RINSPC,<1> EOLGOT MNTB SCALL RINSPC,<1> MNTB: END ............ SWITS MOUNT SWIT QUERY 1 - - Q SWIT WARNING 1 - - O SWIT WRITE 1 - - W SWIT DIRECTORY 1 - - G SWIT LOCK 1 - - M ENDNO SWIT DEVICE 1 - - D SWIT EXTEND 1 - - T,,DVAL SWIT FILE 1 - - F SWIT FOREIGN 1 - - X .IF EQ SB SWIT JOB 1 - - JOB .ENDC ;EQ SB SWIT PRIVATE 1 - - P SWIT READONLY 1 - - R SWIT UNIT 1 - - U,,VAL SWIT NATIVE 1 - - V NOS SWIT NOQUERY 1 - - Y SWIT NOWARNING 1 - - S SWIT NOWRITE 1 - - R SWIT NODIRECTORY 1 - - H SWIT NOLOCK 1 - - N ENDS ............ ;+ ; MOUNT ; The mount command has the following syntax: ; ; MOUNT[/option device-name[:] volume [logical-name[:]] ; ; First, the line is parsed for prompting and processing of switches. ; The chain command is later built. The switches are built into the chain ; command using the KMON routine DOSWIT and the KMON switch data structures. ;- .ENABL LSB OVCMD MOUNT MOV R5,-(SP) ;Store buffer start ITBLE 3 OCALL INITIT ;Parse command into switch table information ;+ ; Restore original pointer to beginning of the command string. Find the first ; device specification and put it into R2. Ignore options found on the line ; as they have already been processed by INITIT. ;- 10$: MOV (SP)+,R5 ;Restore pointer to line CALL CKOPT ;Check for option switch CALL MGTNM ;Get device name BCS 20$ ;Branch if error - invalid command CMPB #<' >,@R5 ;Must have a space as part of syntax BNE 20$ ;Branch for error if not blank between fields CALL CKOPT ;Check for option .BR LDCOM ............ .ENDC ;NE MOUN$$ ;+ ; Common code for MOUNT/DISMOUNT ; ; The RAD50 device-name is pointed to by R2. Check block zero of the ; device handler to make sure that this device supports the MOUNT command. ; If so, finish setting up the command in the chain area, and chain to ; the runnable handler. ;- LDCOM: MOV R5,-(SP) ;Save R5. LK4DEV is merciless. OINST MOV @R2,INPFN,,* ;Save device for error message MOV R2,R0 ;R0->Device (RAD50) CLC ;Say do logical translation OJSR R4,.LK4DV,@ ;And look for handler in monitor tables BR 50$ ;Error - handler not in device tables ...... OINST ADD .$PNAM,R3,* ;Make index into pointer for PNAME table MOV @R3,-(R0) ;Save device name (without unit) (RAD50) MOV R1,R3 ;R3=unit number MOV (SP)+,R5 ;Restore R5 ;+ ; Build the handler DBLK in the chain area ;- MOV #,R1 ;Point to chain block to store RUN command MOV #<^rSY >,(R1)+ ;Move device name in MOV @R0,@R1 ;Handler name MOV @#$SYPTR,R4 ;Make sure we're pointing to RMON ADD HSUFFX-$RMON(R4),(R1)+ ;Add handler suffix CLR (R1)+ ;No second word of filename MOV #<^rSYS>,(R1)+ ;And extension CLR (R1)+ ;Clear next 2 words (510 and 512) to ... CLR @R1 ; ... avoid chaining back (in LD.SYS) BR 60$ ............ ;+ ; Error Returns ;- 20$: OCALLR BADCOM ;Invalid command ............ 30$: OCALLR NOTFND ;Device not found error ............ 40$: OCALLR FIPERR ;System device I/O error ............ 50$: OCALLR BADHAN ;Illegal device ............ ;+ ; At this point the device file name is in the chain area at location 500. ; Read in block 0 of handler to see if it supports the MOUNT command. ; If it does not, give "invalid device" error. ;- 60$: .PURGE # ;Purge channel CHOVLY (Overlay channel) MOV #,R0 ;Copy pointer to file name OINST MOV INPFN,-(SP),* ;Remember the mount device MOV R3,-(SP) ;Copy destroys R3 OCALL COPYFN ;Copy file name in case of error MOV (SP)+,R3 ; .LOOKUP CHOVLY,R0 ;Look up the handler BCS 30$ ;Error 70$: OINST MOV .USRBUF,R4,* ;Point to USR buffer CLR @<.BLKEY-OVLY>-<.+4-OVLYST>(PC) ;We will clobber directory CLR R0 ;Read block 0 .READW CHOVLY,R4,# ;Read 1st 2 blocks into USR buffer BCS 40$ ;Error- file input OINST MOV (SP)+,INPFN,,* ;Restore the mount device for future errors 80$: ADD #,R4 ;Point to second status word in handler BIT #,@R4 ;Does it support mounts? BEQ 50$ ;+ ; At this time R3 contains the unit number. Put the CSI command in the ; chain area. ;- 90$: MOV #,R1 ;Point to area to create CSI line TST R5 ;MOUNT or DISMOUNT command? BEQ 160$ ;DISMOUNT .IF NE MOUN$$ ;If MOUNT command 100$: MOVB -(R5),(R1)+ ;Store a character BEQ 130$ ;Branch if end of string CMPB #<' >,@R5 ;Space character the next character? BEQ 110$ ;Yes, check for next field, option, or end CMPB #<'/>,@R5 ;Next character a slash? BNE 100$ ;No, store it in chain buffer TSTB -(R1) ;Backup text pointer over last slash character 110$: CALL CKOPT ;Check for option TSTB @R5 ;End of string? BEQ 140$ ;Branch if yes to store /L MOV R5,(PC)+ ;Save pointer to area to store BSAV: .WORD 0 ;Start of string CALL MGTNM ;Get device name BCS 20$ ;Branch if error - invalid command MOV R5,R2 CALL CKOPT ;Check for option TSTB @R5 ;End of line? BNE 20$ ;Branch if no - invalid construction MOV BSAV,R5 ;Restore the string pointer TSTB -(R1) ;Adjust pointer to remove copied space .ADDR #,R0 ;Point to /A text to store in chain block .REPT 3 MOVB (R0)+,(R1)+ ;Move in /A text .ENDR 120$: MOVB -(R5),(R1)+ ;Move logical device name into csi string CMP R5,R2 ;Done? BNE 120$ ;Branch if no 130$: TSTB -(R1) ;Reset pointer so that there are no blanks 140$: MOV R3,-(SP) ;Save R3=unit number CLR R2 ;Start with options on command MOV R1,R5 ;R5->Command line in chain area OINST DECB GENFLG,,* ;Tell KMON we mean business (generate command) 150$: OCALL DOSWIT ;Let DOSWIT decipher table and build options INC R2 ;Now get options on next part of command OINST CMPB R2,FILNUM,,* ;Loop through for position independent options BLE 150$ ;Til done MOV (SP)+,R3 ;Restore R3 MOV R5,R1 ;Get new pointer in chain command .ENDC ;NE MOUN$$ 160$: .ADDR #,R0 ;Point to /L text to store in chain block .REPT 5 MOVB (R0)+,(R1)+ ;Move in /L text .ENDR MOVB R3,-(SP) ;Save the unit # BIC #^c<70>,R3 ;Isolate high order octal digit .REPT 3 ASR R3 ;Shift to right justify .ENDR ADD #<'0>,R3 ;Make it ASCII MOVB R3,(R1)+ ;Store it in the chain area MOVB (SP)+,R3 ;Get back the unit # BIC #^c<7>,R3 ;Isolate low order octal digit ADD #<'0>,R3 ;Make it ASCII MOVB R3,(R1)+ ;Store it in chain area CLRB @R1 ;End CSI string CALLR CHANTO ;Go do common chain routine ............ CKOPT: CMPB #<'/>,@R5 ;Slash the next character? BEQ 170$ ;Branch if yes CMPB #<'/>,-1(R5) ;Is the next character a slash BNE 180$ ;Branch if no and adjust pointer 170$: TSTB @R5 ;End of string? BEQ 180$ ;Branch if yes CMPB #<' >,-(R5) ;Skip over option BNE 170$ ;Loop till done 180$: RETURN ............ .DSABL LSB SLSHL: .ASCIZ "/$/L:" ;Slash L text to store in chain block .IF NE MOUN$$ ;If MOUNT command SLSHA: .ASCIZ "/A:" ;Slash A text to store in chain block ............ .ENDC ;NE MOUN$$ ;+ ; Setup pointers and test for command line character ;- MADSUB: OADDR BLOCK,R2 ;Pointer to work block MOV @#$SYPTR,R4 ;R4 -> RMON TSTB @R5 ;End of command? RETURN ;Return with condition code set by terminator ............ ;+ ; Get a device name from the command line in @R2 ;- .ENABL LSB MGTNM: CALL MADSUB ;Setup pointers MGTNM1: OCALL GETNAM ;Get device name BEQ 10$ ;Error. No name OCALL OPTCOL ;Point past optional colon TST 2(R2) ;Was a file name specified? BNE 10$ ;Give error if yes TST (PC)+ ;Clear C-bit for success 10$: SEC ;Error occured - invalid command RETURN ............ .DSABL LSB ;+ ; Chain to the handler's mount utility ;- CHANTO: .SRESET ;Clear all channels .IF NE MMG$T BIC #,@#$JSW ;Ensure that the virtual bit is off .ENDC ;NE MMG$T .CHAIN ;Chain to LD.SYS ............ .IF EQ SB ;+ ; Action routine to convert job name to job number ;- .ENABL LSB OVAJOB: ;+ ;Preserve R3 for ESWIT call ;- OADDR BLOCK+6,R0 ;Point to start of scratch buffer CLR -(R0) ;Clear it out CLR -(R0) CLR -(R0) MOV R0,-(SP) ;Save the starting address MOV #<7>,R1 ;Get count plus 1 CMPB #<':>,@R5 ;Proper delimiter? BNE 50$ ;No, error TSTB @R5 ;Any job name? BEQ 20$ ;Branch if no - invalid command 10$: MOVB -(R5),(R0)+ ;Move job name into the buffer BEQ 30$ ;Branch if delimiter found CMPB @R5,#<'/> ; BEQ 30$ ; CMPB @R5,#<' > ; BEQ 30$ ; SOB R1,10$ ;Decrement the count and branch back for more 20$: OCALLR BADCOM ;Invalid command ............ 30$: CLRB -(R0) ;Make asciz MOV (SP)+,R0 ;Restore start of scratch buffer MOV R5,-(SP) ;Save R5 MOV R0,(PC)+ ;Save pointer to job name in case of error MOUJOB: .WORD 0 MOV @#$SYPTR,R1 ;Get starting address of RMON .IF EQ SYT$K BIC #,@R0 ;Convert user's input to uppercase CMPB #<'F>,@R0 ;Check for F for foreground job BNE 60$ ;Invalid job name MOV FCNTXT-$RMON(R1),R2 ;Get pointer to foreground impure area .IFF ;EQ SYT$K CALL FNDJOB-$RMON(R1) ;See if there's such a job BEQ 60$ ;No such job .ENDC ;EQ SYT$K MOV (SP)+,R5 ;Restore R5 INC R5 ;Move back one character MOVB I.JNUM(R2),R3 ;Make the job number into ascii BIC #<177770>,R3 ;Clear all but lowest octal digit ADD #<'0>,R3 ; and make it ascii MOVB R3,(R5)+ ;Put it in the command line MOV I.JNUM(R2),R3 ;Finish with high octal digit BIC #<177707>,R3 ;Clear all but second octal digit ASR R3 ; ASR R3 ;Move it down to the lowest ASR R3 ; ADD #<'0>,R3 ; and make it ascii MOVB R3,(R5)+ ;Put it in the command line MOVB #<':>,@R5 ;Value is preceeded by a colon .ADDR #<40$>,R3 ;Indicate switch takes a value CLR R1 ;Clear for routine call MOVB #<'J>,R2 ;Set up to add /J switch OCALL ESWIT ;Enter switch and return RETURN ............ 40$: .WORD SVALU ;Flag that option takes a value 50$: OCALLR ILSWIT ;Invalid switch ............ 60$: MOV MOUJOB,R4 ;Point to job name CLR @R3 ;+ ;ERROR KMRTMG ,,BCKASZ ;- .EVEN ............ .DSABL LSB .ENDC ;EQ SB .SBTTL DISMOUNT/MOUNT Option Text Table ;+ ; Option text table for the [DIS]MOUNT command ;- .IRP NUM,<\$OPTX> OPTX'NUM:: .ENDR .BYTE -1 .DSABL CRF $SCNT=0 SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT .EVEN .ENABL CRF NEXTL ............ .ENDC ;NE DISM$$!MOUN$$ .IF NE DIFF$$!SET$$!SQUE$$ .SBTTL DIFFERENCES/SET(Part 1)/SQUEEZE Overlay OVERLAY .IF NE DIFF$$ ;If DIFFERENCES command OVCMD DIFFERENCES CALLR DIF1 ............ .ENDC ;NE DIFF$$ .IF NE SQUE$$ ;If SQUEEZE command OVCMD SQUEEZE CALLR SQU1 ............ .ENDC ;NE SQUE$$ .IF NE SET$$ ;If SET command .SBTTL SET Command FBFLAG =: 100000 ;FB flag for RMON NOUNIT =: 100000 ;No unit number specified .ENABL LSB OVCMD SET MOV @#$SYPTR,R0 ;Point to resident monitor MOV R5,(PC)+ ;Save original pointer OLDR5: .WORD 0 CALL 150$ ;Get a handler or special option name ;+ ; Search for simple monitor options (SET EDIT, FORTRAN, WILD, ERROR) ;- .ADDR #,R1 ;Point to simple special options 10$: CMP @R2,(R1)+ ;Is this the simple special option? BEQ 20$ ;Yes, go do it TST @R1 ;No, end of simple special option list? BEQ NXTINS ;Yes, check to see if we've got a handler ADD @R1,R1 ;Advance to next special command BR 10$ ;Try this one ............ 20$: CALL 150$ ;Found simple special option, get item name TST (R1)+ ;Skip offset to next command ADD @R1,R0 ;Point to fixed offset byte in RMON 30$: TST (R1)+ ;Bump past code value TST @R1 ;End of item list for this option? BEQ 40$ ;Yes, error CMP (R1)+,@R2 ;Is this the item? BNE 30$ ;No, go get next MOVB @R1,@R0 ;Yes, move code to fixed offset byte RETURN ............ 40$: OCALLR BADCOM ;Invalid command ............ ;+ ; If we reach here the SET command did not match one of the simple SET options ; in the table (SETMOF). Here we test to see if a handler name was entered. ; ; There are several forms of device name we must recognize: ; ; D, Dn, Dnn, DD, DDn, and DDnn. ; ; In all cases we want to identify the unit number & the 2 letter device name. ;- NXTINS: MOV #,(PC)+ ;Assume no unit number specified UNUM: .WORD 0 MOV R5,(PC)+ ;Remember how far we've gotten in command line NEWR5: .WORD 0 .IF NE UNI$64 ;+ ;One letter device check ;- MOV OLDR5,R5 ;Get pointer to possible device name 50$: CMPB #<' >,-(R5) ;Skip spaces BEQ 50$ ;Leave pointer at second char of next word CALL 210$ ;Is this a single letter device name? BCS 60$ ;No MOV R2,R0 ;Point R0 to possible device name (RAD50) SEC ;Say don't do logical translation OJSR R4,.LK4DV,@ ;Look for device in monitor tables BR 100$ ;Branch device not found ...... MOV R0,R2 ;Point R2 at the file name space MOV NEWR5,R5 ;Restore R5 OINST ADD .$PNAM,R3,* ;Make index into pointer for PNAME table MOV @R3,@R2 ;R2-> 2 letter name in RAD50 word BR 80$ ; in filename space ............ .ENDC ;NE UNI$64 ;+ ;Two letter device name check ;- 60$: MOV OLDR5,R5 ;Get pointer to possible device name 70$: CMPB #<' >,-(R5) ;Skip spaces BEQ 70$ ;Leave pointer at second char of next word TSTB -(R5) ;Point to third character in device name CALL 210$ ;Is this a double letter device name? MOV NEWR5,R5 ;*C* Point to next word on line BCS 140$ ;Not a device, try non-handler ;+ ;When we reach here, we have the two letter device name in @R2 and the ; unit number in the UNUM (or high bit set). ;- 80$: JSR R4,180$ ;Skip over colon and spaces, if any .WORD <':> CMP @R2,#<^rTT > ;Is it 'SET TT'? BEQ 140$ ;Branch to do non-handler work 90$: MOV @#$SYPTR,R0 ;Point to RMON ADD HSUFFX-$RMON(R0),@R2 ;Make handler name 'HHX.SYS' MOV #<^rSY >,-(R2) ;The handler is on SY: CLR F.NAME+2(R2) ;Standard handler name MOV #<^rSYS>,F.TYPE(R2) ;Extension is .SYS .PURGE # ;Purge overlay channel MOV R2,R0 ;Copy pointer to file name OCALL COPYFN ;Copy file name in case of error .LOOKUP CHOVLY,R2 ;Look up the handler BCC 110$ ;We've got it 100$: OCALLR NOTFND ;It isn't there ............ 110$: OINST MOV .USRBUF,R4,* ;Point to USR buffer CLR @<.BLKEY-OVLY>-<.+4-OVLYST>(PC) ;We will clobber directory CLR R0 ;Read block 0 .READW CHOVLY,R4,# ;Read 1st 2 blocks into USR buffer BCC 120$ ;Branch if read OK OCALLR FIPERR ;System I/O error ............ 120$: ADD #,R4 ;Point to set option table in handler 130$: CLR R2 ;R2 =0 means this is a handler SET 140$: MOV UNUM,-(SP) ;Put UNUM on the stack to pass to SET2 OVLINK SET2 ;Get second SET overlay and jump to it ;>>>IS THIS RETURN NEEDED?? RETURN ............ ;+ ; Get Next Argument in String as 2 RAD50 Words ; Words are stored in DEVSTS work area in KMON ; Blanks following argument are skipped ; ; CALL 150$ ; ; R2 -> RAD50 words ;- 150$: OADDR DEVSTS+2,R2 ;Point to a handy block MOV R0,-(SP) ;Save R0 OCALL GETNAM ;Get 2 words of RAD50 BEQ 40$ ;Error if nothing to get MOV (SP)+,R0 ;Restore R0 160$: INC R5 ;Start scan for non-blank 170$: CMPB -(R5),#<' > ;Blank? BEQ 170$ ;Yes, keep going INC R5 ;No, back up RETURN ............ ;+ ; Skip Optional Byte and, If Present, Blank(s) After It ; ; JSR R4,180$ ; .word [byte to skip if present] ;- 180$: CMPB (R4)+,-(R5) ;Are we pointing to the optional byte? BEQ 190$ ;Yup INC R5 ;Nope, move where we were 190$: CMPB -(R5),#<' > ;Skip optional and spaces BEQ 190$ 200$: CMPB (R4)+,(R5)+ ;Fix R4 and R5 RTS R4 ;Out ............ ;+ ; Check if the unit number specified, starting at R5. If so, assume ; device spec and set up info. ; ; INPUT: ; R5 -> place to look at for unit number ; OUTPUT: ; R0,R4 destroyed and ; ; Carry clear: UNUM = Unit number or high bit set (as appropriate) ; R2 => device name sans unit number ; ie. If unit number was found, it is replaced with ; blanks and the device name is read into RAD50 @R2 ; again without the unit number ; OR ; ; Carry set: UNUM unchanged ;- 210$: MOV R5,R0 ;R0 => possible number DEC R0 ;Adjust for first character CLC ;Specify octal OCALL CVTNUM ;Find number CMP R5,R0 ;Did we move (ie. find a number) BEQ 230$ ;Nope MOV (SP)+,UNUM ;Yup, store unit number INC R0 ;Adjust back to first character 220$: MOVB #<' >,-(R0) ;Replace unit number with space(s) CMP R5,R0 ;Are we done? BNE 220$ ;No MOV OLDR5,R5 ;Point at the beginning of the device name CALL 150$ ;Get Rad50 name without the unit number BR 240$ ;Success ............ 230$: TST (SP)+ ;Dismiss return value from failed CVTNUM call CMPB @R5,#<' > ;Next character a space? BEQ 240$ ;Yes, good CMPB @R5,#<':> ;Or a colon? BNE 250$ ;No, not a device name 240$: TST (PC)+ ;SUCCESS 250$: SEC ;FAILURE RETURN ............ .DSABL LSB ;+ ; The macro .RMSET sets up the option table for a "simple" SET command. ;- .MACRO .RMSET OPTION,OFFSET,DEST .RAD50 \OPTION\ .WORD .WORD .ENDM .RMSET ;+ ; The macro .RMARG set up the table of parameter choices for a "simple" ; SET command. The '...V2' ensures that only one word will be allocated ; for the ARG RAD50 string. ;- .MACRO .RMARG ARG,VAL ...V2 = . .RAD50 \ARG\ . = <...V2+2.> .WORD .ENDM .RMARG .ENABL LSB SETMOF: .RMSET EDI,<10$-.>, ;SET EDIT .RMARG EDI,$$EDIT ;EDIT .RMARG TEC,$$TECO ;TECO .RMARG KED,$$KED ;KED .RMARG K52,$$K52 ;K52 .IF NE MMG$T .RMARG KEX,$$KEX ;KEX .ENDC ;NE MMG$T .WORD 0 ............ 10$: .RMSET WIL,<20$-.>, ;SET WILD .RMARG IMP,1 ;IMPLICIT .RMARG EXP,0 ;EXPLICIT .WORD 0 ............ 20$: .RMSET ERR,<30$-.>, ;SET ERROR .RMARG WAR, ;WARNING .RMARG ERR, ;ERROR .RMARG FAT, ;FATAL .RMARG UNC, ;UNCONDITIONAL .RMARG SEV, ;SEVERE .RMARG NON,<200!UNCON$> ;NONE .WORD 0 ............ 30$: .RMSET FOR,0,<$PROGF-$RMON> ;SET FORTRAN .RMARG F4,$$FORT ;F4 .RMARG F77,$$F77 ;F77 .WORD 0 ............ .DSABL LSB .ENDC ;NE SET$$ .IF NE DIFF$$ ;If DIFFERENCES command (for next page) .SBTTL DIFFERENCES Command ;+ ; DIFFERENCES Command ;- SYNTAX DIFFERENCES PROMPT $FILE1 DEFILE FSTARF CMDQUAL SCALL GSWIT,<1> FILQUAL REQBLNK SCALL SPISPC,<1> PROMPT $FILE2 FLDBEG DSYN1 REQCOMMA OPTEND GOTO DSYN2 ............ DSYN1: REQBLNK DSYN2: SCALL SPISPC,<1> CMDQUAL DEFOSPC $TTSPC EOLSEQ SRCCOM END ............ SWITS DIFFERENCES SWIT COMMENTS 1 SRCCOM - - SWIT SPACES 1 SRCCOM - - SWIT TRIM 1 SRCCOM - - ENDNO SWIT BLANKLINES 1 SRCCOM - B SWIT CASE 1 SRCCOM - I,,VAL SWIT FORMFEED 1 SRCCOM - F SWIT MATCH 1 SRCCOM - L,,DVAL SWIT SLP 1 SRCCOM - SOT SWIT CHANGEBAR 1 SRCCOM - D SWIT AUDITTRAIL 1 SRCCOM - A SWIT PRINTER 1 - - PRI SWIT TERMINAL 1 - - TER SWIT OUTPUT 1 - - OUT SWIT ALLOCATE 1 - - ALL SWIT BINARY 1 - BINCOM - SWIT BYTES 1 BINCOM - B SWIT START 1 BINCOM - S,,VAL SWIT END 1 BINCOM - E,,VAL SWIT QUIET 1 BINCOM - Q SWIT SIPP 1 BINCOM - SOT SWIT ALWAYS 1 BINCOM - O SWIT DEVICE 1 BINCOM - D NOS SWIT NOCOMMENTS 1 SRCCOM - C SWIT NOSPACES 1 SRCCOM - S SWIT NOTRIM 1 SRCCOM - T ENDS ............ .ENABL LSB DIF1: ITBLE 5 ;Set max number of file specs OCALL INITIT ;Do the parse OINST MOV FORCEP,R0,* ;Get the program to run BIC #^c,R0 ;Isolate the cusp number CMP #<$$BINC>,R0 ;BINCOM? BNE 10$ ;Branch if no OINST BISB #,DEFILB,,* ;Set extension wildcard bit 10$: OCALLR CMDEXE ;Generate the command text and ... ............ ; ... execute it .DSABL LSB .ENDC ;NE DIFF$$ .IF NE SQUE$$ ;If SQUEEZE command (for next page) .SBTTL SQUEEZE Command ;+ ; SQUEEZE Command ;- SYNTAX SQUEEZE PROMPT $DEVICE DEFILE FSTARF SCALL GSWIT,<1> REQBLNK SCALL RINSPC,<1> EOLSEQ DUP SETSWIT S END ............ SWITS SQUEEZE SWIT QUERY 1 DUP - - ENDNO SWIT OUTPUT 1 DUP - SOU SWIT WAIT 1 DUP - W NOS SWIT NOQUERY 1 - - Y ENDS ............ SQU1: ITBLE 2 ;Set max number of file specs OCALL INITIT ;Do the parse OCALLR CMDEXE ;Generate the command text and ... ............ ; ... execute it .DSABL LSB .ENDC ;NE SQUE$$ .IF NE DIFF$$!SQUE$$ ;If DIFFERENCES or SQUEEZE command(s) .SBTTL DIFFERENCES/SQUEEZE Option Text Table ;+ ; Option text table for DIFFERENCES and SQUEEZE commands ;- .IRP NUM,<\$OPTX> OPTX'NUM:: .ENDR .BYTE -1 .DSABL CRF $SCNT=0 SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT .EVEN .ENABL CRF NEXTL ............ .ENDC ;NE DIFF$$!SQUE$$ .ENDC ;NE DIFF$$!SET$$!SQUE$$ .IF NE SET$$ .SBTTL SET (Part 2) Overlay ;+ ; Second SET overlay ; ; INPUT from orginal SET overlay: ; ; R2 => SET option in RAD50 if it was not found to be ; a handler in the first overlay ; = 0 if the token was found to be a handler in the ; first overlay ; R4 => SET table in memory ; R5 => command line (current position) ; (SP) = unit number ;- OVERLAY .SBTTL SET Command (Part 2) .ENABL LSB OVCMD SET2 MOV (SP)+,(PC)+ ;Save unit number UNUM2: .WORD 0 MOV @#$SYPTR,R0 .IF EQ MTT$Y MOV TTCNFG-$RMON(R0),SET58$ ;Get current terminal configuration MOVB TTWIDTH-$RMON(R0),SET59$ ; and current terminal width .IFF ;EQ MTT$Y MOV BKCNSL-$RMON(R0),R1 ;Point to TCB of console terminal MOV @R1,SET58$ ;FETCH T.CNFG and MOV T.WID(R1),SET59$ ;T.WID from console TCB .ENDC ;EQ MTT$Y MOV CONFIG-$RMON(R0),SET62$ ;Get old CONFIG word BIC #^c,SET62$ ;Isolate old value of USR$ MOV CONFG2-$RMON(R0),SET63$ ;Get old contents of CONFG2 word BIC #^c,SET63$ ;Isolate the old XITSW$ setting .IF NE MMG$T MOV CONFG3-$RMON(R0),SET64$ ;get old CONFG3 word BIC #^c,SET64$ ;Isolate the old CF3.VB setting .ENDC ;NE MMG$T MOV CLIFLG-$RMON(R0),SET57$ ; Get current CLI flags BIC #^c,SET57$ ; Isolate flags ;+ ; If R2 <> 0, then we've got a non-handler SET command. ; Try to match it against our list: (TT, TERM, EXIT, USR, KMON, CLOCK). ; If No match -> error ; ; If R2 = 0, then the handler information has been taken care of. ; The handlers blocks 0 & 1 are already in memory. ; Skip to loop to process the SET command. ;- TST R2 ;Handler's SET table has already been BEQ 30$ ; read in, go process command .ADDR #,R4 ;Point to the internal SET list 10$: CMP (R4)+,@R2 ;Is this the syntax? BEQ 20$ ;Yes, let's go get the table address TST (R4)+ ;No, move to the next and try that one BNE 10$ ;End of list? Branch if not BR 60$ ;to OCALLR BADCOM, otherwise ............ ;+ ; Loop for each option in command line ;- 20$: ADD @R4,R4 ;Put the table address in R4 30$: MOVB -(R5),R0 ;Assemble 2 characters to check for 'NO' SWAB R0 ;First byte to high byte CLRB R0 ;Clear for next byte BISB -(R5),R0 ;Second character to low byte BIC #,R0 ;Make them both uppercase SUB #<"ON>,R0 ;Check for 'NO', leave R0=0 if 'NO' BEQ 40$ ;Go fix for 'NO' CMPB (R5)+,(R5)+ ;Fix R5, we got no 'NO' BR 50$ ............ 40$: CALL 290$ ;Skip blanks after 'NO', if any 50$: CALL 270$ ;Get the option name MOV R4,R1 ;Point to option table BR 90$ ;Enter loop ............ 60$: BR 200$ ;OCALLR BADCOM ............ 70$: TST (R1)+ ;Skip 2nd word of option name 80$: CMP (R1)+,-(R2) ;Skip flags, fix R2 90$: MOV (R1)+,R3 ;Get preset word BEQ 230$ ;0 => end of table, error CMP (R2)+,(R1)+ ;Check 1st word of name BNE 70$ ;No match CMP @R2,(R1)+ ;2nd word BNE 80$ ;Not yet MOV R4,R2 ;Copy entry pointer MOV @R1,R1 ;R1 = flags, offset BMI 100$ ;'NO' is allowed TST R0 ;'NO' is invalid. Was it given? BEQ 230$ ;Yes, error 100$: TST R0 ;'NO' given? BNE 110$ ;No CMP (R2)+,(R2)+ ;Yes, alter entry point 110$: ASL R1 ;Double offset BPL 160$ ;No number required JSR R4,300$ ;Number needed. Skip over optional '=' .WORD <'=> 120$: MOV R5,R0 ;Copy the command line pointer DEC R0 ;Adjust for first char of number ASL R1 ;Octal/decimal indicator in bit 15 SEC ;Assume decimal BPL 130$ ;Decimal (SEC to CVTNUM) CLC ;Octal (CLC to CVTNUM) 130$: OCALL CVTNUM ;Do number conversion CMP R5,R0 ;Did the pointer move? BEQ 230$ ;No number means error ASR R1 ;Set up correct offset CMPB @R5,#<'.> ;Was a decimal point supplied? BNE 150$ ;No, use the default radix BIT #<40000>,R1 ;Octal or decimal interpreted? BEQ 140$ ;Decimal, we're golden BIC #<40000>,R1 ;Redo with decimal conversion MOV R0,R5 ;Restore the command line pointer INC R5 ;Correctly that is TST (SP)+ ;Pop off the octal interpretation BR 120$ ;Go do it decimally ............ 140$: DEC R5 ;Skip the decimal point 150$: MOV (SP)+,R0 ;Converted number to R0 CALL 280$ ;Skip over blanks, if any 160$: BIC #<140000>,R1 ;Clear out all but offset for handler ADD R1,R2 ;Address of routine in R2 (Clear Carry) MOV UNUM2,R1 ;Get unit number CALL @R2 ;Call parameter routine BR 170$ ;V5 type error handling returns ...... BR 180$ ;5.1 type return - for system write lock error ...... .SBTTL SET Option Processor ;+ ; On entry to SET option processor: ; ; R0 = Numeric argument, if any ; R1 = Unit number. In the case of special options such as USR, EXIT, ; TT.... the contents does not matter and R1 may be used in the ; option routines. ; R2 -> Option processor itself ; R3 = Undefined ; ; Explanation of branches below: ; If a SET command processing routine in a handler returns with Carry Clear ; the SET code tries to write the handler back. If the system is write-locked, ; the message "KMON-SY: write-locked -" ... is produced. If a SET command ; processing routine in a handler returns with Carry Set, the message ; "KMON-F-Invalid Command" is produced. If a SET command processing routine ; in a handler returns to normal return+2 with Carry Clear, the SET code exits ; (skipping any other parameters on the command line). If a SET command ; processing routine in a handler returns to normal return+2 with Carry Set, ; the message "KMON-SY: write locked" ... is produced. The application of this ; alternate return is to allow a handler which writes to itself to invoke the ; SY: write-locked message if it fails to write to itself. The alternate ; return with Carry Clear allows SET code to exit without rewriting for speed ; optimization. ; ; Routine must not change R4, R5 ;- 170$: BCS 200$ ;Handler detected error, report it OINST CMP .USRBUF,R4,* ;Was this the TTY or USR? BHI 240$ ;Yes, it was in KMON, go change the RMON MOV R4,-(SP) ;Save pointer OINST MOV .USRBUF,R4,* ;Repoint to buffer CLR R0 ;Write block 0 .WRITW CHOVLY,R4,# ;Rewrite the handler MOV (SP)+,R4 ;Restore pointer 180$: BCC 190$ ;Check for more set commands ;+ ;ERROR KMRTMG ,UNCON$,PFILE ;- ............ 190$: TSTB -1(R5) ;End of line? BEQ 260$ ;Yes, close it out JSR R4,300$ ;No, skip optional comma .WORD <',> BR 30$ ;Loop ............ 200$: OCALLR BADCOM ............ 210$: OCALLR NOTFND ............ 220$: OCALLR FIPERR ;Input error on handler ............ ;+ ;ERROR 230$: KMEROR ;- ............ 240$: MOV @#$SYPTR,R0 ; SET TTY or SET USR. Point to RMON BIC #,CONFIG-$RMON(R0) ;Turn off USR$ and CLK50$ BIS SET62$,CONFIG-$RMON(R0) ; and put in new value BIC #,CONFG2-$RMON(R0) ; Turn off old value of XITSW$ BIS SET63$,CONFG2-$RMON(R0) ; And set to new value .IF NE MMG$T BIC #CF3.VB,CONFG3-$RMON(R0) ;turn off CF3.VB BIS #0,CONFG3-$RMON(R0) ;and set new value SET64$ =: .-4 .ENDC ;NE MMG$T BIC #,CLIFLG-$RMON(R0) ;Clr old flgs BIS SET57$,CLIFLG-$RMON(R0) ; And set to new value .IF EQ MTT$Y MOV SET58$,TTCNFG-$RMON(R0) ;Put in new TTY CONFIG MOVB SET59$,TTWIDT-$RMON(R0) ; and new width .IF EQ SB ADD #,R0 ;Point to words for F/B switch MOV #,R1 ;This flag sets or clears BIT #,SET58$ ;Is the TT now SET to 'FB'? BNE 250$ ;Yes, ensure that CTRL/F, CTRL/B are found BIS R1,(R0)+ ;If 'NOFB', turn on bit so it never matches BIS R1,(R0)+ .IF NE SYT$K BIS R1,(R0)+ ;Turn off CTRL/X, too .ENDC ;NE SYT$K RETURN ............ 250$: BIC R1,(R0)+ ;For TT SET to 'FB', ensure that the BIC R1,(R0)+ ; CTRL/F and CTRL/B can be found .IF NE SYT$K BIC R1,(R0)+ ;Turn on ^X .ENDC ;NE SYT$K .ENDC ;EQ SB .IFF ;EQ MTT$Y MOV BKCNSL-$RMON(R0),R1 ;R1 -> console TCB MOV SET58$,@R1 ;Update T.CNFG and T.WID MOV SET59$,T.WID(R1) ;Depends on CNFG = 0 .ENDC ;EQ MTT$Y BR 190$ ;Look for another option on the line 260$: RETURN ............ ;+ ; Get Next Argument in String as 2 RAD50 Words ; Words are stored in DEVSTS work area in KMON ; Blanks following argument are skipped ; ; CALL 270$ ; ; R2 -> RAD50 words ;- 270$: OADDR DEVSTS+2,R2 ;Point to a handy block MOV R0,-(SP) ;Save R0 OCALL GETNAM ;Get 2 words of RAD50 BEQ 200$ ;Error if nothing to get MOV (SP)+,R0 ;Restore R0 280$: INC R5 ;Start scan for non-blank 290$: CMPB -(R5),#<' > ;Blank? BEQ 290$ ;Yes, keep going INC R5 ;No, back up RETURN ............ ;+ ; Skip Optional Byte and, If Present, Blank(s) After It ; ; JSR R4,300$ ; .word [byte to skip if present] ;- 300$: CMPB (R4)+,-(R5) ;Are we pointing to the optional byte? BNE 320$ ;No 310$: CMPB -(R5),#<' > ;Yes, skip optional and spaces BEQ 310$ 320$: CMPB (R4)+,(R5)+ ;Fix R4 and R5 RTS R4 ;Out ............ .DSABL LSB .ENABL LSB ;+ ; The .KMSET macro is similar to the .DRSET macro except that it ; has no address checking and self-termination, and it takes the table name ; as an argument after the routine name. ;- .MACRO .KMSET OPTION,VAL,RTN,TAB,MODE .WORD ...V2 = . .WORD 0,0 .=...V2 .RAD50 \OPTION\ . = <...V2+4.> .BYTE /2. ...V2 = 0 .IRP X, .IF IDN , ...V2 = <...V2!^o100> .IFF .IF IDN , ...V2 = <...V2!^o200> .IFF .IF IDN , ...V2 = <...V2!^o140> .IFF .ERROR;?KMOVLY-E-Invalid parameter X; .ENDC .ENDC .ENDC .ENDR .BYTE ...V2 .ENDM .KMSET .SBTTL SET Syntax Tables and Code ;+ ;First we have a table of the syntax names and their table addresses ;- SETTAB:: .RMARG TT , ; SET TT .RMARG TER, ; SET TER .RMARG KMO, ; SET KMON .RMARG EXI, ; SET EXIT .RMARG USR, ; SET USR .RMARG CLI, ; SET CLI .RMARG MOD, ; SET MODE .IF NE MMG$T .RMARG RUN, ; SET RUN .ENDC ;NE MMG$T .IF NE TIME$R .RMARG CLO, ; SET CLOCK .ENDC ;NE TIME$R .WORD 0 ; Terminate table ............ SETMOD: .KMSET SJ,FBMON$,10$,SETMOD, ;SET MOD [NO]SJ .WORD 0 ............ SETUSR: .KMSET SWAP,USR$,5$,SETUSR, ;SET USR [NO]SWAP .WORD 0 ............ 5$: .IF NE SEC ;SET USR SWAP is an error in XM and AI RETURN ............ RETURN ............ .ENDC ;NE 10$: BR 20$ ;Set USR$ off for 'SWAP' NOP ;Filler ............ BIS R3,SET62$ ;'NOSWAP' entry, save a zero RETURN ............ 20$: BIC R3,SET62$ ;'SWAP' off and return RETURN ............ .IF NE MMG$T SETRUN: .KMSET VBGEXE,CF3.VB,11$,SETRUN, ;SET RUN [NO]VBGEXE .WORD 0 ............ 11$: BR 21$ ;Set CF3.VB on for RUN NOP ;Filler ............ BIC R3,SET64$ ;'NORUN' entry RETURN ............ 21$: BIS R3,SET64$ ;'RUN' entry RETURN ............ .ENDC ;NE MMG$T .IF NE TIME$R SETCLK: .KMSET 60,CLK50$,30$,SETCLK ;SET CLOCK 60 .KMSET 50,CLK50$,40$,SETCLK ;SET CLOCK 50 .WORD 0 ............ 30$: BIC R3,(PC)+ ;SET CLOCK 60 - Clear CLK50$ .ENDC ;NE TIME$R SET62$: .WORD 0 ;Value for USR SWAP/NOSWAP bit & CLK50$ .IF NE TIME$R MOV @#$SYPTR,R0 ;Point to resident monitor MOV #,GTM.HI-$RMON(R0) ;Fix end of day MOV #,GTM.LO-$RMON(R0) RETURN ............ 40$: MOV @#$SYPTR,R0 ;Point to resident monitor BIT #,CONFG2-$RMON(R0) ;Are we running on a PRO? BNE 50$ ;Yes, clock can only be 60 BIS R3,SET62$ ;SET CLOCK 50 - Set CLK50$ MOV #,GTM.HI-$RMON(R0) ;Fix end of day MOV #,GTM.LO-$RMON(R0) TST (PC)+ 50$: SEC RETURN ............ .ENDC ;NE TIME$R SETXIT: .KMSET SWAP,XITSW$,60$,SETXIT, ;SET EXIT [NO]SWAP .WORD 0 ............ 60$: .IF EQ AI$COD CLR R3 ;Set XITSW$ off for swap NOP ;Filler for NOSWAP entry MOV R3,(PC)+ ;NOSWAP entry SET63$: .WORD 0 ;0 if SWAP, bit value if NOSWAP RETURN ............ .IFF SEC ;SET EXIT SWAP IS AN ERROR IN AI RETURN RETURN SET63$: .WORD 0 ;0 if SWAP, bit value if NOSWAP .ENDC ;EQ AI$COD SETKMO: .KMSET IND,IFIND$,SETATS,SETKMO, ;SET KMON [NO]IND .WORD 0 ............ SETTTY:: .KMSET QUIET, IFEKO$, SETTTQ, SETTTY, ; SET TT [NO]QUIET .KMSET TAB, HWTAB$, SETTTS, SETTTY, ; SET TT [NO]TAB .KMSET SCOPE, BKSP$, SETTTS, SETTTY, ; SET TT [NO]SCOPE .KMSET FORM, FORM$, SETTTS, SETTTY, ; SET TT [NO]FORM .KMSET CRLF, CRLF$, SETTTS, SETTTY, ; SET TT [NO]CRLF .KMSET PAGE, PAGE$, SETTTS, SETTTY, ; SET TT [NO]PAGE .KMSET WIDTH, 30., SETTTW, SETTTY, ; SET TT WIDTH=n .IF NE MTT$Y .KMSET CONSOL, TCBMAX, SETCON, SETTTY, ; SET TT CONSOL=n .ENDC ;NE MTT$Y .IF EQ SB .KMSET FB, FBTTY$, SETTTS, SETTTY, ; SET TT [NO]FB .ENDC ;EQ SB .WORD 0 SETCLI:: .KMSET DCL, DCL.ON, SETCLF, SETCLI, ; SET CLI [NO]DCL .KMSET CCL, CCL.ON, SETCLF, SETCLI, ; SET CLI [NO]CCL .IF NE U$CL .KMSET UCL, UCL.ON, SETCLF, SETCLI, ; SET CLI [NO]UCL .KMSET UCF, UCF.ON, SETCLF, SETCLI, ; SET CLI [NO]UCF .ENDC ;NE U$CL .WORD 0 ............ .DSABL LSB .ENABL LSB SETATS: SETTTQ: BR 10$ ;SET TT QUIET (set echo off bit) ............ NOP ;Filler for 'NO' BIC R3,@<.STATWD-OVLY>-<.+4-OVLYST>(PC) ;SET NO QUIET RETURN ;Clear echo off bit (turn echo on) ............ 10$: BIS R3,@<.STATWD-OVLY>-<.+4-OVLYST>(PC) ;Set echo off bit RETURN ............ .DSABL LSB .IF NE MTT$Y ;+ ; SET TT CONSOL=n ;- .ENABL LSB SETCON: MOV R0,-(SP) ;Save LUN for later CMP R0,R3 ;Is it too big? BHIS 60$ ;Yes, error MOV @#$SYPTR,R2 ;Point to RMON ASL R0 ;Make unit # a word index ADD R2,R0 ;Add in RMON pointer MOV TCBLST-$RMON(R0),R0 ;Get pointer to new TCB TST T.CSR(R0) ;Is it configured/instaled BEQ 60$ ;No, non-existent terminal ..CRMT ==: < . + 2 > ;**PATCH** Zero to allow SET TT CONSOL=[Remote LUN] BIT #,@R0 ;Is it remote? (depends on T.CNFG=0) BNE 70$ ;Error, must be local ADD #,R2 ;Construct address of console TCB MOV @R2,R3 ;Point to current console TCB CMP R0,R3 ;Setting to same unit? BEQ 40$ ;Yes, quit instantly .IF EQ SB TST T.STAT(R0) ;Is it being used as console? BMI 60$ ;Yes, error! .ASSUME CONSL$ EQ 100000 TST T.OWNR(R0) ;Is it already owned? BNE 60$ ;Yes, error .ENDC ;EQ SB 10$: TSTB I.OCTR-I.CNSL(R2) ;Wait for output to stop on current terminal BNE 10$ ;Loop until quiet OSPL 7 ;Prevent interrupts MOV R0,@R2 ;;; Change TCB pointer in BKCNSL MOV @#$SYPTR,R0 ;;; Point to RMON ADD #<$TCFIG-$RMON>,R0 ;;; -> offset w/addr of term's T.CNFG MOV @R2,@R0 ;;; Store address in fixed offset MOV @R2,R0 ;;; Restore address MOV @SP,I.CLUN-I.CNSL(R2) ;;; Change BG console LUN BIS #,@R0 ;;; Set useful bits MOV @R0,SET58$ ;;; Save CONFIG word of new console MOV T.WID(R0),SET59$ ;;; and the width of the terminal MOV T.STAT(R3),R1 ;;; Get old status BIC #^c,R1 ;;; Extract CONSOLE and SHARE bits BIC R1,T.STAT(R3) ;;; Clear bits in old TCB BIS R1,T.STAT(R0) ;;; and set them in new TCB MOV T.TFIL(R0),@#$TTFILL ;;; Set the new fill char/count MOV T.OWNR(R3),T.OWNR(R0) ;;; Copy OWNER CLR T.OWNR(R3) ;;; No owner for old console .IF EQ SB .IF EQ SYT$K MOV FCNTXT-BKCNSL(R2),R3 ;;; Get FG context pointer BEQ 40$ ;;; No FG job, all done ASL R1 ;;; Remove CONSL$ ;;; Is it shared console? BEQ 40$ ;;; No, no change .ASSUME CONSL$ EQ 100000 .ASSUME SHARE$ NE 100000 MOV R0,I.CNSL(R3) ;;; Change FG console TCB MOV @SP,I.CLUN(R3) ;;; Change LUN in impure area .IFF ;EQ SYT$K MOV T.CNT(R3),T.CNT(R0) ;;; Copy owner count CLR T.CNT(R3) ;;; No more owners for old console ASL R1 ;;; Remove CONSL$, is console shared? BEQ 40$ ;;; No, all done .ASSUME CONSL$ EQ 100000 .ASSUME SHARE$ NE 100000 ADD #<$IMPUR+FJOBNM+2-BKCNSL>,R2 ;;; R2 -> past impure table 30$: MOV -(R2),R1 ;;; R1 -> impure area of next job BEQ 30$ ;;; No job here INC R1 ;;; -1 to indicate end of table? BEQ 40$ ;;; Yes, done CMP I.CNSL-1(R1),R3 ;;; Is this job on this console? BNE 30$ ;;; If NE, no MOV R0,I.CNSL-1(R1) ;;; Move it to new console MOV @SP,I.CLUN-1(R1) ;;; Change LUN in impure area BR 30$ ;;; Keep looking ............ .ENDC ;EQ SYT$K .ENDC ;EQ SB 40$: TST (SP)+ ;;; Clean the stack ;+ ;NOTE: Removing this section of code causes all system halt ; messages to go to the Boot Time Console, instead of ; the Current Console!!! ; ; ADD #,R2 ;;; R2 -> TTKS ; MOV T.CSR(R0),R3 ;;; R3 = device CSR ; SUB @R2,R3 ;;; R3 = new - old ; ADD R3,(R2)+ ;;; Adjust the four pointers, ; ADD R3,(R2)+ ;;; TTKS to TTPB ; ADD R3,(R2)+ ;;; NOTE: Assumes terminal addresses ; ADD R3,@R2 ;;; are contiguous. ;- OSPL 0 ;;; Allow interrupts RETURN ............ ;+ ;ERROR ;MTT$Y only 60$: KMEROR ............ 70$: KMEROR ;- ............ .DSABL LSB .ENDC ;NE MTT$Y ;+ ; Set or Clear Command Line Interpreter Enabling Bits ;- .ENABL LSB SETCLF:: BR 10$ ; Entry to SET bit ............ NOP ; Filler BIC R3,(PC)+ ; Option OFF (NOoption), clear bits SET57$: .WORD 0 RETURN ............ 10$: BIS R3,SET57$ ; Option ON, set bit RETURN ............ .DSABL LSB ;+ ; Set or Clear TT Status Bits ;- .ENABL LSB SETTTS: BR 10$ ;Option ON, go set bit ............ NOP ;Fill BIC R3,(PC)+ ;Option OFF (NOoption), clear bits SET58$: .WORD 0 RETURN ............ 10$: BIS R3,SET58$ ;Option ON, set bit in configuration word RETURN ............ SETTTW: MOVB R0,(PC)+ ;TT WIDTH=n, save new value SET59$: .WORD 0 CMPB R0,R3 ;Check for legal width RETURN ............ .DSABL LSB .ENDC ;NE SET$$ .IF NE B$$!D$$!E$$!INST$$ .SBTTL BASE/DEPOSIT/EXAMINE/INSTALL Overlay OVERLAY .IF NE B$$ ;If BASE command OVCMD B CALLR OB ............ .ENDC ;NE B$$ .IF NE D$$ ;If DEPOSIT command OVCMD D CALLR OD ............ .ENDC ;NE D$$ .IF NE E$$ ;If EXAMINE command OVCMD E CALLR OE ............ .ENDC ;NE E$$ .IF NE INST$$ ;If INSTALL command .SBTTL INSTALL Command ;+ ; INSTALL Command ;- SYNTAX INSTALL PROMPT $DEVICE REQBLNK END ............ SWITS INSTALL ENDNO NOS ENDS ............ OVCMD INSTALL ITBLE 0 ;Set max number of file specs OCALL INITIT ;Do the parse .ENABL LSB OINSTAL: ;+ ; Make sure this device handler is qualified to be installed ;- MOVB -3(R5),R0 ;Check 3rd character CALL DELIMC ; for delimiter BCS 5$ ;Branch if it's there OCALLR BADCOM ;Invalid command 5$: CALL NMCK ;Check name for proper format CMP @R2,#<^rBA > ;Trying to install 'BA'? BEQ 20$ ;Illegal, BA must be assembld into right slot! CMP @R2,#<^rTT > ;Trying to install 'TT'? BEQ 20$ ;Illegal, TT must be assembld into right slot! MOV @R2,-(SP) ;Save device name MOV R2,R3 ;Copy the address for DSTAT information INC R3 ;Indicate we don't want a logical translation .DSTAT R3,R2 ;See if name is known to the system BCC 30$ ;Yes, that's an error, name already exists ;+ ; OK, find a place in the device tables for it ;- CLR R3 ;No, start at the beginning and ... 10$: TST (R1)+ ; ... scan $PNAME table for an empty slot BEQ FNDSLT ;Found one TST (R3)+ ;Not empty here, bump slot counter CMP R3,#<$SLOT*2> ;Done checking all slots? BLO 10$ ;Not yet ;+ ;ERROR KMEROR ;Yes, no free slots ;- ............ 20$: OCALLR BADHAN ;Invalid device specified ............ ;+ ;ERROR 30$: KMRTMG ,WARN$ ;Device already exists ... ............ ; ... in system tables ;- ;+ ; Invade the handler's block 0 and see what we can find out about it ;- HS2.KI = 2 ;KMON INSTALL no support bit H.64UM = 100 ;Extended unit/ UB info word in handler block 0 HUM.UB = 40 ; Handler recognizes UB $CNFG3 = 466 ;Third configuration word in RMON fixed area CF3.UA = 40 ; UB is active FNDSLT: MOV #<^rSY >,(R2)+ ;Lookup the handler on the SY: device MOV @SP,@R2 ;File name is device name (2 chars - RAD50) MOV @#$SYPTR,R0 ;Point to RMON ADD HSUFFX-$RMON(R0),(R2)+ ; but make it 'hhX.SYS' for XM CLR (R2)+ ;Clear second word of file name MOV #<^rSYS>,@R2 ;Extension is ".SYS" SUB #,R2 ;Point to beginning of block again .PURGE # ;PURGE the overlay channel (to do a LOOKUP on) MOV R2,R0 ;Save filename in case of error MOV R3,-(SP) ;Save R3 so we can use it in COPYFN OCALL COPYFN ;Go copy it MOV (SP)+,R3 ;Restore R3 .LOOKUP CHOVLY ;Lookup handler file (R0 points to it) BCC 50$ ;Found it OCALLR NOTFND ;Not found, error 50$: OINST MOV .USRBUF,R4,* ;Found, point to USR buffer to read it into CLR @<.BLKEY-OVLY>-<.+4-OVLYST>(PC) ;Set no directory blk in mem. CLR R0 ;Read block 0 of handler .READW CHOVLY,R4,# ;Read the block BCS 120$ ;Oops, read error MOV @#$SYPTR,R0 ;Point to RMON CMPB H.GEN(R4),SYSGEN-$RMON(R0) ;Do sysgen options match? BNE 130$ ;No, don't install it BIT #,H.STS2(R4) ;Does it support KMON installation? BNE 140$ ;No, don't install it BIT #,H.64UM(R4) ;Does it know about UB? BNE 40$ ;Yup, no problem BIT #,$CNFG3(R0) ;No, is UB active? BNE 140$ ;Yes. so sorry. we can't install this ; handler 40$: .IF NE UNI$64 ;+ ; At the end of this page of code, the stack looks like this: ; ; (SP) = $PNAME entry (<^Rdd >) ; 2(SP) = $PNAM2 entry (<^Rdd > if no 64-unit, <^Rd> if 64-unit) ; 4(SP) = $OWNER entry ;- .IF NE OWN$ER MOV @SP,-(SP) ;Copy 2-letter dev name on stack again MOV #,2(SP) ;Assume 64-unit $OWNER .ENDC ;NE OWN$ER MOV @SP,-(SP) ;Copy 2-letter dev name on stack again CMP @R4,#<^rHAN> ;Is this a new style handler? BNE 60$ ;Nope TST H.UNIT(R4) ;Does this handler support 64-units? BEQ 60$ ;Nope OADDR DEVSTS,R2 ;Point to a work area MOV H.64UM(R4),@R2 ;Check again: BIC #^c,@R2 ;Clear UMR info bits; anything left? BEQ 60$ ;No, no 64-unit device name given MOV @R2,2(SP) ;Adjust entry for the 64-unit $PNAM2 entry MOV R2,R1 ;Copy the address for dstat info INC R1 ;Indicate we don't want a logical translation .DSTAT R1,R2 ;Is 64-unit device name already used? BCS 70$ ;Nope, it's available BR 30$ ;Yup. ............ 60$: .IF NE OWN$ER CLR 4(SP) ;Zero the $OWNER info for non 64-unit handler .ENDC ;NE OWN$ER .ENDC ;NE UNI$64 70$: MOV R3,-(SP) ;Save offset for free slot found MOV R4,R1 ;Copy pointer to block 0 of handler ADD #,R1 ;Point at the handler's CSR .ADDR #,R3 ;Point at our TRAP handler .ADDR #<150$>,R0 ;Point to TRPSET block MOV R0,-(SP) ;Save that pointer .TRPSET ,R3,CODE=SET ;Set up to handle any traps which occur TST @(R1)+ ;Is the CSR for the device out there? BCS 140$ ;No, we won't install it TST @R1 ;Any special handler set up needed? BEQ 80$ ;No, just go install the device MOV R5,-(SP) ;Save the command line pointer MOV R4,-(SP) ;Save pointer to start of block 0 CALL @R1 ;Call the set up routine in the handler BCS 140$ ;Handler told us that the set up failed MOV (SP)+,R4 ;Restore pointer to block 0 of the handler MOV (SP)+,R5 ;Restore the text pointer 80$: MOV (SP)+,R0 ;Point to TRPSET block .TRPSET ,#0 ;Reset the traps (code still = set) OADDR BLOCK,R2 ;Point to SAVESTATUS block .SAVEST CHOVLY,R2 ;SAVESTATUS to get block number of handler MOV @#$SYPTR,R0 ;Point to resident monitor MOV (SP)+,R3 ;Restore offset to device slot ADD R3,R0 ;Point to start of tables in RMON MOV SP,@<.EXTFL-OVLY>-<.+4-OVLYST>(PC) ;Inhibit CTRL/C .IF EQ CLR $HSIZE-$RMON(R0) ;Clear the handler size entry CMP @R4,#<^rHAN> ;Is this a new style handler? BNE 90$ ;Nope TST H.UNIT(R4) ;Does handler support extended units? BEQ 90$ ;Nope SUB #<32.>,$HSIZE-$RMON(R0) ;Cut off the extended ownership table 90$: ADD #,R4 ;Point to handler parameters ADD (R4)+,$HSIZE-$RMON(R0) ;Put handler size in $HSIZE table .IFF ;EQ ADD #,R4 ;Point to handler parameters MOV (R4)+,$HSIZE-$RMON(R0) ;Put handler size in $HSIZE table .ENDC ;EQ MOV (R4)+,$DVSIZ-$RMON(R0) ;Put device size in $DVSIZ table MOV (R4)+,$STAT-$RMON(R0) ;Put status word in $STAT table MOV C.SBLK(R2),$DVREC-$RMON(R0) ;Blk# of hndlr blk 0 to $DVREC tbl INC $DVREC-$RMON(R0) ;Make it blk 1 for FETCHes CLR $ENTRY-$RMON(R0) ;Clr $ENTRY table entry just in case MOV (SP)+,$PNAME-$RMON(R0) ;Put dev name into $PNAME table .IF NE UNI$64 MOV (SP)+,$PNAM2-$RMON(R0) ;Get 2-letter dev name for $PNAM2 100$: .IF NE OWN$ER ADD R3,R0 ;Adjust for 2 word entries of $OWNER MOV (SP)+,$OWNER-$RMON(R0) ;Set 64-unit bit in $OWNER entry .ENDC ;NE OWN$ER .ENDC ;NE UNI$64 CLR @<.EXTFL-OVLY>-<.+4-OVLYST>(PC) ;Re-enable CTRL/C CMPB @R5,#<',> ;Is a comma next? BEQ 110$ ;Yes, get next device TSTB @R5 ;End of cmd line? BEQ PCRTS ;Yes, back to KMON OCALLR BADCOM ;Illegal syntax ............ 110$: CALLR OINSTALL ;Bridge to avoid branch out of range ............ 120$: OCALLR FIPERR ;I/O error reading handler file ............ ;+ ;ERROR 130$: KMEROR ;Handler & RMON don't match ............ 140$: KMRTMG ,,PFILE ;CSR or setup failure ;- ............ 150$: .BLKW ;EMT storage ............ TRPTST: BIS #,2(SP) ;Set CARRY to indicate we took a TRAP RTI ;And CARRY on (Oh, humor ark! ark!) ............ .DSABL LSB ;+ ; NMCK - Point to the device name with R2, skip an optional colon, ; and point to the $PNAME table. ; ; R5 -> command text ; ; CALL NMCK ; ; R1 -> $PNAME table ; R2 -> RAD50 of name ; R5 -> character that terminated name ;- .ENABL LSB NMCK: OADDR DEVSTS,R2 ;Point to work area OCALL GETNAM ;Convert device name to RAD50 OCALL OPTCOL ;Skip optional colon OINST MOV .$PNAM,R1,* ;Point to $PNAME table PCRTS: OINST MOV @R2,INPFN,,* ;Save device for error message RETURN ............ ;+ ; DELIMC ; Check whether the character in R0 is a device-name ; delimiter. Return with C-set if character is a ; CTRL-char or punctuation. ; ; On return, C-set if so; otherwise C-clear. ;- ; YES NO YES NO YES NO YES DELTBL: .BYTE 60, 72, 101, 133, 141, 173, 0 ; delimiter delimiters .EVEN DELIMC: MOV R1,-(SP) ;Save register .ADDR #DELTBL,R1 ;Get address of DELTBL MOV #<1>,-(SP) ;Start with YES 10$: TSTB @R1 ;End of table reached BEQ 20$ ; Branch if done CMPB R0,(R1)+ ;Is character less than table value? BLO 20$ ; Done if so. COM @SP ;Toggle YES/NO bit BR 10$ 20$: ROR (SP)+ ;Put YES/NO bit in CARRY MOV (SP)+,R1 ;*C* restore R1 RETURN .DSABL LSB .ENDC ;NE INST$$ .IF NE B$$ ;If BASE command .SBTTL BASE Command ;+ ; BASE Command ;- OB: CALL EBDSB1 ;Get the BASE BCS EBDXIT ;Report command error TSTB @R5 ;Number terminated with return? BNE EBDXIT ;No, error BIC #,R2 ;Only even BASEs MOV R2,-<.+4-OVLYST>(PC) ;Save the BASE BR EBDRTN ;Return, undo .TRPSET ............ .ENDC ;NE B$$ .IF NE D$$ ;If DEPOSIT command (for next page) .SBTTL DEPOSIT Command ;+ ; DEPOSIT Command ;- OD: CALL EBDSUB ;Get BASE address BCS EBDXIT ;Report command error ADD R2,R3 ;Get desired address BIC #,R3 ;Make sure it's even CMPB @R5,#<'=> ;Equal sign? BNE 40$ ;Yes, continue 20$: MOV R3,R2 ;Copy DEPOSIT address MOV @#$SYPTR,R0 ;Point to permanent CCB ADD #,R0 ; in the RMON OCALL SETBIT ;Set bit in CCB CALL ADTRAN ;Translate address BCS EBDADR ;Report invalid address CMP R3,R2 ;Was this address in virtual core? BEQ 25$ ;No, not if they're the same OINST INC SAVSWT,,* ;Yes, save this block later 25$: OCALL OCTNUM ;Get next value MOV (SP)+,@R2 ;Store it NOP ;Wait for some processors to set 'C' BCS EBDNXM ;'C' set by T4 routine, loc does not exist ADD #2,R3 ;Increment address CMPB @R5,#<',> ;Values separated by comma? BEQ 20$ ;Yes, ok 40$: TSTB @R5 ;End of line? BNE EBDXIT ;No, syntax error CALL SAVEVC ;Yes, save block BR EBDRTN ;Finished, return ............ .ENDC ;NE D$$ .IF NE E$$ ;If EXAMINE command .SBTTL EXAMINE Command ;+ ; EXAMINE Command ;- OE: CALL EBDSUB ;Get the BASE address BCS EBDXIT ;Report command error BIC #,R2 ;Even addresses only CLR R1 ;Clear count (in case only 1) TSTB @R5 ;Terminated w/eol? BEQ 20$ ;Yes, just examine one word CMPB #<'->,@R5 ;Is it a dash (range specified)? BNE EBDXIT ;No, error OCALL OCTNUM ;Get upper limit MOV (SP)+,R1 ;Copy the upper limit TSTB @R5 ;Terminated w/eol? BNE EBDXIT ;No, error SUB R2,R1 ;Compute word count BLO EBDXIT ;Backwards is a no-no ROR R1 ;R1 has word count - 1 20$: ADD R2,R3 ;Get address (BASE+given address) 30$: MOV #<10>,R4 ;Display 8 words per line 40$: CALL ADTRAN ;Translate address in case virtual core BCS EBDADR ;Report invalid address ADD #2,R3 ;Bump address for next time MOV @R2,R2 ;Get the word NOP ;Wait for some processors to set 'C' BCS EBDNXM ;'C' set by trap routine, loc doesn't axist MOV #<30>,R0 ;Convert word to octal and print it SEC 45$: ROL R2 ;Don't try to understand this routine ROLB R0 ; just use it & love it .TTYOUT MOV #<206>,R0 47$: ASL R2 ;Done yet ? BEQ 60$ ;Yes ROLB R0 BCS 47$ BR 45$ ............ 60$: DEC R1 ;Any more to do? BMI 80$ ;No, go home .TTYOUT <#<' >> ;Print separator SOB R4,40$ ;8/line -- branch if more on this line OCALL KCRLF ;Print CR LF BR 30$ ;Count another 8 words ............ 80$: OCALL KCRLF ;Print CR LF BR EBDRTN ;Go home ............ .ENDC ;NE E$$ .IF NE B$$!D$$!E$$ ; 'GOOD' return from Examine/Base/Deposit EBDRTN:: CALL FIXXIT ;Fix stack and traps for exit RETURN ............ ; 'ERROR' exit from Examine/Base/Deposit EBDXIT:: CALL FIXXIT ;Fix stack and traps for exit OCALLR BADCOM ............ ; Fatal Error - Non-existent memory EBDNXM:: CALL FIXXIT ;Fix stack and traps for exit ;+ ;ERROR KMRTMG ;- ............ EBDADR:: CALL FIXXIT ;Fix stack and traps for exit ;+ ;ERROR KMEROR
............ ;- ; FIXXIT - Fix the stack, restore traps for exit. FIXXIT: MOV 2(SP), R0 ; Set TRPSET Block pointer MOV (SP)+,(SP) ; Move return address over pointer .TRPSET ,#0 ; Reset the traps (code still = set) RETURN ............ TRPBLK:: .BLKW ;EMT storage ............ ;+ ; EBDSUB ; ; Checks that E,B, or D command terminated w/space or , then gets ; octal number following command. ;- EBDSUB: OINST MOV #<-1>,BLOKWG,,* ;Indicate no SWAP block in buffer yet OINST MOV BASE,R3,* ;Get the BASE address EBDSB1: MOV @SP,-(SP) ;Copy return addr, make room for TRPBLK .ADDR #,R2 ;Point to our trap handler .ADDR #,R0 ;Point to TRPSET data block MOV R0,2(SP) ;Save that pointer .TRPSET ,R2,CODE=SET ;Set up to handle any traps which occur CMPB @R5,#<' > ;Command name end with space? BEQ 20$ ;Yes, ok TSTB @R5 ;No, is it ? BNE 90$ ;No, error 20$: OCALL OCTNUM ;Get first address MOV (SP)+,R2 ;Return number to caller TST (PC)+ ;Set 'GOOD' return 90$: SEC ;Set 'BAD' return RETURN ............ .ENDC ;NE B$$!D$$!E$$ .IF NE D$$!E$$ .SBTTL ADTRAN & SAVEVC - Access SWAP Blocks For EXAMINE, DEPOSIT ADTRAN: MOV @#$SYPTR,R2 ;Point to resident monitor CMP R3,SYSLOW-$RMON(R2) ;Is address in range? ..EMON ==: < . > ;**PATCH** 'NOP' to allow EXAMINE/DEPOSIT above syslow BHIS 90$ ;No, give error BHIS 5$ ;No, examine monitor or I/O page OADDR KMON,R2 ;Setup pointer to KMON BIC #,R2 ;Force to a block boundary SUB R3,R2 ;Is address in virt. core ? BLOS 10$ ;Yes, go do virtual core 5$: MOV R3,R2 ;No, real core is easy BR 50$ ;Return to caller ............ 10$: OADDR SYSIOB-2,R5,PUSH ;Save R5, point to system IOB NEG R2 ;Get displacement into virtual core CLRB R2 ;Zero lower 8 bits SWAB R2 ;Compute block number in SWAP.SYS ASR R2 ; as displacement / 1000 CMP R2,(R5)+ ;Is it the block we've got ? BEQ 30$ ;Yes CALL SAVEVC ;Save current block in buffer if modified NEG 2(R5) ;Make word count positive MOV R2,R0 ;Get desired block number MOV R0,-<.+4-OVLYST>(PC) ;Save it OCALL SYSK ;Read from SWAP.SYS 30$: MOV R3,R2 ;Get real address BIC #^c,R2 ;Mask to get offset within buffer ADD @R5,R2 ;Add start of buffer MOV (SP)+,R5 ;Restore pointer to SYSTEM IO block 50$: TST (PC)+ 90$: SEC RETURN ............ SAVEVC: MOV #<-BK.WD>,-<.+6-OVLYST>(PC) ;Make a 1 blk write OADDR SAVSWT,R5,PUSH ;Save R5, point to SYSIOB-4 TST (R5)+ ;Did we alter the block in the buffer? BEQ 5$ ;No MOV (R5)+,R0 ;Get block number of block in memory OCALL SYSK ;Write into SWAP.SYS 5$: MOV (SP)+,R5 ;Restore pointer to SYSTEM IO block RETURN ............ .ENDC ;NE D$$!E$$ .SBTTL ABORT/ASSIGN/DEASSIGN/RESUME/SUSPEND Overlay OVERLAY .IF NE ABOR$$ ;If ABORT command OVCMD ABORT CALLR ABO1 ............ .ENDC ;NE ABOR$$ .IF NE SUSP$$ ;If SUSPEND command OVCMD SUSPEND CALLR SUSP1 ............ .ENDC ;NE SUSP$$ .IF NE RESU$$ ;If RESUME command OVCMD RESUME CALLR RESU1 ............ .ENDC ;NE RESU$$ .IF NE ASSI$$ ;If ASSIGN command OVCMD ASSIGN CALLR ASSIG1 ............ .ENDC ;NE ASSI$$ .IF NE DEAS$$ ;If DEASSIGN command OVCMD DEASSIGN CALLR DEASS1 ............ .ENDC ;NE DEAS$$ .IF NE ASSI$$!DEAS$$ .SBTTL DEASSIGN Command STAR50 =: 132500 ;RAD50 '*' (Wildcard) .ENABL LSB ;+ ; DEASSIGN Command ;- DEASS1: CALL ADSUB ;Setup pointers and check command line BNE 20$ ;Specific name specified. Don't clear all ADD #<$UNAM2-$RMON>,R4 ;Deassign all. Point to user names MOV #<$SLOT>,R1 ;Get slot count for table size 10$: CLR (R4)+ ;Clear all until done SOB R1,10$ ; .IF NE UNI$64 CLR $PNAM2-$UNAM2(R4) ;Deassign * (clear $PNAM2+<2*$SLOT>) .ENDC ;NE UNI$64 RETURN ............ 20$: CLR (R2)+ ;Not end, clear permanent name for DEASSIGN BR PERNM ;Jump into ASSIGN to get name of device ............ .DSABL LSB .SBTTL ASSIGN Command ;+ ; ASSIGN Command ;- SYNTAX ASSIGN PROMPT $PHYSICAL REQBLNK SPISPEC PROMPT $LOGICAL REQBLNK END ............ SWITS ASSIGN ENDNO NOS ENDS ............ .ENABL LSB ASSIG1: MOV R5,-(SP) ;Save pointer for later ITBLE 2 ;Allow 2 filespecs OCALL INITIT ;Parse MOV (SP)+,R5 ;Restore command pointer CALL GTNAM ;Get physical device name BCS 10$ ;Branch if error TST (R2)+ ;Position to second word in area CMPB @R5,#<' > ;Space character? BEQ PERNM ;Branch around if yes 10$: OCALLR BADCOM ;Invalid command ............ PERNM: .IF NE UNI$64 OINST MOV SP,EMTMOD,,* ;Let's accept special characters (*) .ENDC ;NE UNI$64 CALL GTNAM1 ;Get logical device name .IF NE UNI$64 OINST MOV #0,EMTMOD,,* ;*C* Reset for no special characters .ENDC ;NE UNI$64 BCS 10$ ;Branch if error - invalid command TSTB @R5 ;Was a 2nd device name specified? BNE 10$ ;Yes, invalid command OINST MOV @R2,INPFN,,* ;Save device name in case of error CMP @R2,#<^rSY > ;Trying to ASSIGN/DEASSIGN SY:? ..ASSY ==: < . > ;**PATCH** 'NOP' to allow ASSIGN of SY: BEQ 10$ ;Yes, error MOV -2(R2),R5 ;Get user's permanent name BEQ 50$ ;No permanent name, do a DEASSIGN CMP @R2,#<^rBA > ;Is logical name 'BA'? BEQ HANERK ;Yes, error, can't ASSIGN to BA ;+ ; If the first assign name is a logical name, the following code finds ; it and substitutes the associated physical name. ;- MOV R2,R0 ;Copy pointer to work area TST -(R0) ;R0-> permanent name ADD #<$UNAM2-$RMON>,R4 ;Point to list of user names MOV #<$SLOT+3>,R1 ;Counter in R1 20$: DEC R1 ;Decrement count BEQ 30$ ;Branch if done CMP R5,(R4)+ ;Check if match BNE 20$ ;Branch if no match MOV $UNAM1-$UNAM2-2(R4),@R0 ;Use associated perm name 30$: OINST MOV @R0,INPFN,,* ;Save device name in case of error MOV R2,-(SP) ;Save R2 across call to LK4DEV SEC ;Say don't do logical translation OJSR R4,.LK4DV,@ ;Find the device in monitor tables .IF NE UNI$64 BR 90$ ;It isn't there ...... 40$: .IFF ;NE UNI$64 BR HANERK ; ...... .ENDC ;NE UNI$64 MOV (SP)+,R2 ;Restore R2 MOV -(R0),R5 ;Restore permanent name .IF NE UNI$64 ADD @#$SYPTR,R3 ;Add base of RMON to the $PNAME index MOV $PNAM2-$RMON(R3),R4 ;Get 1-letter handler name in R4 CMP $PNAME-$RMON(R3),R4 ;Is this a 64-unit handler? BEQ 50$ ;Branch if not CMP R1,#<7> ;Is this unit 7 or less? BHI 50$ ;No, so we know user specified one-letter form CMP R5,R4 ;Did user specify 1-letter sans unit #? BEQ 50$ ;If so, use it as is MOV R4,R5 ;Move the 1-letter name to R5 CMP @R0,$PNAME-$RMON(R3) ;Did user specify 2-ltr name sans unit #? BEQ 50$ ;If so, use 1-letter name ADD #<^r 00>,R5 ;Add zeros for unit number ADD R1,R5 ;Add actual unit # for dnn form of device name .ENDC ;NE UNI$64 ;+ ;Enter the logical assignment in the $UNAM1/2 tables ;- 50$: MOV @#$SYPTR,R4 ;Find RMON .IF NE UNI$64 CMP @R2,# ;Assigning wildcard device? BEQ 100$ ;Yup, skip the UNAM1/2 garbage .ENDC ;NE UNI$64 MOV #<$SLOT>,R1 ;Found valid permanent name. Get slot count ADD #<$UNAM2+<2*$SLOT>-$RMON>,R4 ;Point to top of user name table CLR R3 ;No empty slot in $UNAM2 yet 60$: CMP @R2,-(R4) ;Is this logical name already assigned? BEQ 110$ ;Yes, replace its assignment TST @R4 ;No, is this an empty entry? BNE 70$ ;Branch if no MOV R4,R3 ;Yes, remember it 70$: SOB R1,60$ ;Loop until no more TST R5 ;Is this a DEASSIGN? BEQ 120$ ;Yes, but that name wasn't assigned MOV R3,R4 ;No, it's an assign. Is there a slot handy? BEQ 130$ ;No room in table MOV @R2,@R4 ;Put user logical name in $UNAM2 80$: MOV R5,$UNAM1-$UNAM2(R4) ;Put physical name in $UNAM1 RETURN ............ .IF NE UNI$64 ;+ ; Come here only if ASSIGN xxx * where xxx is an undefined logical. ; Previous default assignment, if there is one, remains in effect. If ; none, invalid command. ;- 90$: MOV (SP)+,R2 ;Restore R2 ; MOV @#$SYPTR,R4 ;Get address of the start of RMON ; MOV $PNAM2+<2*$SLOT>-$RMON(R4),R5 ;Get wildcard assignment BNE 120$ ;Print error message ............ .ENDC ;NE UNI$64 HANERK: OCALLR BADHAN ; ............ .IF NE UNI$64 100$: MOV R5,$PNAM2+<2*$SLOT>-$RMON(R4) ;Fill in wildcard assignment ... ; ... entry in $PNAM2 table with the ... RETURN ; ... physical name or deassign it if R5=0 ............ .ENDC ;NE UNI$64 110$: TST R5 ;Found user name. ASSIGN or DEASSIGN? BNE 80$ ;ASSIGN, go set physical name CLR @R4 ;DEASSIGN, clear the user logical name RETURN ............ ;+ ;ERROR 120$: KMRTMG ,WARN$ ;Name not found for DEASSIGN ;or ASSIGN * ............ 130$: KMEROR ;No room in user name table ;- ............ .DSABL LSB ADSUB: OADDR BLOCK,R2 ;Pointer to work block MOV @#$SYPTR,R4 ;R4 -> RMON TSTB @R5 ;End of command? RETURN ;Return with condition code set by terminator ............ .ENABL LSB GTNAM: CALL ADSUB ;Setup pointers GTNAM1: OCALL GETNAM ;Get device name BEQ 10$ ;Error. No name OCALL OPTCOL ;Point past optional colon TST 2(R2) ;Was a file name specified? BNE 10$ ;Give error if yes TST (PC)+ ;Clear C-bit for success 10$: SEC ;Error occured - invalid command RETURN ............ .DSABL LSB .ENDC ;NE ASSI$$!DEAS$$ .IF NE RESU$$!SUSP$$ .IF EQ SYT$K .SBTTL SUSPEND/RESUME Commands SUSP1: TST (PC)+ ;Clear the Carry RESU1: SEC ;Set the Carry MOVB @R5,R1 ;*C* At eol now? (C unchanged) BEQ SPNRSU ;*C* Yes, command is ok OCALLR BADCOM ; ............ .ENABL LSB SPNRSU: MOV @#$SYPTR,R1 ;*C* Point to monitor MOV FCNTXT-$RMON(R1),R2 ;*C* Point to FG impure area BEQ 20$ ;*C* Oops, no foreground BCS 10$ ;Go if RESUME BIS #,I.BLOK(R2) ;Set suspension bit in FG status RETURN ............ 10$: BIC #,I.BLOK(R2) ;Clear the suspension bit MOVB #,INTACT-$RMON(R1) ;Force scheduler pass .EXIT ;Leave this way (.EXIT) to make it happen ............ ;+ ;ERROR 20$: KMEROR ;- ............ .DSABL LSB .IFF ;EQ SYT$K SUSP1: CALL GLJNM ;Check out job name BIS #,I.BLOK(R5) ;Suspend the job RETURN ............ RESU1: CALL GLJNM ;Check out job name BIC #,I.BLOK(R5) ;Awaken the job MOV @#$SYPTR,R3 ;R3 => RMON MOVB #,INTACT-$RMON(R3) ;Force scheduler pass .EXIT ;Leave this way to make it happen ............ .ENABL LSB GLJNM: .ADDR #,R0 ;Point to work space MOV R0,-(SP) ;Save pointer... CLR (R0)+ ;Clear out CLR (R0)+ ;The fwd ASCII CLR (R0)+ ;Work space MOV @SP,R0 ;Restore pointer... MOV #,R1 ;R1 = max char count TSTB -(R5) ;Look at first char of name BNE 20$ ;If none there MOVB #<'F>,@R0 ;Assume FG job... BR 30$ ;And go check it out ............ 10$: TSTB -(R5) ;Look at next character... BEQ 30$ ;All done ! 20$: MOVB @R5,(R0)+ ;Xfer a char to fwd ASCII work space... SOB R1,10$ ;Loop until 6 char xferred 30$: MOV (SP)+,R0 ;Point to beginning of work space 40$: MOV @#$SYPTR,R5 ;R5 => RMON CALL FNDJOB-$RMON(R5) ;See if there's such a job BEQ 50$ ;No such job ! MOV @R5,R5 ;R5 = impure address... RETURN ............ ;+ ;ERROR 50$: KMEROR ;- ............ NMBUF: .BLKW 3 ;Forward ASCII logical job name ............ .DSABL LSB .ENDC ;EQ SYT$K .ENDC ;NE RESU$$!SUSP$$ .IF NE ABOR$$ ;If ABORT command (for next page) .SBTTL ABORT Command SYNTAX ABORT PROMPT $JOB REQBLNK END ............ SWITS ABORT ENDNO NOS ENDS ............ ;+ ; Routine to ABORT a job as if the jobs are terminated by double control C's. ; The syntax of the command is: ; ; ABORT jobname ; ; where jobname is the name of a running job listed in the SHOW JOBS display. ; This means that you must use ABORT F if you are aborting a foreground job ; in a non system job environmnet. ;- .ENABL LSB ABO1: MOV R5,(PC)+ ;Save start of string SVNM: .WORD 0 ;Contains pointer to jobname (backwards) ITBLE 0 ;Set maximum number of file specs OCALL INITIT ;Do the parse DEC SVNM ;Skip past the space OADDR BLOCK+L.LJNM,R0 ;Point to start of scratch buffer CLR -(R0) ;Clear it out CLR -(R0) CLR -(R0) MOV R0,-(SP) ;Save the starting address MOV #,R1 ;Get count plus 1 TSTB @R5 ;Any job name? BEQ 20$ ;Branch if no - invalid command 10$: MOVB -(R5),(R0)+ ;Move job name into the buffer BEQ 30$ ;Branch if done SOB R1,10$ ;Decrement the count and branch back for more 20$: OCALLR BADCOM ;Invalid command ............ 30$: MOV (SP)+,R0 ;Restore start of scratch buffer MOV @#$SYPTR,R1 ;Get starting address of RMON .IF EQ SYT$K BIC #,@R0 ;Convert user's input to uppercase CMP #<'F>,@R0 ;Check for F for foreground job BNE 70$ ;Invalid job name MOV FCNTXT-$RMON(R1),R2 ;Get pointer to foreground impure area .IFF ;EQ SYT$K CALL FNDJOB-$RMON(R1) ;See if there's such a job BEQ 70$ ;No such job .ENDC ;EQ SYT$K MOV I.SCCA(R2),R5 ;Get status address if any BEQ 60$ ;SCCA is on .IF NE MMG$T MOV I.SCC1(R2),50$ ;Set up PAR 1 value of user's SCCA flag BIC #,@#PS ;Enter kernel mode (compatible mapping) JSR R0,@P1EXT-$RMON(R1) ;Execute following code clear of PAR 1 40$: .WORD < 50$ - 40$ > ;Byte size of code and PAR 1 value word .ENDC ;NE MMG$T BIS #<100000>,@R5 ;Set minus bit in user's SCCA flag .IF NE MMG$T 50$: .WORD 0 ;PAR 1 value when executing P1EXT code BIS #,@#PS ;Restore user mode .ENDC ;NE MMG$T RETURN ............ 60$: BIS #<100000>,INTACT-$RMON(R1) ;Set high bit to make minus BIS #,@R2 ;Set abort pending bit in jobs status word RETURN ............ 70$: MOV SVNM,R4 ;Point to name CLRB @R3 ;Clear for error ;+ ;ERROR KMRTMG ,,BCKASZ ;- ............ .DSABL LSB .ENDC ;NE ABOR$$ .ENDC ;NE ABOR$$!ASSI$$!DEAS$$!RESU$$!SUSP$$ .IF NE EDIT$$!MAKE$$!MUNG$$!TECO$$ .SBTTL EDIT/MAKE/MUNG/TECO Overlay OVERLAY .IF NE TECO$$ ;If TECO command OVCMD TECO .ENDC ;NE TECO$$ .IF NE MAKE$$ ;If MAKE command OVCMD MAKE .ENDC ;NE MAKE$$ .IF NE MUNG$$ ;If MUNG command OVCMD MUNG .ENDC ;NE MUNG$$ .IF NE MAKE$$!MUNG$$!TECO$$ .SBTTL MAKE/MUNG/TECO Commands .ENABL LSB .ADDR #,R0 ;Point at TECO name MOV #,R1 ;Set up CHAIN area for TECO MOV (R0)+,(R1)+ ;Copy the device (500) MOV (R0)+,(R1)+ ;And the RAD50 file name (502) MOV (R0)+,(R1)+ ;Two words of filename (504) MOV (R0)+,(R1)+ ;And the extension (506) MOV #<-1>,(R1)+ ;Indicate new interface to TECO (510) OADDR KMCBUF,R0 ;Point at the entire command string 10$: MOVB -(R0),(R1)+ ;Move entire command string to (512) BNE 10$ ;Including ASCIZ delimiter BR CHNLNK ;CHAIN to TECO ............ .DSABL LSB ..TECN ==: < . > ;**PATCH** TECO/MAKE/MUNG Default Program Filespec NMTECO: .RAD50 /SY TECO SAV/ ............ .ENDC ;NE MAKE$$!MUNG$$!TECO$$ .IF NE EDIT$$ ;If EDIT command .SBTTL EDIT Command ;+ ; EDIT Command ;- SYNTAX EDIT PROMPT $FILEE SCALL GSWIT,<1> REQBLNK OUTSPEC SAVNAM SCALL GSWIT,<1> EOLSEQ EDIT,EDIT MAKOFL TOTYP END ............ SWITS EDIT SWIT COMMAND 1 - - COM SWIT QUERY 1 - - - ENDNO SWIT TECO 1 - TECO - SWIT EDIT 1 - EDIT - SWIT KED 1 - KED - SWIT K52 1 - K52 - SWIT KEX 1 - KEX - SWIT EXECUTE 1 TECO - TEX SWIT CREATE 1 - - C SWIT OUTPUT 1 - - PUT SWIT ALLOCATE 1 - - ALL SWIT INSPECT 1 - - I SWIT READONLY 1 - - I SWIT JOURNAL 1 - - TOT SWIT RECOVER 1 - - REC NOS SWIT NOCOMMAND 1 - - N SWIT NOQUERY 1 - - Y ENDS ............ .ENABL LSB OVCMD EDIT ;+ ; Initialize important stuff and parse the command line ;- CLR @#XED.FG ;Clear CHAIN area flags CLR KEDCOM ;Assume no /COMMAND file specified CLR KEDREC ;Assume no /RECOVER file specified ITBLE 5 ;Set max number of file specs OCALL INITIT ;Parse the command line ;+ ; Set flags for /CREATE and /INSPECT ;- MOVB #<'C>,R3 ;Was /CREATE specified? OCALL FDSWIT ; BCS 10$ ;Nope OCALL REMSWT ;Remove it. It isn't really used. BIS #,@#XED.FG ;Yup, set a bit in chain area 10$: MOVB #<'I>,R3 ;Was /INSPECT specified? OCALL FDSWIT ; BCS 20$ ;Nope BIS #,@#XED.FG ;Yup, set a bit in the chain area ;+ ; Decide between "chain-to" editors and CSI structured ;- 20$: .ADDR #,R0 ;Point at the .CHAIN editors 30$: CMP (R0)+,(R0)+ ;Get the start of the next entry MOV (R0)+,R1 ;Pick up the program index BEQ EDTCSI ;End of list, must be CSI editor OINST CMPB FORCEP,R1,* ;Is this the specified editor? BNE 30$ ;No, go try next ;+ ; Setup for chaining to editor specified ;- MOV #,R5 ;Set up pointer to the CHAIN area MOV (PC)+,(R5)+ ;SY: for the editor file ..EDDV:: .RAD50 /SY / ;**PATCH** Device name for editor in editing commands MOV (R0)+,(R5)+ ;Copy both words of the RAD50 editor MOV (R0)+,(R5)+ ;Name to the CHAIN area MOV #<^rSAV>,(R5)+ ; and last but not least the type TST (R5)+ ;Point to output area MOVB #,R4 ;Set to generate the input spec at 512 OINST MOVB R5,GENFLG,,* ;Set GENFLG non-zero for DOENT CALL SETDTP ;Set the default file types OCALL DOENT ;Fill in the ASCII input file spec CLRB @R5 ;Make it ASCIZ DECB R4 ;Set to generate the output file spec MOV #,R5 ;At absolute 540 OCALL DOENT ;Put in the ASCII CLRB @R5 ;Make it ASCIZ .BR CHNLNK ............ .DSABL LSB .ENDC ;NE EDIT$$ CHNLNK: .SRESET ;Clear all channels .IF NE MMG$T BIC #,@#$JSW .ENDC ;NE MMG$T .CHAIN ;CHAIN to the appropriate editor ;+ ; EDIT/JOURNAL:FILE3/OUTPUT:FILE2 FILE1 ; ; Options CSI Line ; ; /JOURNAL FILE2,FILE3=FILE1 ; /CREATE FILE1= ; /INSPECT =FILE1/I ; /OUTPUT FILE2=FILE1 ; NO OPTIONS FILE1=FILE1 ; ; Overall CSI Structure: ; ; OUTPUT,JOURNAL=INPUT,RECOVER,COMMAND ;- .ENABL LSB EDTCSI:: ;+ ; /JOURNAL:fspec ;- MOVB #,R1 ;We want the third output spec CALL FNDTYP ;It's the /JOURNAL file spec MOVB #,STFLG(R2) ;Fix it to be the second output file ;+ ; The preceding was all because the KMON routine for the second ; output file spec has some screwy defaults that we didn't want. ;- MOV @#XED.FG,R4 ;Look at the option bitmap ;+ ; /CREATE ;- BIT #,R4 ;Was /CREATE selected? BEQ 20$ ;Nope CALL MKBLNK ;Make a blank input spec BIT #,R4 ;Were /INSPECT or /OUTPUT also? BEQ 60$ ;Nope, good 10$: OCALLR CNFSWT ;Conflicting switches ............ ;+ ; /INSPECT ;- 20$: BIT #,R4 ;Was /INSPECT selected? BEQ 30$ ;Nope BIT #,R4 ;Was /OUTPUT also? BNE 10$ ;Yup, conflict MOVB #,R1 ;Nope CALL FNDTYP ;Find the file specified on the line MOV R2,R0 ;Set up R0 for the call ADD #,R0 ;And clear the allocation field OCALL ZFALLF MOVB #,@R0 ;Make it the input file BR 60$ ;Go take care of other input files ............ ;+ ; /OUTPUT:fspec ;- 30$: BIT #,R4 ;Was /OUTPUT selected? BEQ 40$ ;Nope MOVB #,R1 ;Yup CALL FNDTYP ;Look for the command line file MOVB #,STFLG(R2) ;Make it the input file MOV R2,R0 ;Setup R0 for the call ADD #,R0 OCALL ZFALLF ;Clear the allocation field MOVB #,R1 CALL FNDTYP ;Look for the /OUTPUT: filespec MOVB #,STFLG(R2) ;And make it the primary output file BR 60$ ;Go take care of other input files ............ ;+ ; fspec=fspec ;- 40$: OCALL MULSZI ;Find an open space in the file table MOVB #,R1 ;Normal command line file=file CALL FNDTYP ;Find the command line file MOV #,R3 ;Copy the file spec to another slot ... 50$: MOV (R2)+,(R0)+ ; ... byte by byte SOB R3,50$ ;Loop until done OCALL ZFALLF ;Zero the allocation field MOVB #,@R0 ;And mark this copy as the input file .BR 60$ ............ ;+ ; Make a /RECOVER file entry - second input spec ;- 60$: MOV KEDREC,R5 ;Is there a /RECOVER specified? BEQ 70$ ;No CALL 100$ ;Build an input spec (position 2) BR 80$ ............ 70$: CALL MKBLNK ;No /RECOVER, so fill in a blank spec ;+ ; Make a /COMMAND file entry - third input spec ;- 80$: MOV KEDCOM,R5 ;Is there a /COMMAND entry? BEQ 90$ ;No CMPB #<':>,@R5 ;Was an argument given? BNE 90$ ;No, ignore the switch OCALL INSPEC ;Build an input spec (postition 3) ;+ ; Build command ;- 90$: OCALLR CMDEXE ;Build CSI and return ............ ;+ ; Get the input file or default it if none given ;- 100$: CMPB #<':>,@R5 ;Was an argument given? BEQ 120$ ;Yup, go get it CALL MKBLNK ;Nope, fill in with blank spec MOVB #,R1 ;Find the first input file CALL FNDTYP MOV FNMFLD(R2),FNMFLD(R0) ;Copy the input file name BNE 110$ ;Is there really anything to copy? MOVB #,R1 ;Nope, must've been a /CREATE CALL FNDTYP ;Then use the output file name 110$: MOV FNMFLD(R2),FNMFLD(R0) ;Copy the ASCII file name MOV FNMFLD+2(R2),FNMFLD+2(R0) MOV FNMFLD+4(R2),FNMFLD+4(R0) RETURN ............ 120$: OCALLR INSPEC ;Get file name and return from there ............ ;+ ; Save the pointer to the /RECOVER: argument (if any) and skip over it ;- OVAREC: MOV R5,KEDREC ;Save the pointer to the filename BR 130$ ;Go skip over filename ............ OVACOM: MOV R5,KEDCOM ;Save the pointer to the filename 130$: INC R5 ;Fix R5 to start 140$: TSTB -(R5) ;End of string? BEQ 150$ ;Yup CMPB #<'/>,@R5 ;Slash the next character? BEQ 150$ ;Branch if yes CMPB #<' >,@R5 ;Space the next character? BEQ 150$ ;Branch if yes BR 140$ ;Loop around to skip over switch argument ............ 150$: RETURN ............ ;+ ; FNDTYP - Find the specified (R1) entry type in the file list ; ; Return (R2) the pointer to the file descriptor ; R3 destroyed ;- FNDTYP: OADDR FILST,R2 ;Point at the file list OADDR OTBLK,R3 ;Marks the end of the list 160$: CMPB R1,STFLG(R2) ;Is this entry of the right type? BEQ 180$ ;Yup, keep R2 pointing to it ADD #,R2 ;Nope, point to the next entry in the table CMP R2,R3 ;Are there anymore to check? BLO 160$ ;Yup, check next one out (unsigned br) BR 190$ ............ ;+ ; MKBLNK - Make a blank input file entry ; ; R0 points to file descriptor ; R2,R3 destroyed ;- MKBLNK: OCALL MULSZI ;Find an empty entry in the file list MOV #,R3 ;Get the size of the entry 170$: CLRB (R0)+ ;And zero the whole thing SOB R3,170$ ;Loop until done MOVB #,-1(R0) ;Then mark it as an input file SUB #,R0 ;Point to the beginning of the descriptor 180$: TST (PC)+ ;Clear carry 190$: SEC ;Set carry (error) RETURN ............ .DSABL LSB KEDREC: .WORD 0 ;Pointer to /RECOVER parameter or 0 KEDCOM: .WORD 0 ;Pointer to /COMMAND parameter or 0 ............ EDTCHN: .WORD $$EDIT ;Program index for EDIT ..EDIF ==: < . > ;**PATCH** EDIT Default Program Filename .RAD50 /EDIT / .WORD $$TECO ;Program index for TECO ..TECF ==: < . > ;**PATCH** EDIT/TECO Default Program Filename .RAD50 /TECO / .WORD 0 ;End of the chain editors list ............ EFTYP: .BYTE 0, 0, 0, 0 ;ASCII of default type for input file ............ .DSABL LSB .IF NE EDIT$$ ;If EDIT command .ENABL LSB SETDTP: OADDR FILST+FTPFLD,R2 ;Point to first file type CALL @PC ;Do this twice TST @R2 ;Is it null? BNE 10$ ;Branch if not MOV EFTYP,@R2 ;Put in file type MOV EFTYP+2,2(R2) ;Both words ADD #,R2 ;Point to next entry 10$: RETURN ............ .DSABL LSB ;+ ; Special output handler for EDIT Command to order 2 out specs from it ;- .ENABL LSB OVAPUT: CMPB #<':>,@R5 ;Is /OUTPUT terminated with a colon? BNE 10$ ;No, ignore it OCALL OUTSPEC ;Process a non-special mode filespec ;This is for EDIT command MOVB #,-(R0) ;R0 from JSR! Flag as secondary output BIS #,@#XED.FG ;Flag that we have an /OUTPUT:fspec 10$: RETURN ............ .DSABL LSB ;+ ; Action Routine for TECO EXECUTE Option ;- .ENABL LSB OVATEX: MOV #<377>,@#XTE.FG ;Flag command as MUNG MOV #<".T>,EFTYP ;Force .TEC filetype MOV #<"EC>,EFTYP+2 ; .ADDR #,R1 ;Point to TECO command for MUNG MOV #,R0 ;Point to EXECUTE command area 10$: MOVB (R1)+,(R0)+ ;Move bytes into CHAIN area BNE 10$ ;Loop till null DEC R0 ;Point back to null CMPB #<':>,@R5 ;Is there an input string? BNE 30$ ;Branch if not CMPB #<''>,-(R5) ;Is string in quotes? BNE 50$ ;Branch if not 20$: CMPB #<''>,-(R5) ;Look for string terminator BNE 40$ ;Branch if not it CMPB #<''>,-(R5) ;Is this double quote? BEQ 40$ ;Yes, accept as single embedded quote 30$: MOVB (R1)+,(R0)+ ;Move in the terminator byte BNE 30$ ;Move in remainder of command RETURN ............ 40$: MOVB @R5,(R0)+ ;Put the byte in BNE 20$ ;Branch as long as not end of line OCALLR BADCOM ;Command not acceptable ............ 50$: INC R5 ;Bump back to fall in loop 60$: CMPB #<' >,-(R5) ;If not in quotes accept a blank field BEQ 30$ ;Branch if at terminator MOVB @R5,(R0)+ ;Move over a byte BNE 60$ ;Keep looping BR 30$ ;Give up ............ EXSTR: .ASCIZ "YHXZHK@I" .ASCIZ "MZ" .EVEN ............ .DSABL LSB .SBTTL EDIT Option Text Table ;+ ; Option text table for EDIT commands ;- .IRP NUM,<\$OPTX> OPTX'NUM:: .ENDR .BYTE -1 .DSABL CRF $SCNT=0 SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT .EVEN .ENABL CRF NEXTL ............ .ENDC ;NE EDIT$$ .ENDC ;NE EDIT$$!MAKE$$!MUNG$$!TECO$$ .IF NE CREA$$!DELE$$!PRIN$$!TYPE$$ .SBTTL CREATE/DELETE/PRINT/TYPE Overlay OVERLAY .IF NE DELE$$ ;If DELETE command OVCMD DELETE CALLR DEL1 ............ .ENDC ;NE DELE$$ .IF NE TYPE$$ ;If TYPE command .SBTTL TYPE Command ;+ ; TYPE Command ;- SYNTAX TYPE PROMPT $FILE SCALL GSWIT,<1,2> REQBLNK DEFILE FSTARF DEFINX $.LST SCALL SPISPC,<1> FLDBEG SCALL CSPISPC,<1> ITEREND DEFOSPC $TTSPC EOLSEQ PIP SETSWIT A WILDEF PIP,W,LOG,ASK,NLG,NLG,$WILD0 COMPDEF APLYDEF PIP,LOG,W APLYDEF PIP,ASK,Q END ............ SWITS TYPE SWIT LOG 1 PIP - - LOG ENDNO SWIT QUERY 1 PIP - - ASK SWIT COPIES 1 PIP - K,,DVAL SWIT DELETE 2 PIP - D SWIT NEWFILES 1 PIP - C SWIT BEFORE 1 PIP - J,,DVAL SWIT DATE 1 PIP - C,,DVAL SWIT SINCE 1 PIP - I,,DVAL SWIT INFORMATION 1 PIP - X SWIT WAIT 1 PIP - E NOS SWIT NOLOG 1 - - - NLG ENDS ............ OVCMD TYPE ITBLE 7 ;Set maximum number of file specs .IF EQ CREA$$ ;If no CREATE command, must use own processing OCALL INITIT ;Do the parse OCALLR CMDEXE ;Generate the command text and execute it ............ .IFF ;EQ CREA$$ ;If CREATE command BR COMONC ;Join common code to parse and execute command ............ .ENDC ;EQ CREA$$ .ENDC ;NE TYPE$$ .IF NE CREA$$ ;If CREATE command (for next page) .SBTTL CREATE Command ;+ ; CREATE Command ;- SYNTAX CREATE PROMPT $FILEE SCALL GSWIT,<1> REQBLNK SCALL ROUSPC,<1,2> ROUTINE ATE SETSWIT C EOLSEQ DUP END ............ SWITS CREATE ENDNO SWIT START 1 DUP - G,,DVAL SWIT EXTENSION 1 - DUP T,,DVAL SWIT ALLOCATE 2 DUP - ALL NOS ENDS ............ OVCMD CREATE ITBLE 1 ;Set maximum number of file specs COMONC: OCALL INITIT ;Do the parse OCALLR CMDEXE ;Generate the command text and execute it ............ ;+ ; Action routine for the CREATE command ;- .ENABL LSB OVAATE: OINST TST FORCEP,,* ;Any program forced yet? BPL 10$ ;No, then set /C create for DUP CMPB (R4)+,(R4)+ ;Yes,bump interp ptr past SETSWIT C 10$: RETURN ............ .DSABL LSB .ENDC ;NE CREA$$ .IF NE PRIN$$ ;If PRINT command (for next page) .SBTTL PRINT Command ;+ ; PRINT Command ;- SYNTAX PRINT PROMPT $FILE DEFILE FSTARF SCALL GSWIT,<1> REQBLNK FILQUAL DEFINX $.LST SPISPEC SAVNAM SCALL GSWIT,<1> FLDBEG SCALL CSPISPC,<1> ITEREND DEFOSPC $LPWLD ROUTINE QPD EOLSEQ PIP WILDEF PIP,W,LOG,ASK,NLG,NLG,$WILD0 COMPDEF APLYDEF PIP,LOG,W APLYDEF QUEMAN,LOG,W APLYDEF PIP,ASK,Q APLYDEF QUEMAN,ASK,Q END ............ SWITS PRINT SWIT LOG 1 - - - LOG SWIT FLAGPAGE 1 - QUEMAN H,,DVAL ENDNO SWIT QUERY 1 - - - ASK SWIT COPIES 1 - - K,,DVAL SWIT DELETE 1 - - D SWIT NEWFILES 1 - - C SWIT BEFORE 1 - - J,,DVAL SWIT SINCE 1 - - I,,DVAL SWIT DATE 1 - - C,,DVAL SWIT INFORMATION 1 - - X SWIT WAIT 1 PIP - E SWIT PROMPT 1 - QUEMAN / SWIT NAME 1 - QUEMAN QNM SWIT PRINTER 1 - - - SWIT OUTPUT 1 - - PRO NOS SWIT NOLOG 1 - - - NLG SWIT NOFLAGPAGE 1 - QUEMAN N ENDS ............ OVCMD PRINT .ENABL LSB ITBLE 8. ;Set maximum number of file specs OCALL INITIT ;Do the parse .IF NE VENU$C ;VENUS uses SPSTAT for 'DCON running' flag: ; cannot use spooler in VENUS console !! .IFF ;NE VENU$C MOV @#$SYPTR,R5 ;Point to start of RMON BIT #,SPSTAT-$RMON(R5) ;Is the spooler active? BEQ 50$ ;Branch if no - normal processing MOV PC,-(SP) ;Initialize FLAGPAGE flag MOV #<'N>,R3 ;Check if /NOFLAGPAGE issued CALL DELSWT ;If option present, delete switch from table BCS 10$ ;Branch if /NOFLAGPAGE not issued CLR @SP ;Set flagpage count to 0 10$: MOV #<'H>,R3 ;Check if /FLAGPAGE:n issued CALL DELSWT ;If option present, delete switch from table BCC 20$ ;Branch if /FLAGPAGE issued TST @SP ;No /FLAGPAGE - was /NOFLAGPAGE also issued? BEQ 30$ ;Branch if yes to set spooler status word BR 40$ ;Else, clean stack and process without switch ............ ;+ ; /FLAGPAGE was issued and detected. Test is /NOFLAGPAGE was also detected ; and give error if so. ;- 20$: TST @SP ;Was /NOFLAGPAGES issued? BEQ 80$ ;Branch if yes for Conflicting switch error CLR @SP ;Set default to 0 CMPB #<':>,(R2)+ ;Was a value specified? BNE 40$ ;No - use default setting MOVB (R2)+,@SP ;Get number of flagpages to print BIC #<'0>,@SP ;De-ASCIIze it CMPB #<6>,@SP ;Must be in range of 0 to 6 BLO 90$ ;If > 6 - Invalid value with option error CMPB #<'.>,@R2 ;Was number of flagpages > 2 digits? BNE 90$ ;BR if yes - Invalid value with option error 30$: SWAB @SP ;Get count in high byte COM @SP ;Create the active complement BIC #^c<3400>,@SP ;Isolate count BIS @SP,SPSTAT-$RMON(R5) ;Set override value in status word 40$: TST (SP)+ ;Clean up stack OINST MOVB #<$$PIP>,FORCEP,,* ;Force the run of PIP .ENDC ;NE VENU$C 50$: CALL DETPRG ;Determine the program to run BEQ 60$ ;Branch if QUEMAN is to be run MOV (PC)+,R3 ;Get the two switches to check for .BYTE <'/>, <'D> ;Parse switch table for // and /D OCALL FDSWIT ;PIP is to run - look for // QUEMAN prompt swt ;;; CALL FNDSWT ;PIP is to run - look for // QUEMAN prompt swt BCC 70$ ;If found invalid options SWAB R3 ;Set up to check /D OCALL FDSWIT ;Go find /D given ;;; CALL FNDSWT ;Go find /D given BCS 60$ ;Not specified, skip rest TSTB @R1 ;Is it on the command ? BEQ 60$ ;Yes, don't worry about it OINST CMPB FILNUM,#<2>,* ;More than 1 input file specified ? BGT 70$ ;No, don't worry about it 60$: OCALLR CMDEXE ;Generate the command text ............ ;+ ; Possible errors. ;- 70$: OCALLR ILSWIT ;Give "Invalid option" ............ .IF EQ VENU$C 80$: OCALLR CNFSWT ;Conflicting options ............ 90$: OCALLR ILVALU ;Invalid value with switch ............ .ENDC ;EQ VENU$C .DSABL LSB .ENDC ;NE PRIN$$ .IF NE DELE$$ ;If DELETE command (for next page) .SBTTL DELETE Command ;+ ; DELETE Command ;- SYNTAX DELETE PROMPT $FILE SCALL GSWIT,<1,2> REQBLNK FILQUAL DEFILE ESTARF+FSTARF SPISPEC SAVNAM SCALL GSWIT,<1> FLDBEG SCALL CSPISPC,<1> ITEREND EOLSEQ PIP APLYDEF PIP,,D APLYDEF FILEX,,D WILDEF PIP,Q,LOG,ASK,DIT,DIT,$WILD0 COMPDEF APLYDEF PIP,ASK,Q APLYDEF FILEX,ASK,Q APLYDEF PIP,LOG,W APLYDEF PIP,WAI,E APLYDEF FILEX,WAI,W END ............ SWITS DELETE SWIT QUERY 1 PIP - - ASK ENDNO SWIT LOG 1 PIP - - LOG SWIT SYSTEM 1 PIP - Y SWIT NEWFILES 1 PIP - C SWIT DATE 1 PIP - C,,DVAL SWIT SINCE 1 PIP - I,,DVAL SWIT BEFORE 1 PIP - J,,DVAL SWIT EXCLUDE 1 PIP - P SWIT POSITION 1 PIP - M,,DVAL SWIT INFORMATION 1 PIP - X SWIT WAIT 1 - - - WAI SWIT DOS 1 - FILEX S SWIT INTERCHANGE 1 - FILEX U SWIT ENTRY 2 - QUEMAN M NOS SWIT NOQUERY 1 - - - DIT ENDS ;Switch ID list for DELETE ............ .ENABL LSB DEL1: ITBLE 7 ;Maximum of 6 filespecs to delete OCALL INITIT ;Parse the command CALL DETPRG ;Determine the program to run BNE 10$ ;PIP is to run so no need to go further MOVB #<'M>,R3 ;Running QUEMAN, look if /M given OCALL FDSWIT ;Go find if switch given ;;; CALL FNDSWT ;Go find if switch given BCS 10$ ;Nothing to worry about TSTB @R1 ;Is switch on command? BNE 10$ ;No, just a file qualifier CALL PUTOUT ;Put switch on the output spec 10$: OCALLR CMDEXE ;Go execute command ............ .DSABL LSB .ENDC ;NE DELE$$ .IF NE DELE$$!PRIN$$ ;+ ; Action routines to handle the PRINT to the Queue or DELETE/ENTRY Options ;- .ENABL LSB OVAQNM: MOV @#$SYPTR,R1 ;Point to start of RMON .IF EQ VENU$C BIT #,SPSTAT-$RMON(R1) ;Spooler active? BNE 10$ ;Branch if yes .ENDC ;EQ VENU$C BIT #,CONFIG-$RMON(R1) ;Is QUEUE running? BNE 20$ ;Branch if yes 10$: OCALLR ILSWIT ;Give "Invalid option" ............ 20$: OINST MOV DEFDEV,-(SP),* ;Save the two words of the OINST MOV DEFDEV+2,-(SP),* ;The current default device OINST MOV LPDEV,DEFDEV,,* ;Make the default LP: OINST MOV LPDEV+2,DEFDEV+2,,* OCALL ACTFOT ;Make the spec OINST TSTB FOTFLG,,* ;Anything generated yet? BEQ 30$ ;No,wait till something happens TSTB FTPFLD-FSIZ+1(R0) ;An extension given ? BNE BADEXT ;Yes, invalid for a job name 30$: OINST MOV (SP)+,DEFDEV+2,,* ;Default device OINST MOV (SP)+,DEFDEV,,* ;Restore the original RETURN ............ BADEXT: OCALLR BADCOM ;Invalid command ............ ..QULP ==: < . > ;**PATCH** .ASCIZ "LP:" Default device for QUEMAN LPDEV: .ASCIZ "LP:" ;Default device for QUEMAN output .EVEN FOTIND: .WORD < -2 - FOTYP > * OFBSIZ ;First output spec type ............ .DSABL LSB .ENABL LSB OVAQPD: ;Determine program to run OINST MOV FORCEP,R0,* ;Get the program to run BIC #^c,R0 ;Is there a definite program ? BNE 10$ ;Yes, skip determination MOV @#$SYPTR,R0 ;Get the RMON location BIT #,CONFIG-$RMON(R0) ;Is QUEUE running ? BEQ 10$ ;No, go with PIP MOVB #<200!$$QUEM>,R0 ;Let's set the QUEUE running BIC #<340>,R0 ;A lot of work but this is how it's OINST MOV R0,FORCEP,,* ;Done to set FORCEP correctly 10$: RETURN ............ .DSABL LSB ;+ ; Determine the program to RUN ; On Output: R0 = program to RUN cusp index ; All Registers Destroyed! ;- .ENABL LSB DETPRG: OINST MOV FORCEP,R0,* ;Get the program to run BIC #^c,R0 ;Isolate the cusp number CMPB #<$$QUEM>,R0 ;Is it QUEMAN ? BNE 10$ ;No, go execute the command MOV R0,-(SP) ;Save the program to run .ADDR #,R4 ;Point at the spec block OINST MOV LPDEV,DEFDEV,,* ;Lp: is the default output device OINST MOV LPDEV+2,DEFDEV+2,,* ;For QUEMAN OCALL MAKOFL ;Make default output file MOV (SP)+,R0 ;Restore the program being run SEZ 10$: RETURN ............ .DSABL LSB ;+ ; PUTOUT - Put the FILNUM of the first output spec in the switch's ; table entry passed in R1 ;- .ENABL LSB PUTOUT: CLR R2 ;Keep track of the filespec number OADDR FILST-1,R0 ;Point at the start of the file specs 10$: INC R2 ;At start the next file ADD #,R0 ;Look at the file type field CMPB @R0,# ;Is this the one we want BNE 10$ ;No it isn't MOVB R2,@R1 ;Store the FILNUM for the switch RETURN ............ .DSABL LSB ;+ ; Search for switch (in R3). If found, delete it's entry in the switch table ; by removing the offset to that switch in TRANSW. NSWITS (switch count) must ; also be decremented. ; ; Input: R3 = contains the ASCII switch character to search for in ; the low byte. ; ; Call: CALL DELSWT ; ; Output: SAME as FNDSWT except that R1 is destroyed. ;- .ENABL LSB DELSWT: OCALL FDSWIT ;See if switch is in table ;;; CALL FNDSWT ;See if switch is in table BCS 10$ ;Branch if not OCALL REMSWT ;If yes remove the swtch from table CLC ;Make sure c-bit cleared to show switch found 10$: RETURN ............ .DSABL LSB .ENDC ;NE DELE$$!PRIN$$ .IF NE DELE$$!PRIN$$!TYPE$$ ;If DELETE, PRINT or TYPE command(s) .SBTTL DELETE/PRINT/TYPE Option Text Table ;+ ; Option Text Table for DELETE, PRINT, TYPE ;- .IRP NUM,<\$OPTX> OPTX'NUM:: .ENDR .BYTE -1 .DSABL CRF $SCNT=0 SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT .EVEN .ENABL CRF NEXTL ............ .ENDC ;NE DELE$$!PRIN$$!TYPE$$ .ENDC ;NE CREA$$!DELE$$!PRIN$$!TYPE$$ .IF NE BOOT$$!DUMP$$!FORM$$!INIT$$!PROT$$!RENA$$!UNPR$$ .SBTTL BOOT/DUMP/FORMAT/INITIALIZE/PROTECT/UNPROTECT/RENAME Overlay OVERLAY .IF NE BOOT$$ ;If BOOT command OVCMD BOOT CALLR BOT1 ............ .ENDC ;NE BOOT$$ .IF NE DUMP$$ ;If DUMP command OVCMD DUMP CALLR DUM1 ............ .ENDC ;NE DUMP$$ .IF NE FORM$$ ;If FORMAT command OVCMD FORMAT CALLR FOR1 ............ .ENDC ;NE FORM$$ .IF NE RENA$$ ;If RENAME command .SBTTL RENAME Command ;+ ; RENAME Command ;- SYNTAX RENAME PROMPT $FROM DEFILE FSTARF+ESTARF SCALL GSWIT,<1> REQBLNK SCALL SPISPC,<1> FLDBEG SCALL CSPISPC,<1> ITEREND PROMPT $TO SCALL SPOSPC,<1> EOLSEQ PIP SETSWIT R WILDEF PIP,W,LOG,ASK,NLG,NLG,$WILD0 COMPDEF APLYDEF PIP,LOG,W APLYDEF PIP,ASK,Q END ............ SWITS RENAME SWIT LOG 1 PIP - - LOG SWIT REPLACE 1 PIP - - SWIT PROTECTION 1 PIP - F ENDNO SWIT QUERY 1 PIP - - ASK SWIT SYSTEM 1 PIP - Y SWIT NEWFILES 1 PIP - C SWIT DATE 1 PIP - C,,DVAL SWIT SINCE 1 PIP - I,,DVAL SWIT BEFORE 1 PIP - J,,DVAL SWIT SETDATE 1 PIP - T,,DVAL SWIT INFORMATION 1 PIP - X SWIT WAIT 1 PIP - E NOS SWIT NOLOG 1 - - - NLG SWIT NOREPLACE 1 PIP - N SWIT NOPROTECTION 1 PIP - Z ENDS ;Switch ID list for RENAME ............ OVCMD RENAME ITBLE 7 ;Set max number of file specs OCALL INITIT ;Do the parse OCALLR CMDEXE ;Generate the command text and execute it ............ .ENDC ;NE RENA$$ .IF NE PROT$$ ;If PROTECT command (for next page) .SBTTL PROTECT Command ;+ ; PROTECT Command ;- SYNTAX PROTECT PROMPT $FILE SCALL GSWIT,<1> REQBLNK FILQUAL DEFILE FSTARF+ESTARF SPISPEC SAVNAM SCALL GSWIT,<1> FLDBEG SCALL CSPISPC,<1> ITEREND EOLSEQ PIP SETSWIT F WILDEF PIP,W,LOG,ASK,NLG,NLG,$WILD0 COMPDEF APLYDEF PIP,LOG,W APLYDEF PIP,ASK,Q END ............ SWITS PROTECT SWIT LOG 1 PIP - - LOG ENDNO SWIT QUERY 1 PIP - - ASK SWIT SYSTEM 1 PIP - Y SWIT NEWFILES 1 PIP - C SWIT DATE 1 PIP - C,,DVAL SWIT SINCE 1 PIP - I,,DVAL SWIT BEFORE 1 PIP - J,,DVAL SWIT EXCLUDE 1 PIP - P SWIT WAIT 1 PIP - E SWIT INFORMATION 1 PIP - X SWIT SETDATE 1 PIP - T,,DVAL NOS SWIT NOLOG 1 - - - NLG ENDS ;Switch ID list for protection ............ OVCMD PROTECT ITBLE 7 ;Maximum number of filespecs to protect OCALL INITIT ;Parse the command OCALLR CMDEXE ;Go execute command ............ .ENDC ;NE PROT$$ .IF NE UNPR$$ ;If UNPROTECT command (for next page) .SBTTL UNPROTECT Command ;+ ; UNPROTECT Command ;- SYNTAX UNPROTECT PROMPT $FILE SCALL GSWIT,<1> REQBLNK DEFILE FSTARF+ESTARF SPISPEC SAVNAM SCALL GSWIT,<1> FLDBEG SCALL CSPISPC,<1> ITEREND EOLSEQ PIP SETSWIT Z WILDEF PIP,W,LOG,ASK,NLG,NLG,$WILD0 COMPDEF APLYDEF PIP,LOG,W APLYDEF PIP,ASK,Q END ............ SWITS UNPROTECT SWIT LOG 1 PIP - - LOG ENDNO SWIT QUERY 1 PIP - - ASK SWIT SYSTEM 1 PIP - Y SWIT NEWFILES 1 PIP - C SWIT DATE 1 PIP - C,,DVAL SWIT SINCE 1 PIP - I,,DVAL SWIT BEFORE 1 PIP - J,,DVAL SWIT EXCLUDE 1 PIP - P SWIT WAIT 1 PIP - E SWIT INFORMATION 1 PIP - X SWIT SETDATE 1 PIP - T,,DVAL NOS SWIT NOLOG 1 - - - NLG ENDS ;Switch ID list for UNPROTECTion ............ OVCMD UNPROTECT ITBLE 7 ;Maximum number of filespecs to UNPROTECT OCALL INITIT ;Parse the command OCALLR CMDEXE ;Go execute command ............ .ENDC ;NE UNPR$$ .IF NE INIT$$ ;If INITIALIZE command (for next page) .SBTTL INITIALIZE Command ;+ ; INITIALIZE Command ;- SYNTAX INITIALIZE PROMPT $DEVICE DEFILE FSTARF DEFINX $.BOT SCALL GSWIT,<1> REQBLNK SCALL SPOSPC,<1> EOLSEQ DUP SETSWIT Z COMPDEF APLYDEF DUP,WAI,W APLYDEF FILEX,WAI,W END ............ SWITS INITIALIZE SWIT QUERY 1 - - - ENDNO SWIT FILE 1 DUP - FIN SWIT SEGMENTS 1 DUP - N,,DVAL SWIT DOS 1 - FILEX S SWIT INTERCHANGE 1 - FILEX U SWIT VOLUMEID 1 - - V,,VAL SWIT BADBLOCKS 1 DUP - B,,VAL SWIT REPLACE 1 DUP - R,,VAL SWIT WAIT 1 - - - WAI SWIT RESTORE 1 DUP - D ;;; SWIT BACKUP 1 - BUP - NOS SWIT NOQUERY 1 - - Y ENDS ............ OVCMD INITIALIZE INI1: ITBLE 2 ;Set max number of file specs OCALL INITIT ;Do the parse OCALLR CMDEXE ;Generate the command text and execute it ............ .ENDC ;NE INIT$$ .IF NE DUMP$$ ;If DUMP command (for next page) .SBTTL DUMP Command ;+ ; DUMP Command ;- SYNTAX DUMP PROMPT $DVOFL SCALL GSWIT,<1> REQBLNK SCALL RINSPC,<1> DEFOSPC $LPSPC EOLSEQ DUMP END ............ SWITS DUMP SWIT ASCII 1 DUMP - - ENDNO SWIT WORDS 1 DUMP - W SWIT BYTES 1 DUMP - B SWIT RAD50 1 DUMP - X SWIT ONLY 1 DUMP - O,,VAL SWIT START 1 DUMP - S,,VAL SWIT END 1 DUMP - E,,VAL SWIT IGNORE 1 DUMP - G SWIT FOREIGN 1 DUMP - T SWIT TERMINAL 1 - - TER SWIT PRINTER 1 - - PRI SWIT OUTPUT 1 - - OUT SWIT ALLOCATE 1 - - ALL NOS SWIT NOASCII 1 DUMP - N ENDS ............ DUM1: ITBLE 3 ;Set max number of file specs OCALL INITIT ;Do the parse OCALLR CMDEXE ;Generate the command text and execute it ............ .ENDC ;NE DUMP$$ .IF NE BOOT$$ ;If BOOT command (for next page) .SBTTL BOOT Command ;+ ; BOOT Command ;- SYNTAX BOOT PROMPT $DVOFL DEFDV $SY DEFINX $.SYS SCALL GSWIT,<1> REQBLNK SCALL RINSPC,<1> EOLSEQ DUP SETSWIT O END ............ SWITS BOOT ENDNO SWIT WAIT 1 DUP - W SWIT FOREIGN 1 DUP - Q NOS ENDS ............ BOT1: ITBLE 1 ;Set max number of file specs OCALL INITIT ;Do the parse OCALLR CMDEXE ;Generate the command text and execute it ............ .ENDC ;NE BOOT$$ .IF NE FORM$$ ;If FORMAT command (for next page) .SBTTL FORMAT Command ;+ ; FORMAT Command ;- SYNTAX FORMAT PROMPT $DEVICE SCALL GSWIT,<1> REQBLNK SCALL RINSPC,<1> EOLSEQ FORMAT END ............ SWITS FORMAT SWIT QUERY 1 FORMAT - - ENDNO SWIT WAIT 1 FORMAT - W SWIT SINGLEDENSITY 1 FORMAT - S SWIT VERIFY 1 FORMAT - V,,VAL SWIT PATTERN 1 FORMAT - P,,VAL NOS SWIT NOQUERY 1 FORMAT - Y ENDS ............ FOR1: ITBLE 1 ;Set max number of file specs OCALL INITIT ;Do the parse OCALLR CMDEXE ;Generate the command text and execute ............ .ENDC ;NE FORM$$ .SBTTL BOOT/DUMP/FORMAT/PROTECT/RENAME/UNPROTECT/INITIALIZE Option Text Table ;+ ; Option text table for RENAME, PROTECT, UNPROTECT, INITIALIZE, DUMP, BOOT ; and FORMAT. ;- .IRP NUM,<\$OPTX> OPTX'NUM:: .ENDR .BYTE -1 .DSABL CRF $SCNT=0 SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT ;;; SWTDEF ;;; FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT .EVEN .ENABL CRF NEXTL ............ .ENDC ;NE BOOT$$!DUMP$$!FORM$$!INIT$$!PROT$$!RENA$$!UNPR$$ .IF NE DIBO$$!HELP$$!MACR$$ .SBTTL DIBOL/HELP/MACRO Overlay OVERLAY .IF NE HELP$$ ;If HELP command OVCMD HELP CALLR HELP1 ............ .ENDC ;NE HELP$$ .IF NE MACR$$ ;If MACRO command (for next page) .SBTTL MACRO Command ;+ ; MACRO Command ;- SYNTAX MACRO SCALL GSWIT,<1> FLDBEG MINIT1 TSTCFLG OPTEND REQCOMMA GOTO MINIT2 ............ MINIT1: PROMPT $FILE REQBLNK MINIT2: FILQUAL INSPEC SAVNAM SCALL GSWIT,<1,2> FLDBEG REQPLUS SCALL RINSPC,<1,2> ITEREND MAKOFL FOTYP MAKOFL SOTYP CEOLSEQ MACRO END ............ SWITS MACRO SWIT OBJECT 1 - - FOT SWIT SHOW 1 MACRO - L,,VAL ENDNO SWIT LIST 1 - - SOT SWIT ENABLE 1 MACRO - E,,VAL SWIT DISABLE 1 MACRO - D,,VAL SWIT CROSSREFERENCE 1 MACRO - C,,VAL SWIT LIBRARY 2 MACRO - M SWIT PASS 2 MACRO - P,,DVAL SWIT ALLOCATE 1 - - ALL NOS SWIT NOOBJECT 1 - - NOO SWIT NOSHOW 1 MACRO - N,,VAL ENDS ;Switch ID list for MACRO ............ MACMOR: OINST MOV CNMPTR,R5,* ;Restore the pointer to the switches OVCMD MACRO OINST MOV R5,CNMPTR,,* ;Save pointer to switches for a,b case ITBLE 9. ;Max of 6 in, 2+1 out filespecs to MACRO OCALL INITIT ;Parse the command OINST INCB COMPFL,,* ;Flag in middle of COMPILE class command OINST MOV R5,CSTPTR,,* ;Save text pointer where scan stopped OCALL CMDMAK ;Generate the command text OINST TSTB @CSTPTR,,* ;Are we at end of line? BNE MACMOR ;Continue processing this command OCALLR STRT ;Jump into the KMON to do the commands ............ .ENDC ;NE MACR$$ .IF NE DIBO$$ ;If DIBOL command (for next page) .SBTTL DIBOL Command ;+ ; DIBOL Command ;- SYNTAX DIBOL SCALL GSWIT,<1> FLDBEG DINIT1 TSTCFLG OPTEND REQCOMMA GOTO DINIT2 ............ DINIT1: PROMPT $FILE REQBLNK DINIT2: FILQUAL INSPEC SAVNAM SCALL GSWIT,<1> FLDBEG REQPLUS SCALL RINSPC,<1> ITEREND MAKOFL FOTYP MAKOFL SOTYP CEOLSEQ DICOMP END ............ SWITS DIBOL SWIT OBJECT 1 - - FOT SWIT WARNINGS 1 - - - SWIT LINENUMBERS 1 - - - ENDNO SWIT LIST 1 - - SOT SWIT ALPHABETIZE 1 - - A SWIT ONDEBUG 1 - - D SWIT CROSSREFERENCE 1 - - C SWIT ALLOCATE 1 - - ALL SWIT LOG 1 - - G SWIT PAGE 1 - - P,,DVAL SWIT TABLES 1 - - S NOS SWIT NOOBJECT 1 - - NOO SWIT NOWARNINGS 1 - - W SWIT NOLINENUMBERS 1 - - O ENDS ;Switch ID list for DIBOL ............ DIBMOR: OINST MOV CNMPTR,R5,* ;Restore the pointer to the switches OVCMD DIBOL OINST MOV R5,CNMPTR,,* ;Save pointer to switches for a,b case ITBLE 9. ;Max of 6 in, 2+1 out filespecs to DIBOL OCALL INITIT ;Parse the command OINST INCB COMPFL,,* ;Flag in middle of COMPILE class command OINST MOV R5,CSTPTR,,* ;Save text pointer where scan stopped OCALL CMDMAK ;Generate the command text OINST TSTB @CSTPTR,,* ;Are we at end of line? BNE DIBMOR ;Continue processing this command OCALLR STRT ;Jump into the KMON to do the commands ............ .ENDC ;NE DIBO$$ .IF NE HELP$$ ;If HELP command .SBTTL HELP Command ;+ ; HELP Command ;- .ENABL LSB HELP1: CLRB @#XED.1F ;Clear input file name area CLRB @#XED.2F ;Clear output file name area MOV #,R0 ;Now set up chain arguments .ADDR #,R1 ;Point to help chain info MOV (R1)+,(R0)+ ;Put in 500 MOV (R1)+,(R0)+ ;Put in 502 MOV (R1)+,(R0)+ ;Put in 504 MOV (R1)+,(R0)+ ;Put in 506 MOV #,R0 ;Put user command line - help at 600 INC R5 ;Bump pointer for entering loop 10$: MOVB -(R5),(R0)+ ;Move string into chain area BNE 10$ ;Loop till done .SRESET ;Clear all channels .IF NE MMG$T BIC #,@#$JSW .ENDC ;NE MMG$T .CHAIN ;CHAIN to the appropriate editor ............ .DSABL LSB ..HELF ==: < . > ;**PATCH** HELP Default Program Filespec HLPBLK: .RAD50 /SY HELP SAV/ ............ .ENDC ;NE HELP$$ .IF NE DIBO$$!MACR$$ .SBTTL DIBOL/MACRO Option Text Table ;+ ; Option Text Table for the MACRO and DIBOL Command(s) ; ; If any changes are made here, they should also be made (if needed) to ; the copies of this table in the EXECUTE and FORTRAN/COMPILE overlays. ;- .IRP NUM,<\$OPTX> OPTX'NUM:: .ENDR .BYTE -1 .DSABL CRF $SCNT=0 SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF
FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT .EVEN .ENABL CRF NEXTL ............ .ENDC ;NE DIBO$$!MACR$$ .ENDC ;NE DIBO$$!HELP$$!MACR$$ .IF NE COMP$$!FORT$$ .SBTTL COMPILE/FORTRAN Overlay OVERLAY .IF NE FORT$$ ;If FORTRAN command OVCMD FORTRAN CALLR FORT ............ .ENDC ;NE FORT$$ .IF NE COMP$$ ;If COMPILE command OVCMD COMPILE CALLR COMPL1 ............ .SBTTL COMPILE Command ;+ ; COMPILE Command ;- SYNTAX COMPILE SCALL GSWIT,<1> FLDBEG COMP1 TSTCFLG OPTEND REQCOMMA GOTO COMP2 ............ COMP1: PROMPT $FILE REQBLNK COMP2: FILQUAL INSPEC SAVNAM SCALL GSWIT,<1,2> FLDBEG REQPLUS SCALL RINSPC,<1,2> ITEREND MAKOFL FOTYP MAKOFL SOTYP CNDROUT FRT,FRT FILTYPR $COMPSTR CEOLSEQ FORTRAN,FORTRAN COMPDEF APLYDEF F77,NMS,S APLYDEF F77,WRP,W APLYDEF FORTRAN,NMS,S APLYDEF DICOMP,NMS,O APLYDEF FORTRAN,WRP,W APLYDEF DICOMP,WRN,W END ............ SWITS COMPILE SWIT OBJECT 1 - - FOT SWIT SHOW 1 - - L,,VAL SWIT LINENUMBERS 1 - - - SWIT SWAP 1 - - - SWIT VECTORS 1 FORTRA - - SWIT OPTIMIZE 1 FORTRA - P,,VAL SWIT WARNINGS 1 - - - WRP ENDNO SWIT MACRO 1 - MACRO - SWIT DIBOL 1 - DICOMP - SWIT FORTRAN 1 - - - FRT SWIT F4 1 - FORTRA - SWIT F77 1 - F77 - SWIT TRACE 1 F77 - S,,VAL SWIT CHECK 1 F77 - I SWIT WORKFILES 1 F77 - F,,DVAL SWIT CONTINUATIONS 1 F77 - C,,DVAL SWIT WIDE 1 F77 - Q SWIT LIST 1 - - SOT SWIT ENABLE 1 MACRO - E,,VAL SWIT DISABLE 1 MACRO - D,,VAL SWIT CROSSREFERENCE 1 - - C,,VAL SWIT ALPHABETIZE 1 DICOMP - A SWIT LOG 1 DICOMP - G SWIT PAGE 1 DICOMP - P,,DVAL SWIT TABLES 1 DICOMP - S SWIT ONDEBUG 1 - - D SWIT EXTEND 1 - - E SWIT STATISTICS 1 - - A SWIT UNITS 1 - - N,,DVAL SWIT HEADER 1 FORTRA - O SWIT CODE 1 FORTRA - I,,VAL SWIT DIAGNOSE 1 FORTRA - B,,VAL SWIT RECORD 1 - - R,,DVAL SWIT I4 1 - - T SWIT LIBRARY 2 MACRO - M SWIT PASS 2 MACRO - P,,DVAL SWIT ALLOCATE 1 - - ALL NOS SWIT NOOBJECT 1 - - NOO SWIT NOSHOW 1 MACRO - N,,VAL SWIT NOLINENUMBERS 1 - - - NMS SWIT NOSWAP 1 - - U SWIT NOVECTORS 1 FORTRA - V SWIT NOOPTIMIZE 1 - - M,,VAL SWIT NOWARNINGS 1 - - - WRN ENDS ............ COMMOR: OINST MOV CNMPTR,R5,* ;Restore the pointer to the switches COMPL1: OINST MOV R5,CNMPTR,,* ;Save pointer to switches for a,b case ITBLE 9. ;Max of 6 in, 2+1 out filespecs OCALL INITIT ;Parse the command OINST INCB COMPFL,,* ;Flag in middle of COMPILE class command OINST MOV R5,CSTPTR,,* ;Save text pointer where scan stopped CALL FIXNPT ;If running F77, change /M to /O OCALL CMDMAK ;Generate the command text OINST TSTB @CSTPTR,,* ;Are we at the end of the line? BNE COMMOR ;Continue processing this command OCALLR STRT ;Jump into the KMON to do the commands ............ .ENDC ;NE COMP$$ .IF NE FORT$$ ;If FORTRAN command (for next page) .SBTTL FORTRAN Command ;+ ; FORTRAN Command ;- SYNTAX FORTRAN SCALL GSWIT,<1> FLDBEG FORT1 TSTCFLG OPTEND REQCOMMA GOTO FORT2 ............ FORT1: PROMPT $FILE REQBLNK FORT2: FILQUAL INSPEC SAVNAM SCALL GSWIT,<1> FLDBEG REQPLUS SCALL RINSPC,<1> ITEREND MAKOFL FOTYP MAKOFL SOTYP CEOLSEQ FORTRAN,FORTRAN END ............ SWITS FORTRAN SWIT OBJECT 1 - - FOT SWIT LINENUMBERS 1 FORTRA - - SWIT SWAP 1 - - - SWIT VECTORS 1 FORTRA - - SWIT OPTIMIZE 1 FORTRA - P,,VAL SWIT WARNINGS 1 - - W ENDNO SWIT F4 1 - FORTRA - SWIT F77 1 - F77 - SWIT TRACE 1 F77 - S,,VAL SWIT CHECK 1 F77 - I SWIT WORKFILES 1 F77 - F,,DVAL SWIT CONTINUATIONS 1 F77 - C,,DVAL SWIT WIDE 1 F77 - Q SWIT ONDEBUG 1 - - D SWIT EXTEND 1 - - E SWIT STATISTICS 1 - - A SWIT UNITS 1 - - N,,DVAL SWIT HEADER 1 FORTRA - O SWIT DIAGNOSE 1 FORTRA - B,,VAL SWIT CODE 1 FORTRA - I,,VAL SWIT RECORD 1 - - R,,DVAL SWIT LIST 1 - - SOT SWIT I4 1 - - T SWIT SHOW 1 - - L,,VAL SWIT ALLOCATE 1 - - ALL NOS SWIT NOOBJECT 1 - - NOO SWIT NOLINENUMBERS 1 - - S SWIT NOSWAP 1 - - U SWIT NOVECTORS 1 FORTRA - V SWIT NOOPTIMIZE 1 - - M,,VAL SWIT NOWARNINGS 1 - - - ENDS ;Switch ID list for FORTRAN ............ FORMOR: OINST MOV CNMPTR,R5,* ;Restore the pointer to the switches FORT: OINST MOV R5,CNMPTR,,* ;Save pointer to switches for a,b case ITBLE 9. ;Max of 6 in, 2+1 out filespecs OCALL INITIT ;Parse the command OINST INCB COMPFL,,* ;Flag in middle of FORTRAN command OINST MOV R5,CSTPTR,,* ;Save text pointer where scan stopped CALL FIXNPT ;If running F77, change /M to /O OCALL CMDMAK ;Generate the text OINST TSTB @CSTPTR,,* ;Are we at end of line? BNE FORMOR ;Continue processing this command OCALLR STRT ;Jump into the KMON to do them ............ .ENDC ;NE FORT$$ ;+ ; FIXNPT: If the FORTRAN 77 is being used, /M:val in the ; switch table must be changed to /O. ; This is done here because of the limitations ; of 37 action routine numbers. ; If FORTRAN 77 someday adds a /M switch, this will ; have to be changed. ; ; This routine is duplicated in the EXECUTE overlay. If changes are ; made here, they should be also be made there. ;- .ENABL LSB FIXNPT: OINST MOV FORCEP,R0,*, ;Check to see what cusp will be used BIC #^c,R0 ;Isolate cusp number CMPB #<$$F77>,R0 ;Is it F77? BNE 10$ ;No, branch MOVB #<'M>,R3 ;Did we use /M ? OCALL FDSWIT ;Find it, it's wrong BCS 10$ ;Didn't find it, nothing to worry about MOVB #<'O>,-(R2) ;Change it to /O for F77s 10$: RETURN ............ .DSABL LSB .SBTTL COMPILE/FORTRAN Option Text Table ;+ ; Option Text Table for the FORTRAN and COMPILE Command(s) ; ; If any changes are made here, they should also be made (if needed) to ; the copies of this table in the MACRO/DIBOL and EXECUTE overlays. ;- .IRP NUM,<\$OPTX> OPTX'NUM:: .ENDR .BYTE -1 .DSABL CRF $SCNT=0 SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF
FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT .EVEN .ENABL CRF NEXTL ............ .ENDC ;NE COMP$$!FORT$$ .IF NE EXEC$$!REMO$$ ;If EXECUTE or REMOVE command(s) .SBTTL EXECUTE (Parts 1&3)/REMOVE Overlay OVERLAY .IF NE REMO$$ ;If REMOVE command .SBTTL REMOVE Command ;+ ; REMOVE command ; ; Under SB and FB: ; Removes a device from the monitor currently in core. The format of command ; is "REMOVE XX[,YY,ZZ]" where XX,YY are names of devices to be removed. The ; devices must be known to the monitor as permanent physical devices (i.e., ; name is in $PNAME table). The device can't be either the system device or a ; device one of whose units is currently assigned to "SY:". The 'BA' handler ; cannot be removed, as its slot number: BA.NUM is used to determine whether ; BATCH is active. The device can't be TT:, since TT is resident. Any other ; device can be removed, unless its handler is currently resident. All device ; assignments are eliminated for all units of a device which is removed. ; ; Under XB and XM: ; You may remove a handler and/or a region. The region may be by itself or ; part of the handler that you are removing. If it is a region and it is not ; 2 characters long then no other processing is done. The name is treated as ; a region and VDMALC is entered to return spece to free memory. If the ; specified name is 2 characters in length, the handler name table is searched ; for a match. If the name is not found then the name is treated as a region ; and VDMALC is entered. If the handler is found, it is removed as mentioned ; in the previous paragraph. Once it is removed, a RAD50 $ is stored in the ; second word of the arguments passed to VDMALC so any region of the handler ; is also removed. (NOTE: All regions associated with a handler should be of ; the form /xx $/ where xx is the name of the handler followed by a space ; dollar sign. ;- SYNTAX REMOVE PROMPT $DEVICE REQBLNK END ............ SWITS REMOVE ENDNO NOS ENDS ............ .ENABL LSB OVCMD REMOVE ITBLE 0 ;Set maximum number of file specs OCALL INITIT ;Do the parse OREMOV: MOV R5,R2 ;R2 -> old string pointer MOV R5,R3 ;R3 -> new string pointer 10$: MOVB -(R2),-(R3) ;Get character in buffer BEQ 30$ ;End of line - branch out CMPB #<'a>,@R3 ;Less than lowercase a? BHI 20$ ;Branch if yes - no conversion CMPB #<'z>,@R3 ;Greater than lowercase z? BLO 20$ ;Branch if yes - no conversion BICB #,@R3 ;Convert lowercase alpha to uppercase 20$: CMPB #<' >,@R2 ;Space character? BNE 10$ ;No, get next character TSTB (R3)+ ;Adjust new string pointer - skip space BR 10$ ;Branch to get next character ............ 30$: MOV R5,-(SP) ;Save start of text for next name .IF NE MMG$T CLR (PC)+ ;Reset handler removed flag HNDREM: .WORD 0 ;<> denotes handler was removed in loop .ENDC ;NE MMG$T CLR (PC)+ ;Reset colon present flag CLNFLG: .WORD 0 ;<> denotes colon detected .ADDR #,R2 ;Point to work area OCALL GETNAM ;Get device name TST @R2 ;Any name given? BEQ 110$ ;No invalid command MOV R2,R0 ;Point at the filename OCALL COPYFN ;Save the filename incase of error TSTB @R5 ;All done with command string? BEQ 40$ ;Yes CMPB #<',>,@R5 ;No, are we at a comma? BEQ 40$ ;Yes CMPB #<':>,@R5 ;At a colon? BNE 110$ ;No, invalid command MOV SP,CLNFLG ;Set colon flag for presence of colon char. 40$: SUB R5,@SP ;Get character count TST CLNFLG ;Was colon specified? BEQ 50$ ;Branch if no CMPB #<',>,-(R5) ;Followed by comma? BEQ 50$ ;Branch if yes TSTB @R5 ;Followed by end of line? BNE 110$ ;Syntax error 50$: .IF NE UNI$64 CMP #<3>,@SP ;2 characters? BNE 60$ ;Nope TST (SP)+ ;Yes BR 80$ ............ 60$: CMP #<2>,(SP)+ ;Single letter input? .IFF ;NE UNI$64 CMP #<3>,(SP)+ ;Possible 2-char device name? .ENDC ;NE UNI$64 .IF EQ MMG$T BNE 110$ ;Bad syntax - give error .IFF ;EQ MMG$T BEQ 80$ ;Branch if yes TST CLNFLG ;Was a colon specified? BNE 110$ ;Branch if yes - syntax error TST 2(R2) ;3 characters or less? BNE 180$ ;Branch if no CMP @R2,#<^rIND> ;Trying to remove IND region? BNE 180$ ;Branch if definitily not OINST TSTB @.INDSTA,,* ;Were we called by IND to REMOVE? BPL 180$ ;Branch if no ;+ ;ERROR 70$: KMRTMG ,, ;- ............ .ENDC ;EQ MMG$T 80$: CMP @R2,#<^rSY > ;Did user say remove SY:? BEQ 230$ ;Yes, can't remove SY:. CMP @R2,#<^rBA > ;Was it remove BA? BEQ 230$ ;Yes, can't do that either CMP @R2,#<^rTT > ;Was it remove TT? BEQ 230$ ;Yes, also invalid MOV #<$SLOT>,R3 ;Count of device slots OINST MOV .$PNAM,R1,* ;Point to $PNAME table .IF NE UNI$64 MOV R1,R4 ;Point to the ... ADD #<$PNAM2-$PNAME>,R4 ; ... $PNAM2 table .ENDC ;NE UNI$64 90$: CMP @R2,(R1)+ ;Was the $PNAME form given for this device? BEQ 120$ ;Yes, use it .IF NE UNI$64 CMP @R2,(R4)+ ;Was the $PNAM2 form given for this device? BNE 100$ ;Nope MOV -2(R1),@R2 ;Use the $PNAME table form always BR 120$ ;And proceed ............ 100$: .ENDC ;NE UNI$64 SOB R3,90$ ;Loop to do all slots .IF EQ MMG$T ;+ ;ERROR KMRTMG ,, ;- ............ .IFF ;EQ MMG$T BR 180$ ;Go try to remove region ............ .ENDC ;EQ MMG$T 110$: OCALLR BADCOM ;Invalid syntax ............ 120$: MOV @R2,-(SP) ;Save device name CLR @R2 ;Clear it out OINST MOV .$UNAM,R4,* ;Point to user logical assignment table MOV #<$SLOT+1>,R3 ;R3 = Number of device slots + 1 130$: DEC R3 ;Thru the table? BEQ 140$ ;Yes CMP #<^rSY >,(R4)+ ;Is this 'SY:'? BNE 130$ ;No, try another MOV $UNAM1-$UNAM2-2(R4),@R2 ;Yes, replace it with assigned name 140$: CMP @SP,@R2 ;Is device assigned to 'SY:'? BEQ 230$ ;Yes, he can't remove SY:! MOV SP,R4 ;No, let's check all units of device to remove CALL DVCHK ;Any of its units assigned to SY:? BCS 230$ ;Yes, can't remove it OADDR DEVSTS,R3 ;Point to a work area MOV (SP)+,@R2 ;No, restore original device name .DSTAT R3,R2 ;Get its DSTATUS information BCS 150$ ;Error, just remove device TST 4(R3) ;No - is device loaded? (entry point non-0?) BNE 230$ ;Error if so, can't remove loaded handler 150$: MOV R2,R0 ;Setup for calling DVCHK properly MOV #<$SLOT>,R3 ;Slot counter OINST MOV .$UNAM,R2,* ;Check for logical assigns to dev to remove ADD #<$UNAM1-$UNAM2>,R2 ;Look at $UNAM1 table (perm. name) MOV SP,@<.EXTFL-OVLY>-<.+4-OVLYST>(PC) ;Inhibit CTRL/C 160$: CALL DVCHK ;See if entry matches device to be removed BCC 170$ ;No match CLR $UNAM2-$UNAM1(R2) ;Match - clear $UNAM2 entry CLR (R2)+ ;Clear $UNAM1 entry, bump to next slot 170$: SOB R3,160$ ;Loop to do all slots CLR -(R1) ;Clear $PNAME entry for device CLR $STAT-$PNAME(R1) ;Clear $STAT table entry for device CLR $DVREC-$PNAME(R1) ;Clear $DVREC table entry for device .IF NE OWN$ER MOV R1,R4 ;Copy pointer to $PNAME entry OINST SUB .$PNAM,R4,* ;Calculate slot number ADD R1,R4 ;Add slot number in again for the ... ; ... double-word entries of $OWNER CLR $OWNER-$PNAME(R4) ;Clear the $OWNER table entry CLR $OWNER-$PNAME+2(R4) ; .ENDC ;NE OWN$ER .IF NE UNI$64 CLR $PNAM2-$PNAME(R1) ;Clear the $PNAM2 table entry .ENDC ;NE UNI$64 .IF NE MMG$T MOV SP,HNDREM ;Set handler removed flag MOV #<^r$ >,NAME+2 ;Store $ in second word to denote handler 180$: MOV @#$SYPTR,R4 ;Get start of RMON JSR R5,(R4) ;Return memory to free list NAME: .BLKW 2 ;Two RAD50 words for device name storage BCC 190$ ;Branch if no error BNE 70$ ;If Z bit clear, perm or active region TST HNDREM ;Were we trying to remove a handler region? BNE 190$ ;Yes, no error since there may not be a region ;+ ;ERROR KMRTMG ,, ;- ............ 190$: .ENDC ;NE MMG$T CLR @<.EXTFL-OVLY>-<.+4-OVLYST>(PC) ;Enable CTRL/C 200$: CMPB #<':>,@R5 ;Is it a colon? BNE 210$ ;Branch if no TSTB -(R5) ;Point past it 210$: TSTB @R5 ;End of command? BEQ 220$ ;Branch out if done CALLR 30$ ;Branch back if more to process ............ 220$: RETURN ............ ;+ ;ERROR 230$: KMRTMG ,, ;- ............ .IF EQ MMG$T NAME: .BLKW 2 ;Two RAD50 words for device name storage ............ .ENDC ;EQ MMG$T .DSABL LSB ;+ ; DVCHK - Compare user specified device name against names of devices ; known to system ; ; DVCHK will compare the user supplied name with the system name ; and will also check for units # 0-7. ; ; R2 -> user supplied name (RAD50) or 2-letter equivalent ; R4 -> system name (RAD50) ; ; CALL DVCHK ; ; C=0 => no match ; C=1 => match ;- .ENABL LSB DVCHK: MOV @R4,-(SP) ;Copy device name for comparison CMP @R2,@SP ;Does user specified device match? BEQ 20$ ;Yes ADD #<^r 0>,@SP ;No, put a zero digit into device name CMP @SP,@R2 ;Match now? BHI 10$ ;No ADD #<'7-'0>,@SP ;Maybe. Change the name to xx7 CMP @R2,@SP ;Is user name in range xx0 to xx7? BLOS 20$ ;It matches .IF NE UNI$64 MOV @R4,@SP ;Start over and try 64-unit devices ADD #<^r 00>,@SP ;No, put a zero digit into device name CMP @SP,R0 ;Match now? BHI 10$ ;No MOV @R4,@SP ;Maybe. ADD #<^r 77>,@SP ;Change name to x77 CMP R0,@SP ;Is user name in range x00 to x77? BLOS 20$ ;Ayup .ENDC ;NE UNI$64 10$: TST (PC)+ ;No match, set C=0 and skip the 'SEC' 20$: SEC ;Match, set C=1 MOV R2,(SP)+ ;Clear stack without zapping C bit RETURN ............ .DSABL LSB .ENDC ;NE REMO$$ .IF NE EXEC$$ .SBTTL EXECUTE Command (Part 1) ;+ ; EXECUTE Command ;- .ENABL LSB 10$: OINST MOV CNMPTR,R5,* ;Restore the pointer to the switches OVCMD EXECUTE OINST MOV R5,CNMPTR,,* ;Save pointer to switches for a,b case OVLINK EXEINT ............ .SBTTL EXECUTE Command (Part 3) OVCMD EXE2 OINST MOV .USRBUF,EXEUBF,* ;Get address of LINK line buff in USR MOV EXEUBF,EXEUPT ;Calculate address of LINK positional ADD #,EXEUPT ; options buffer in USRBUF OINST INCB EXEFLG,,* ;Set flag to denote that gone through EXECUTE OINST INCB COMPFL,,* ;Flag in middle of COMPILE class command OINST MOV R5,CSTPTR,,* ;Save text pointer where scan stopped MOV (SP)+,R4 ;Adjust stack for next JSR JSR R4,80$ ;Get PIC pointer to special EXECUTE code MOV R1,-(SP) ;Preserve all used regs besides R0 OINST MOVB EXEDEL,R0,* ;Output a space first time then always a comma OINST MOVB <#<',>>,EXEDEL,,* ;Set for a comma from now on 20$: CMPB #<'[>,R0 ;Don't want file size allocations BEQ 40$ ;Branch if at file size, have enough CALL EXECHR ;Output a new character for the link 30$: MOVB (R1)+,R0 ;Get a byte for LINK string BEQ 30$ ;Skip nulls BPL 20$ ;Pass on the char 40$: MOV EXEUPT,R1 ;Set up a pointer to positional options 50$: MOVB (R1)+,R0 ;Pick up a byte BEQ 60$ ;Branch if thats it CALL EXECHR ;Output the byte BR 50$ ;Loop thru this set ............ 60$: MOV (SP)+,R1 ;Restore regs 70$: RETURN ............ 80$: OINST MOV R4,EXEESC,,* ;Save pointer/flag to escape code ;This is used to pick up object files ;For LINK part of command CALL FIXF77 ;If running F77, change /M to /O ... ; ... if not, remove /Q switch OCALL CMDMAK ;Generate the command text OINST MOV .USRBUF,EXEUBF,* ;Get address of LINK line buff in USR MOV EXEUBF,EXEUPT ;Calculate address of LINK positional ADD #,EXEUPT ; options buffer in USRBUF OINST TSTB @CSTPTR,,* ;Are we at the end of the line? BNE 10$ ;Continue processing this command OINST TSTB RUNFLG,,* ;Was /NORUN specified? BNE 110$ ;Branch if yes MOV (SP)+,R1 ;Adjust sp for next JSR JSR R1,100$ ;Form PIC pointer to /RUN .ASCIZ "/RU" ;Bytes for /RUN option ............ 90$: CALL EXECHR ;Output the byte 100$: MOVB (R1)+,R0 ;Get a byte BNE 90$ ;Insert it in LINK command 110$: CLR R0 ;End LINK string with a null CALL EXECHR ;Insert it MOV EXEUPT,R1 ;Point to LINK string OADDR KMCBUF,R5 ;Point to KMON's line buffer MOV R5,R0 ;Make work copy 120$: MOVB -(R1),-(R0) ;Now copy line to resident part of KMON BNE 120$ ;Branch until end of line CLRB -(R0) ;One more so identical to keyboard input OCALLR CMDREC ;Jump into the KMON to do the LINK ............ ;+ ; Used to save chars in the new string for the LINK phase ; Destroys R0 which is input char ;- EXECHR: MOV EXEUBF,R2 ;Point to the LINK line OINST ADD EXEPTR,R2,* ;Adjust pointer to current insert point MOVB R0,@R2 ;Insert the text byte OINST DECB EXEPTR,,* ;Bump pointer BGE 70$ ;Return 130$: OCALLR TCERR ;We can't handle the translation ............ .DSABL LSB ;+ ; FIXF77: This routine is provided to handle exceptions that must be ; made for FORTRAN 77 to be added to the EXECUTE command. ; ; If FORTRAN 77 is being used, /M:val in the ; switch table must be changed to /O. ; If FORTRAN 77 someday adds a /M switch, this will ; have to be changed. ; ; If FORTRAN 77 is not being used, /Q in the ; switch table must be removed. ; If another compiler someday adds a /Q switch, this ; will have to be changed. ; ; These special situations are handled here because ; of the limitations of 37 action routine numbers. ; ; This routine is duplicated in part (/M -> /O) in the COMPILE ; overlay. If changes are made here, they should be also be made there. ;- .ENABL LSB FIXF77: OINST MOV FORCEP,R0,*, ;Check to see what cusp will be used BIC #^c,R0 ;Isolate cusp number CMPB #<$$F77>,R0 ;Is it F77? BNE 20$ ;No, branch MOVB #<'M>,R3 ;Did we use /M ? OCALL FDSWIT ;Find it, it's wrong BCS 10$ ;Didn't find it, nothing to worry about MOVB #<'O>,-(R2) ;Change it to /O for F77s 10$: RETURN ............ 20$: MOVB #<'Q>,R3 ;Did we use /Q ? OCALL FDSWIT ;See if it's there BCS 10$ ;It isn't, return OCALL REMSWT ;It is, remove it CLC ;Clear for return RETURN ............ .DSABL LSB .SBTTL EXECUTE Overlay II OVERLAY ;+ ; EXECUTE COMMAND INTERPRETER ; ; This overlay is called by the EXECUTE overlay. It calls the ; DCL command interpreter in KMON to parse the DCL command ; according to the SYNTAX given below. ;- SYNTAX EXECUTE SCALL GSWIT,<1> FLDBEG EXEC1 TSTCFLG OPTEND REQCOMMA GOTO EXEC2 ............ EXEC1: PROMPT $FILE REQBLNK EXEC2: FILQUAL INSPEC SAVNAM SCALL GSWIT,<1,2> FLDBEG REQPLUS SCALL RINSPC,<1,2> ITEREND MAKOFL FOTYP MAKOFL SOTYP CNDROUT FRT,FRT FILTYPR $COMPSTR CEOLSEQ FORTRAN,FORTRAN COMPDEF .IF EQ MMG$T APLYDEF F77,NMS,S APLYDEF F77,WRP,W .IFF ;EQ MMG$T APLYDEF F77XM,NMS,S APLYDEF F77XM,WRP,W .ENDC ;EQ MMG$T APLYDEF FORTRAN,NMS,S APLYDEF DICOMP,NMS,O APLYDEF FORTRAN,WRP,W APLYDEF DICOMP,WRN,W END ............ SWITS EXECUTE SWIT SHOW 1 - - L,,VAL SWIT LINENUMBERS 1 - - - SWIT SWAP 1 - - - SWIT VECTORS 1 FORTRA - - SWIT OPTIMIZE 1 FORTRA - P,,VAL SWIT WARNINGS 1 - - - WRP SWIT RUN 1 - - - ENDNO SWIT MACRO 1 - MACRO - SWIT DIBOL 1 - DICOMP - SWIT FORTRAN 1 - - - FRT SWIT F4 1 - FORTRA - SWIT F77 1 - F77 - SWIT TRACE 1 F77 - S,,VAL SWIT CHECK 1 F77 - I SWIT WORKFILES 1 F77 - F,,DVAL SWIT CONTINUATIONS 1 F77 - C,,DVAL SWIT OBJECT 1 - - FOT SWIT LIST 1 - - SOT SWIT ENABLE 1 MACRO - E,,VAL SWIT DISABLE 1 MACRO - D,,VAL SWIT CROSSREFERENCE 1 - - C,,VAL SWIT ALPHABETIZE 1 DICOMP - A SWIT LOG 1 DICOMP - G SWIT PAGE 1 DICOMP - P,,DVAL SWIT TABLES 1 DICOMP - S SWIT ONDEBUG 1 - - D SWIT EXTEND 1 - - E SWIT STATISTICS 1 - - A SWIT UNITS 1 - - N,,DVAL SWIT HEADER 1 FORTRA - O SWIT CODE 1 FORTRA - I,,VAL SWIT DIAGNOSE 1 FORTRA - B,,VAL SWIT RECORD 1 - - R,,DVAL SWIT I4 1 - - T SWIT LIBRARY 2 MACRO - M SWIT PASS 2 MACRO - P,,DVAL SWIT ALLOCATE 1 - - ALL SWIT PROMPT 1 - - LNK SWIT WIDE 1 - - WID SWIT BOTTOM 1 - - LNK SWIT LINKLIBRARY 1 - - LNK SWIT DEBUG 1 - - LNK SWIT EXECUTE 1 - - LNK SWIT MAP 1 - - LNK SWIT DUPLICATE 1 - - LNK SWIT GLOBAL 1 - - LNK NOS SWIT NOSHOW 1 MACRO - N,,VAL SWIT NOLINENUMBERS 1 - - - NMS SWIT NOSWAP 1 - - U SWIT NOVECTORS 1 FORTRA - V SWIT NOOPTIMIZE 1 - - M,,VAL SWIT NOWARNINGS 1 - - - WRN SWIT NORUN 1 - - NOR ENDS ............ .SBTTL EXECUTE Command (Part 2) .ENABL LSB OVCMD EXEINT OINST MOV .USRBUF,R2,* ;Get the USR buffer address MOV #,R3 ; .ADDR #,R1 ;Move the USR buffer to the EXELBF buffer 10$: MOVB (R2)+,(R1)+ ; for safe keeping in case there is a .LOOKUP SOB R3,10$ ; performed as part of INITIT CLRB EXEOPT ;No LINK positional options yet ITBLE 9. OCALL INITIT ;Parse DCL command CLR @<.BLKEY-OVLY>-<.+4-OVLYST>(PC) ;Let the rest know we're ;changing USRBUF contents OINST MOV .USRBUF,R2,* ; MOV #/2,R3 ; .ADDR #,R1 ;Move the EXELBF and EXEOPT buffer contents 20$: MOV (R1)+,(R2)+ ; to the USR buffer for use by the EXECUTE SOB R3,20$ ; overlay OVLINK EXE2 ............ EXELSZ = 120. ;Line size allowed for built link commnd EXELPT = 59. ;Buffer size for postional options ;+ ; Used to save chars in the new string for the link phase. ; Destroys R0 which is input char. ;- EXECR: JSR R0,30$ EXELBF: .BLKB EXELSZ ;Buffer in which to build LINK command .ASCII "KNIL" ;"LINK" is here to get us started EXEOPT: .BLKB EXELPT ;Buffer for linker positional options EXEND: .BYTE 0 ............ 30$: OINST ADD EXEPTR,R0,* ;Point into line at current insert point MOVB (SP)+,@R0 ;Insert the text byte OINST DECB EXEPTR,,* ;Bump pointer BGE 90$ ;Return 40$: OCALLR TCERR ;We can't handle the translation ............ ;+ ; EXECUTE/WIDE must produce /Q for the FORTRAN 77 compiler in ; addition to the /WIDE LINK switch. Assume for now that we'll ; be using the FORTRAN 77 compiler. ;- OVAWID: CLR R3 ;Indicate switch doesn't take a value CLR R1 ;Clear for routine call MOVB #<'Q>,R2 ;Set up to add /Q compiler switch OCALL ESWIT ;Enter swit & return to add linker /WIDE swit ;+ ; EXECUTE interface to handle LINKER options ;- OVALNK: INC R5 ;Bump back to before delimiter 50$: CMPB #<'/>,(R5)+ ;Find the start of the option BNE 50$ ;Branch till there MOVB -(R5),R0 ;Get the '/' 60$: OINST TSTB QUALFL,,* ;Is this file or command option? BEQ 70$ ;Branch if command qualifier OINST MOVB EXEPT2,R1,* ;Get pointer into temporary option list CMPB #,R1 ;Check for end of list BLE 40$ ;Branch if overrun .ADDR #,R1,ADD;Form PIC pointer MOVB R0,(R1)+ ;Put in the byte CLRB @R1 ;Use zero byte as end of list indicator OINST INCB EXEPT2,,* ;Bump to next slot BR 80$ ;Loop thru rest of option ............ 70$: OINST TSTB COMPFL,,* ;Is this the first time? BNE 80$ ;Branch if not, we already got these CALL EXECR ;Output the linker option on LINK text 80$: MOVB -(R5),R0 ;Get the char into R0 BEQ 90$ ;Branch if at end of line CMPB #<'/>,R0 ;At a new option? BEQ 90$ ;Branch if yes CMPB #<' >,R0 ;At end of option? BEQ 90$ ;Branch if yes CMPB #<',>,R0 ;At a new filespec? (can't be on EXEC!) BEQ 90$ ;Branch if yes CMPB #<'+>,R0 ;New filespec? (also only in filespecs) BNE 60$ ;Branch if not to copy option char 90$: RETURN ;Return with R5 past LINKER option ............ EXEUPT: .WORD 0 ;Pointer to positional options buffer ... EXEUBF: .WORD 0 ; ... and LINK command buffer within USRBUF .DSABL LSB .SBTTL EXECUTE Option Text Table ;+ ; Option Text Table for the EXECUTE Command ; ; If any changes are made here, they should also be made (if needed) to ; the copies of this table in the MACRO/DIBOL and FORTRAN/COMPILE overlays. ;- .IRP NUM,<\$OPTX> OPTX'NUM:: .ENDR .BYTE -1 .DSABL CRF $SCNT=0 SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF
FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT .EVEN .ENABL CRF NEXTL ............ .ENDC ;NE EXEC$$ .ENDC ;NE EXEC$$!REMO$$ .IF NE LIBR$$!LINK$$!LNK$IF .SBTTL LINK/LIBRARY Overlay OVERLAY .IIF EQ LNK$IF, .NLIST .IF NE LNK$IF OVCMD LAT1 CALLR LAT1A ............ OVCMD LAT2 CALLR LAT2A ............ .ENDC ;NE LNK$IF .IIF EQ LNK$IF, .LIST .IF NE LINK$$ .SBTTL LINK Command ;+ ; LINK Command ;- SYNTAX LINK SCALL GSWIT,<1> PROMPT $FILE REQBLNK FILQUAL INSPEC SAVNAM SCALL GSWIT,<1> FLDBEG REQCOMMA SCALL RINSPC,<1> ITEREND MAKOFL FOTYP MAKOFL SOTYP MAKOFL TOTYP EOLSEQ LINK END ............ SWITS LINK SWIT EXECUTE 1 - - FOT SWIT BITMAP 1 - - - ENDNO SWIT MAP 1 - - SOT SWIT SYMBOLTABLE 1 - - TOT SWIT LIBRARY 1 - - FIN SWIT LINKLIBRARY 1 - - FIN SWIT DEBUG 1 - - DEB SWIT RUN 1 - - NOR SWIT INCLUDE 1 - - I SWIT FOREGROUND 1 - - R,,VAL SWIT FILL 1 - - Z,,VAL SWIT WIDE 1 - - W SWIT SLOWLY 1 - - S SWIT LDA 1 - - L SWIT STACK 1 - - M,,VAL SWIT BOTTOM 1 - - B,,VAL SWIT TRANSFER 1 - - T,,VAL SWIT EXTEND 1 - - E,,VAL SWIT ROUND 1 - - U,,VAL SWIT BOUNDARY 1 - - Y,,VAL SWIT ALPHABETIZE 1 - - A SWIT TOP 1 - - H,,VAL SWIT ALLOCATE 1 - - ALL SWIT PROMPT 1 - - / SWIT XM 1 - - V,,VAL SWIT GLOBAL 1 - - N SWIT DUPLICATE 1 - - D SWIT LIMIT 1 - - K,,DVAL SWIT IDSPACE 1 - - J NOS SWIT NOEXECUTE 1 - - NOO SWIT NOBITMAP 1 - - X ENDS ;Switch ID list for LINK ............ .ENABL LSB OVCMD LINK ITBLE 9. ;Max of 6 in, 2+1 out filespecs to LINK OCALL INITIT ;Parse the command OINST INCB LNKFLG,,* ;Flag this as a language type command OINST TSTB RUNFLG,,* ;Do we force a RUN? BNE 10$ ;Branch if yes OCALLR CMDEXE ;Generate the command text and execute it ............ 10$: OINST CLRB EXEFLG,,* ;Reset EXECUTE flag CALL 40$ ;Get PIC address of following code MOV R1,-(SP) ;Need to preserve all but R0 MOV R2,-(SP) ; .ADDR #,R0 ;Place to store save file name 20$: MOVB (R1)+,R2 ;Get a byte BEQ 20$ ;Throw away nulls BMI 30$ ;Branch if have whole name CMPB #<'[>,R2 ;Don't want file size part of name BEQ 30$ ;Branch if have part of name we want MOVB R2,(R0)+ ;Save byte of save file name for later BR 20$ ;Loop till we have the whole thing ............ 30$: CLRB @R0 ;Make string ASCIZ for later MOV (SP)+,R2 ;Restore regs MOV (SP)+,R1 RETURN ............ 40$: OINST MOV (SP)+,EXEESC,,* ;Save pointer/flag to escape code ;This is used to pick up the save file OCALL CMDMAK ;Generate the LINK command .ADDR #,R1 ;Now figure out length of RUN chars CLR R0 ;For call to DCLSPC 50$: INC R0 ;Keep count for DCLSPC TSTB (R1)+ ;It's ASCIZ BNE 50$ ;Branch till end OCALL DCLSPC ;Ask for the space, we may move! .ADDR #,R0 ;Get address of RUN text again 60$: MOVB (R0)+,(R1)+ ;Move a byte, also the 0 for end of line BNE 60$ ;Branch till all there OCALLR STRT ;Now execute the stream of commands ............ RUNCMD: .ASCII "RUN " ;Text for RUN LNKSAV: .BLKB 16. ;Maximum size EXECUTE file name .EVEN .DSABL LSB .SBTTL LINK Command Action Routines ;+ ; Action Routine for /DEBUG[:FILESPEC] on LINK command ;- .ENABL LSB OVADEB: OCALL MULSZI ;Get pointer to next free file slot MOV R0,R1 ;Save it OADDR FILST,R2 ;Address of where to stop moving ADD #,R1 ;Point to end of unused slot BR 20$ ;Check for at begining of table ............ 10$: MOVB -(R0),-(R1) ;Move up a byte 20$: CMP R0,R2 ;Are we at begining of table? BNE 10$ ;Branch if not to continue moving ;Now R0 points to first entry and ;All others are moved up CLR R1 ;Flag as regular input spec CMPB #<':>,@R5 ;Is there a value? BEQ 30$ ;Branch if yes to accept as debuger name MOV R5,-(SP) ;Save scan pointer OADDR DUMYNM,R5 ;Point to ODT filename string as default OCALL INSPC1 ;Process as file name MOV (SP)+,R5 ;Restore scan pointer RETURN ............ 30$: OCALLR INSPC1 ;Get debugger name and return from there ............ .DSABL LSB .ENDC ;NE LINK$$ .IIF EQ LINK$$,.LIST .IF NE LIBR$$ ;If LIBRARY command (for next page) .SBTTL LIBRARY Command ;+ ; LIBRARY Command ;- SYNTAX LIBRARY .ASSUME $QUAL LT 50, MESSAGE=<$QUAL 50 too small> $QUAL = 50 SCALL GSWIT,<1> PROMPT $LIBR REQBLNK ROUTINE FIC FILQUAL INSPEC SAVNAM SCALL GSWIT,<1> CMDQUAL PROMPT $FILEE CNDROUT FIL,EXT PROMPT $FILE CNDROUT FIL,CRL CNDROUT FIL,INL FLDBEG LIBR1 REQBLNK SCALL RINSPC,<1,2> OPTEND FLDBEG REQCOMMA SCALL RINSPC,<1,2> ITEREND LIBR1: CNDROUT EXT,EXT CNDROUT CRL,CRL MAKOFL SOTYP ROUTINE LST EOLSEQ LIBR END ............ SWITS LIBRARY SWIT OBJECT 1 - - FOT ENDNO SWIT INSERT 1 - - - INL SWIT DELETE 1 - - D SWIT REMOVE 1 - - G SWIT CREATE 1 - - - CRL SWIT LIST 1 - - SOT SWIT MACRO 1 - - MAC,,DVAL SWIT EXTRACT 1 - - - EXT SWIT ALLOCATE 1 - - ALL SWIT PROMPT 1 - - / SWIT REPLACE 2 - - R SWIT UPDATE 2 - - U NOS SWIT NOOBJECT 1 - - NOO ENDS ;Switch ID list for LIBRARY ............ OVCMD LIBRARY ITBLE 9. ;Max of 6 in, 2+1 out filespecs to LIBR OCALL INITIT ;Parse the command OINST INCB LNKFLG,,* ;Flag this as a LANGUAGE type command OCALLR CMDEXE ;Generate the command text and execute it ............ .SBTTL LIBRARY Command Action Routines ;+ ; Action Routine to Eliminate Library from Inputs on /CREATE ;- OVACRL: CALL FNDIN ;Make operation create by not CLRB @R1 ;passing 1st input which is library RETURN ............ ;+ ; Action Routine to Force /MACRO to do /CREATE ;- OVAMAC: OINST BISB #<$CRL50>,DEFMSK,,* ;Set CREATE specified MOVB #<'M>,R2 ;Set up to simulate /M switch OCALLR ESWIT ;Return to switch processor to exit ............ ;+ ; Action Routine associated with EXTRACT option ;- .ENABL LSB OVAEXT: CALL FNDIN ;Make secondary input -> output on /EXT CALL FNDIN2 ;Now find the second input BNE 10$ ;No 2nd input, must be /OBJ:FILE, o.k. MOVB #,@R1 ;Set it to an output 10$: OINST INCB FOTFLG,,* ;Turn off default object file generation MOVB #<'E>,R2 ;Set up to force RT11 LIBR E switch CLR R1 ;Some flag setting for routine to call CLR R3 ;Some more OCALLR ESWIT ;Call routine to insert switch ............ .DSABL LSB .ENABL LSB FNDIN: OADDR FILST+STFLG-FSIZ,R1 ;Point to filespecs list OINST MOVB FILNUM,R2,* ;Get number of filespecs to look at FNDIN2: DECB R2 ;At end of list? BMI 10$ ;Branch if yes, Z=0 ADD #,R1 ;Like at the type fields on the files CMPB #,@R1 ;Is this an input file? BNE FNDIN2 ;Branch if no to keep looking 10$: RETURN ;Return with Z set for success ............ .DSABL LSB ;+ ; Special code to default command with no /OPTION to /INSERT ;- .ENABL LSB OVAFIC: OINST TSTB SCNTFL,,* ;Were any options given? BNE 10$ ;Branch if there was an option OINST BISB #<$INL50>,DEFMSK,,* ;Set default of /INSERT 10$: RETURN ............ .DSABL LSB ;+ ; Action routine to Force Prompt for Files if CREATE, EXTRACT, or INSERT ;- OVAFIL: OCALLR REQBLNK ;Is there a blank? (means more text) ............ ;This could really be REQBLNK directly ;>>> Is this instruction really neccessary????? BR LOB ;Go set up listing file defaults ............ ;+ ; Special code to avoid new copy of LIBRARY when just /LIST ;- OVALST: OINST CMPB SCNTFL,#<1>,* ;Was there exactly 1 switch? BNE LOB ;Branch if not OINST TSTB SOTFLG,,* ;Did we generate a listing? BMI LOB ;Branch if not, option wasn't /LIST OINST INCB FOTFLG,,* ;Prevent default object libr generation .BR LOB ............ ;+ ; Special code to replace 'MAKOFL' subroutine to accomplish ; Library oriented defaults for the output file ;- .ENABL LSB LOB: OINST TSTB FOTFLG,,* ;Did we generate an output file already? BNE 20$ ;Branch if yes MOV R5,-(SP) ;Save current text pointer for later OADDR DUMYNM,R5 ;Point to a dummy file name OCALL OUTSPEC ;Create a correctly defaulted out spec MOV (SP)+,R5 ;Restore the text pointer MOV R0,R1 ;Make copy of pointer to file spec SUB #,R1 ;Point to the start of it OADDR SAVNM,R3 ;Point to saved library file name ;To use as default output file MOV (R3)+,(R1)+ ;Move in used device name MOV (R3)+,(R1)+ ;Both words OINST MOV FOTDV1,R2,* ;Is there a default output device? BEQ 10$ ;Branch if not MOV R2,-4(R1) ;Override the inputs device for output OINST MOV FOTDV2,-2(R1),* ;Override default 10$: MOV (R3)+,(R1)+ ;Take default output MOV (R3)+,(R1)+ ;File name same as this MOV (R3)+,(R1)+ ;Input file spec name MOV (R3)+,(R1)+ ;And copy the file type MOV (R3)+,(R1)+ ;Both words MOVB #,-(R0) ;Setup as primary output spec 20$: RETURN ............ .DSABL LSB .ENDC ;NE LIBR$$ .IIF EQ LNK$IF, .NLIST ;(for next page) .IF NE LNK$IF .SBTTL LAT1A - LINK Overlay Indirect File Support (Part 1) ;+ ; LAT1A ; ; Used to process Indirect Command File which contains overlay commands ; (CSI lines) for the DCL LINK command. When this routine is called there ; is a command line in the KMON's commmand buffer (KMCBUF) which cannot be ; destroyed. This line is slid down to the end of KMCBUF (& KMCBUF'S size ; appropriately shortened) so that KMCBUF can be used to expand the command ; file. If (Size of a Line in the Command File + Size of Saved Line) exceeds ; Size of KMCBUF, it is just like user typed a line which was too long to ; fit in KMCBUF. Once the overlay command file lines have been expanded and ; stored, the saved command line is moved to the beginning of the command ; buffer and control returns to DCL to finish processing the LINK. ; ; Call R0 - > @file spec. from LINK command. ; CALL LINKAT ; ; Return R0 = # of bytes KMON has moved ; Do "SUB R0,X" to relocate X ; R5 -> start of KMCBUF ; ; All regs. USED and NOT SAVED. ; ; The bit IFLIF in STATWD indicates that we are processing this type of ; @File, and causes some changes in the normal indirect file processing. ; Notably, these indirect file lines are not echoed, and they are stored ; in the DCL/@File buffer above the USR as if DCL generated them, rather ; than as if they were @File lines. This is done in the SCNDUN routine ; where DCLSP1 is called but ATFLG is not set if IFLIF is set in STATWD. ;- .ENABL LSB LAT1A: MOV (SP)+,R0 ;Get saved R0 OADDR KMCBUF,R5 ;Point to KMON line buffer MOV R5,R1 ;Copy pointer MOV R5,R3 ;Calculate end addr. of buffer ADD #,R3 10$: TSTB -(R5) ;Is this end of command line in buffer? BNE 10$ ;If NE, no 20$: MOVB (R5)+,(R3)+ ;Yes - move line to end of buffer CMP R5,R1 ;Done? BNE 20$ ;If NE, no OINST MOV R3,OLDLIN,,* ;Yes - save ptr to begin of old line MOV R1,-(SP) ;Calculate space left in buffer SUB R3,@SP ;(Begin of bfr - Begin of old line) MOV @SP,R1 ;Save count OINST MOV (SP)+,KBFLN,,* ;Also save as new KMON line bfr size OINST BIS #,@.STATWD,,* ;Set bit, processing LINK overlay @file OINST CLR ACCUM,,* ;Clr loc used to accumulate size of KMON moves DEC R1 ;Any room? BMI 60$ ;If MI, no room left MOVB #<'@>,-(R5) ;Yes, move in @ for indirect file spec. 30$: DEC R1 ;Now move LINK @File spec. to command bfr BMI 60$ ;If MI - no room left MOVB (R0)+,-(R5) ;R0 pts to @file spec - move to KMCBUF BMI 40$ ;If MI - end of @file spec BNE 30$ ;If NE - keep going CMPB (R1)+,(R5)+ ;Null byte: adjust count, pointer to ignore it BR 30$ ;Proceed ............ 40$: CLRB (R5)+ ;Done - end with a null byte OADDR KMCBUF,R5 ;Point to start of @file spec OCALLR LNKAT1 ;Back to root to expand @file ............ .SBTTL LAT2A - LINK Overlay Indirect File Support (Part 2) ;+ ; Continue LINK @file process ;- LAT2A: MOV (SP)+,R0 ;Restore R0 (saved across LINK) SUB R0,@SP ;Done expanding @file - relocate rtn address OADDR KMCBUF,R5 ;Point to KMCBUF OINST MOV OLDLIN,R3,* ;Point to saved command line SUB R0,R3 ;Relocate pointer 50$: MOVB -(R3),-(R5) ;Restore old command line to start of buffer BNE 50$ ;If NE - more to move OADDR KMCBUF,R5 ;Point to KMCBUF RETURN ............ 60$: OCALLR LTL ;Line too long-invalid command ............ .DSABL LSB .ENDC ;NE LNK$IF .IIF EQ LNK$IF, .LIST .SBTTL LIBRARY/LINK Option Text Table ;+ ; Option Text for LINK, LIBRARY Command(s) ;- .IRP NUM,<\$OPTX> OPTX'NUM:: .ENDR .BYTE -1 .DSABL CRF $SCNT=0 SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT .EVEN .ENABL CRF NEXTL ............ .ENDC ;NE LIBR$$!LINK$$!LNK$IF .IF NE BACK$$!SHOW$$ .SBTTL BACKUP/SHOW Overlay OVERLAY .IF NE BACK$$ ;If BACKUP command OVCMD BACKUP CALLR BAC1 ............ .ENDC ;NE BACK$$ .IF NE SHOW$$ ;If SHOW command .SBTTL SHOW Command ;+ ; SHOW Command ;- SYNTAX SHOW FLDBEG SHOWA SCALL GSWIT1,<1> OPTEND GOTO SHOWB ............ SHOWA: SETSWIT L EOLSEQ RESORC SHOWB: END ............ SWITS SHOW ENDNO SWIT ALL 1 - RESORC A SWIT CACHE 1 - RESORC B SWIT COMMANDS 1 - UCL - SWIT CONFIGURATION 1 - RESORC Z SWIT DEVICES 1 - RESORC DEV SWIT ERRORS 1 - ERROUT - SWIT JOBS 1 - RESORC J SWIT MEMORY 1 - RESORC X SWIT QUEUE 1 - RESORC Q SWIT SUBSET 1 - RESORC S SWIT TERMINALS 1 - RESORC T SWIT UMR 1 - RESORC R SWIT USERS 1 - RESORC U NOS ENDS ............ .ENABL LSB OVCMD SHOW TSTB @R5 ;SHOW typed? BEQ 10$ ;Yes CMPB @R5,#<' > ;Space? BNE 20$ ;Yes, repace with "/" MOVB #<'/>,@R5 ;Stuff slash into input line 10$: ITBLE 1 ;Set max # of file specs OCALL INITIT ;Do the parse OINST MOV FORCEP,R0,* ;Get the forced program BIC #^c,R0 ;Isolate the cusp to run CMPB #<$$ERRO>,R0 ;Is it ERROUT ? BEQ SHWERR ;Yes continue with ERRORS options CMPB #<$$UCL>,R0 ;Is it UCL? BEQ SHWCMD ;Branch if yes TSTB @R5 ;End of line ? BEQ 30$ ;Yes then execute command 20$: OCALLR BADCOM ;Invalid command ............ 30$: OCALLR CMDEXE ;Execute the command ............ OVADEV: CMPB #<':>,@R5 ;Is there a colon? BNE 40$ ;Branch if not ;;; OINST MOVB #<1>,NOSPEC,,* ;Set spec number to 1 OCALL INSPEC ;Store input device name 40$: MOVB #<'D>,R2 ;Set up to force /D switch CLR R1 ;Some flag setting for routine to call CLR R3 ;Some more OCALLR ESWIT ;Call routine to insert switch ............ .DSABL LSB .SBTTL SHOW (Primary) Option Text Table ;+ ; Option Text for SHOW Primary Commands ;- .IRP NUM,<\$OPTX> OPTX'NUM:: .ENDR .BYTE -1 .DSABL CRF $SCNT=0 SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT .EVEN .ENABL CRF NEXTL ............ .SBTTL SHOW COMMANDS Command ;+ ; SHOW COMMANDS Command ;- SYNTAX SHWCMD SCALL GSWIT,<1> DEFOSPC $TTSPC EOLSEQ UCL END ............ SWITS SHWCMD ENDNO SWIT PRINTER 1 UCL - PRI SWIT TERMINAL 1 UCL - TER SWIT OUTPUT 1 UCL - OUT NOS ENDS ............ SHWCMD: ITBLE 2 ;Set the maximum number of filespecs OCALL INITIT ;Do the parse OCALLR CMDEXE ;Generate the command text and execute it ............ .SBTTL SHOW COMMANDS Option Text Table ;+ ; Option text for SHOW COMMANDS ;- .IRP NUM,<\$OPTX> OPTX'NUM:: .ENDR .BYTE -1 .DSABL CRF $SCNT=0 SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT .EVEN .ENABL CRF NEXTL ............ .SBTTL SHOW ERRORS Command ;+ ; SHOW ERRORS ;- SYNTAX SHWERR SCALL GSWIT,<1> DEFOSPC $TTSPC EOLSEQ ERROUT END ............ SWITS SHWERR ENDNO SWIT ALL 1 ERROUT - A SWIT SUMMARY 1 ERROUT - S SWIT FROM 1 ERROUT - F,,DVAL SWIT TO 1 ERROUT - T,,DVAL SWIT PRINTER 1 ERROUT - PRI SWIT TERMINAL 1 ERROUT - TER SWIT OUTPUT 1 ERROUT - OUT SWIT FILE 1 ERROUT - ELF NOS ENDS ............ .ENABL LSB SHWERR: ITBLE 3 ;Set the max number of filespecs CLR ELINSP ;Indicate no input spec yet OCALL INITIT ;Do the parse OINST CMPB FILNUM,#<3>,* ;Max of three specs BNE 10$ ;No, nothing to worry about TST ELINSP ;At least one must be an input spec BNE 10$ ;Everything's in order OCALLR CNFSWT ;Conflicting options ............ 10$: OCALLR CMDEXE ;Generate the command text and execute it ............ .DSABL LSB .ENABL LSB OVAELF: CMPB #<':>,@R5 ;Is there a :? BNE 10$ ;No, ignore option OCALL INSPEC ;Get the input file spec INC ELINSP ;We've got an input spec 10$: RETURN ............ ELINSP: .WORD 0 ;Error log input spec indicator .DSABL LSB .SBTTL SHOW ERRORS Option Text Table ;+ ; Option Text for SHOW ERRORS ;- .IRP NUM,<\$OPTX> OPTX'NUM:: .ENDR .BYTE -1 .DSABL CRF $SCNT=0 SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT .EVEN .ENABL CRF NEXTL ............ .ENDC ;NE SHOW$$ .IF NE BACK$$ ;If BACKUP command .SBTTL BACKUP ;+ ; BACKUP command ;- SYNTAX BACKUP PROMPT $FROM SCALL GSWIT,<1,2> REQBLNK SCALL SPISPC,<1,2> FLDBEG SCALL CSPISPC,<1,2> ITEREND DEFILE FSTARF PROMPT $TO ROUTINE CTO GOTO BACK2 ............ SCALL SPOSPC,<1> BACK2: EOLSEQ BUP END ............ SWITS BACKUP SWIT LOG 1 - - - SWIT REWIND 1 - - - SWIT SCAN 1 - - - SWIT QUERY 1 - - - ENDNO SWIT DEVICE 1 - - I SWIT RESTORE 1 - - X SWIT VERIFY 1 - - V,,VAL SWIT FILES 1 - - F SWIT INITIALIZE 1 - - Z SWIT SAVESET 1 - - S SWIT ONLY 1 - - O,,DVAL SWIT SUBSET 1 - - R SWIT SYSTEM 1 - - E SWIT OUTPUT 2 - - TOT SWIT DIRECTORY 2 - - 1 SWIT PRINTER 2 - - 2 NOS SWIT NOLOG 1 - - W SWIT NOREWIND 1 - - M SWIT NOSCAN 1 - - G SWIT NOQUERY 1 - - Y ENDS ............ BAC1: ITBLE 7 ;Set maximum number of file specs OCALL INITIT ;Do the parse OCALLR CMDEXE ;Generate the command text and execute it ............ ;+ ; Action Routine to handle /DIRECTORY, does the following - ; ; 1) If /PRINT and /DIRECTORY were given, make LP: the third filespec. ; 2) If /DIRECTORY was given alone, make TT: the third filespec. ; 3) If /DIRECTORY and /OUTPUT were given and there was no filespec given, ; make TT: the third filespec. ; 4) If /DIRECTORY and /OUTPUT:fs were given, fs will be the third filespec. ; 5) If any of the above conditions are true, bump the syntax stack pointer ; to skip the output file prompt. ;- .ENABL LSB OVACTO: MOVB #<'2>,R3 ;Was /PRINT given? OCALL FDSWIT ;Check the switch table for it BCS 10$ ;No MOV R4,-(SP) ;Save R4 across the ACTPRI call OCALL REMSWT ;If yes remove the swtch from table CALL 20$ ;Check to make sure that /DIRECTORY was given OCALL ACTPRI ;Create default LP: output filespec MOVB #,-(R0) ;Mark it as the third output filespec MOV (SP)+,R4 ;Restore R4 OINST TSTB TOTFL2,,* ;Check to see if we have a /OUTPUT filespec BNE 70$ ;Yes, error RETURN ;Return and skip the TO? prompt ............ 10$: OINST TSTB TOTFLG,,* ;Do we need to generate the default? ; ... (i.e., Have we gotten an output ... ; ... /OUTPUT but no file specified?) BNE 30$ ;No CALL 20$ ;Check to make sure that /DIRECTORY was given OINST TST TOTDV1,,* ;Was a device name argument given? BEQ 50$ ;No, default to TT: MOV R5,-(SP) ;Save command pointer OADDR DUMYNM,R5 ;Use a dummy file name OCALL OUTSPEC ;Build an output filespec using ... ; ... device name given on /OUTPUT option MOV (SP)+,R5 ;Restore command pointer OINST MOV TOTDV1,-FSIZ(R0),* ;Put in saved device name OINST MOV TOTDV2,-FSIZ+2(R0),* ; CLR FNMFLD-FSIZ(R0) ;Clear dummy filename out of spec CLR FNMFLD-FSIZ+2(R0) ; CLR FNMFLD-FSIZ+4(R0) ; MOVB #,-(R0) ;Change the type to specify the third outspec RETURN ;Yes, return and skip TO? prompt ............ 20$: MOVB #<'1>,R3 ;Was /DIRECTORY given? OCALL FDSWIT ;See if switch is in table BCS 60$ ;No, error MOV R4,-(SP) ;Save R4 across the ACTPRI call OCALL REMSWT ;If yes, remove the switch from table MOV (SP)+,R4 ;Restore R4 RETURN ............ 30$: OINST TSTB TOTFL2,,* ;Check to see if we have a /OUTPUT filespec BNE 20$ ;Yes, check to see if we got /DIRECTORY too MOVB #<'1>,R3 ;Was /DIRECTORY given without /OUT or /PRI? OCALL FDSWIT ;See if switch is in table BCS 40$ ;Nope, no directory is being specified MOV R4,-(SP) ;Save R4 across the ACTPRI call OCALL REMSWT ;If yes, remove the switch from table MOV (SP)+,R4 ;Restore R4 BR 50$ ;Default to TT: ............ 40$: CMPB (R4)+,(R4)+ ;No, bump interp ptr past GOTO for TO? prompt RETURN ............ 50$: MOV R4,-(SP) ;Save R4 across the call to ACTTER OCALL ACTTER ;Create default TT: output filespec MOVB #,-(R0) ;Mark it as the third output filespec MOV (SP)+,R4 ;Restore R4 RETURN ;Return and skip TO? prompt ............ 60$: OCALLR ILSWIT ;"Invalid switch" error ............ 70$: OCALLR CNFSWT ;"Conflicting options" error ............ .DSABL LSB .SBTTL BACKUP Option Text Table ;+ ; Option table for BACKUP ;- .IRP NUM,<\$OPTX> OPTX'NUM:: .ENDR .BYTE -1 .DSABL CRF $SCNT=0 SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT SWTDEF FLGTXT .EVEN .ENABL CRF NEXTL ............ .ENDC ;NE BACK$$ .ENDC ;NE BACK$$!SHOW$$ .SBTTL GET (Part 2)/REENTER/START Overlay OVERLAY ;+ ; AT2 - Continuation of ATSCAN routine. ; ; OVCMD AT2 is located here because the table codes require OVCMD labels ; to be in first block of overlay. ;- OVCMD AT2 JMP AT2BEG ;Branch immediately to support code .............. .ENABL LSB .IF NE REEN$$ ;If REENTER command .SBTTL REENTER Command OVCMD REENTER BIT #,@#$JSW ;Is prog REENTERable? BEQ BDCOM ;No,invalid command MOV #<-2>,R2 ;Use start address minus two BR STRE ............ .ENDC ;NE REEN$$ .IF NE STAR$$ ;If START command .SBTTL START Command OVCMD START BIT #,@#$JSW ; Virtual job ? BNE BDCOM ; Yes, can't use START CMPB @R5,#<' > ;Don't throw away first digit BEQ 10$ ;If user forgot to type a space. INC R5 ;He forgot,back up pointer 10$: OCALL OCTNUM ;Get the desired START address TSTB @R5 ;Terminated with end of line? BNE BDCOM ;No, branch to give error MOV (SP)+,R2 ; BNE GOTADR ; .ENDC ;NE STAR$$ .SBTTL REENTER/START Common Code OVCMD STRE ADD @#$USRPC,R2 ;Use starting address from CCB if 0 GOTADR: MOV PC,-(SP) ;Equivalent to OADDR KMON,-(SP) ADD #-<.-OVLYST>,@SP ;Setup first address to read .IF NE MMG$T OINST SUB VBIAS,@SP,* ;Get virtual address of start of KMON .ENDC ;NE MMG$T BIC #,@SP ;Round to a block OINST MOV @.$SWPBL,-(SP),* ;Setup first block to read MOV R0,-(SP) ;Save R0 OVCMD RUNCHK .Assume IN$IND EQ 200 OINST TSTB @.INDSTA,,* ;Were we called by IND? BPL 20$ ;No, no need to check error condition further OADDR INPFN+2,R0 ;Point to file name being executed CMP #<^rIND>,(R0)+ ;Trying to execute IND.SAV? BNE 20$ ;No, everything's ok TST (R0)+ ;Second word would be 0 BNE 20$ ;No, valid run CMP #<^rSAV>,(R0)+ ;Is the extension .SAV? BEQ INVCNS ;Yes, invalid control file nesting 20$: MOV (SP)+,R0 ;Restore R0 BIT #,@#$JSW ;Are we chained to ? BNE 30$ ;Yes, do not reset .SRESET ;No, reset all (except maybe 17) 30$: MOV (SP)+,R1 ;Restore first address to read MOV (SP)+,R3 ;Restore start address of KMON MOV @#$SYPTR,R5 ;Get start of RMON OCALLR BEGIN ............ ;+ ;ERROR INVCNS: KMEROR ;- ............ .DSABL LSB .SBTTL GET Command (Part 2 - Also Used By RUN) ;+ ; Since RUN always comes through here (GET1) this is a convenient ; place to accept the extended RUN syntax for a command string to ; be passed to the program to be invoked. The fact that GET also ; accepts it is ok. This code has to be before the .SAV image is ; loaded so the KMON can move to make room for text. ; ; GETUCL entry is provided to purge channels since UCL is entered ; as though it were .CHAINed to. ;- ;+ ; The LOOKUP occurs here because KMON may move changing file addr. ;- .ENABL LSB .IF NE MMG$T 10$: MOV #<500>,-(SP) ;Point to file spec again OINST MOV #<3-400>,VBGFLG,,* ;Indicate fallback to nonVBGEXE pass .ENDC ;NE MMG$T .IF NE OVCMD GETUCL .PURGE # ;Purge overlay channel so we can do .LOOKUP .ENDC ;NE OVCMD GET1 MOV (SP)+,R0 ;Restore file descriptor address OCALL COPYFN ;Copy filename incase of error OADDR KMCBUF,R2 ;Point to start of command buffer .LOOKUP CHOVLY ;Lookup file to be got BCC 70$ ;File found - error CMP #<' >,@R2 ;Conventional RUN command? BEQ 50$ ;Branch if yes MOV #<' >,@R2 ;Reset stopper in buffer for factoring .IF EQ U$CL BR BDCOM ;Print invalid command ............ .IFF ;EQ U$CL OVCMD UCL MOV @#$SYPTR,R0 ;Point to monitor BITB #,CLIFLG-$RMON(R0) ;Doing UCL? BEQ BDCOM ;No, then invalid command error MOVB #,CLITYP-$RMON(R0) ;Indicate UCL (not UCI call) JSR R3,20$ ;Point to user defined command file name ..UCLD ==: < . > ;**PATCH** Default Device for UCL Program ..UCLF ==: < . + 2 > ;**PATCH** Default Filename for UCL Program UCLNAM: .RAD50 /SY UCL SAV/ ;Default Filespec of UCL Program ............ OVCMD UCF JSR R3,20$ ;Point to user defined command file name ..UCFD ==: < . > ;**PATCH** Default Device for UCF Program ..UCFF ==: < . + 2 > ;**PATCH** Default Filename for UCF Program UCFNAM: .RAD50 /SY UCF SAV/ ;Default Filespec of UCF Program ............ 20$: .SRESET ;No, reset all (except maybe 17) MOV #,@#$JSW ;Simulate a .CHAIN to UCL (or UCF) MOV R2,@SP ;Save start of command buffer. Upon return to ;GET1 R5 will contain this value so the whole ;string will be passed to UCL as is ;string to UCL CALL STUFIT ;Store remaining command string in chain area .ENDC ;EQ U$CL .IF NE 30$: MOV R3,R0 ;R3 on return contains adjusted pointer of R0 OCALLR UCLROT ;Load handler if needed. Then GETUCL .............. ; is re-entered which falls into GET1. .ENDC ;NE ;VBG+ .IF NE MMG$T 40$: OADDR KMCBUF,R3 ;Point to start of command buffer ;+ ; We don't want to modify the chain area here, because it is already set ; up! So STUFIT must not be called. ;- JSR R3,30$ ;R3 -> VBGNAM and save cmd buff -> on stack ..VBGD ==: < . > ;**PATCH** Default Device for VBGEXE Program ..VBGF ==: < . + 2 > ;**PATCH** Default Filename for VBGEXE Program VBGNAM: .RAD50 /SY VBGEXESAV/ ;Default Filespec of VBGEXE Program .ENDC ;NE MMG$T ;VBG- BDCOM: OCALLR BADCOM .............. 50$: ;VBG+ .IF NE MMG$T OINST ASR VBGFLG,,* ;Is this VBGEXE startup or fallback pass? BCC 60$ ;Branch if not BEQ 10$ ;Branch if V|VRUN not specified and not ; fallback pass 60$: .ENDC ;NE MMG$T ;VBG- OCALLR NOTFND ;File not found .............. 70$: MOV #<' >,@R2 ;Make sure stopper reset for factoring MOV #$JSW,R1 ;R1 -> $JSW ;VBG+ .IF NE MMG$T BIC #,@R1 ;Indicate job not running under VBGEXE OINST ASRB VBGFLG,,* ;Is this VBGEXE startup or fallback? BCC 80$ ;Branch if not BNE 230$ ;Go load job without VBGEXE BIS #,@R1 ;Indicate VBGEXE is running BR 230$ ; and go load it ............ 80$: MOV R5,-(SP) ;Save R5 OCALL CCBB0R ;Read CCB for $JSX check .ASSUME H.HAN EQ 0 CMP @R5,# ;Handlers don't have a $JSX BEQ 90$ ;Bypass $JSX check if a handler MOV @#$SYPTR,R0 ;R0 -> $RMON BIT #,$JSX(R5) ;Does job require ZB|ZM? BEQ 90$ ;Branch if not MOV (R0),-(SP) ;Get CONFG3 BIC #^c,@SP ;Isolate h/s bits for supy/I&D space CMP #,(SP)+ ;ZB|ZM monitor w/ supy/I&D hardware? BEQ 90$ ;Branch if so, else error ;+ ;ERROR NEEDZM: KMRTMG ,,PFILE ;- 90$: OINST TSTB VRNFLG,,* ;VBGEXE explicitly specified by V[RUN]? BEQ 100$ ;Branch if not BIS #,@R1 ;Set persistent VBGEXE environment BR 140$ ;VBGEXE will check for handler and NOVBG$ ............ 100$: BIT #,@R1 ;Are we being chained to? BNE 110$ ;Branch if yes BIC #,@R1 ;R|RUN so no persistent VBGEXE environment 110$: .ASSUME H.HAN EQ 0 CMP @R5,# ;Handlers cannot be run under VBGEXE BEQ 150$ ;Branch if a handler -- can't use VBGEXE CMP SV.SID(R5),# ;Is job I&D separated? BNE 120$ ;Branch if not OINST MOV #<-2>,VBGFLG,,* ;Must use VBGEXE for I&D space jobs BR 140$ ;Go setup VBGEXE startup pass ............ 120$: BIT #,@R1 ;Persistent VBGEXE environment? BNE 130$ ;Branch if so (use VBGEXE unless NOVBG$ set) BIT #,(R0) ;Is SET RUN VBGEXE in effect? BEQ 150$ ;Branch if not -- don't use VBGEXE .ASSUME VBGEX$ EQ 200 TSTB $JSX(R5) ;Would job like to use VBGEXE? BEQ 150$ ;Branch if not -- don't use VBGEXE 130$: BIT #,$JSX(R5) ;Is job forbidden to use VBGEXE? BNE 150$ ;Branch if yes -- don't use VBGEXE 140$: OINST MOVB #1,VBGFLG,,* ;Indicate VBGEXE startup pass 150$: MOV (SP)+,R5 ;Restore R5 .ENDC ;NE MMG$T ;VBG- BIT #,@R1 ;Is this a .CHAIN? BNE 220$ ;Yes, skip syntax check ;+ ; What is this for? I can't find any reference to this in the documentation ; or in KMON. ; TSTB @R5 ;RUN without following command string? ; BEQ 125$ ;Branch if yes ; MOV #<-1>,@# ;Denote RUN with command string ; ;following (Complex RUN) ;125$: ;- ;VBG+ .IF NE MMG$T OINST TSTB VBGFLG,,* ;Are we going to use VBGEXE? BEQ 160$ ;Branch if not MOV #,R2 ;Get pointer past file spec MOV -(R3),-(R2) ;Move file spec to MOV -(R3),-(R2) ; 500 - 506 MOV -(R3),-(R2) ; with VBGEX$ set in $JSW MOV -(R3),-(R2) ; so VBGEXE can get filespec 160$: .ENDC ;NE MMG$T ;VBG- INC R5 ;Bump up so we can look at delim again 170$: OCALL ALPHNT ;Skip over extra chars in filename BCS 170$ ;Loop till real terminator MOV R5,R2 ;R2 -> rest of command line CALL STUFIT ;Store it in chain area TSTB @R5 ;At end of line? BEQ 220$ ;Branch if yes, no special syntax CMPB #<' >,@R5 ;Extra syntax always starts with a space BNE BDCOM ;Branch if error OADDR FILST,R0 ;Get addr of a large work area MOV R0,R2 ;Save for later MOV R5,R4 ;Save where we are in scan 180$: TSTB -(R5) ;Did we hit end of line? BEQ 200$ ;Branch if yes, no output file list CMPB #<' >,@R5 ;Are we at an output file field BNE 180$ ;Branch if not to try and find one CLRB @R5 ;Now make primary list end at ' ' 190$: MOVB -(R5),(R0)+ ;Put together output file list BNE 190$ ;Branch till end of line MOVB #<'=>,-1(R0) ;Force an '=' after output list for CSI 200$: MOVB -(R4),(R0)+ ;Now put together input file list BNE 200$ ;Branch till end of input MOVB #,(R0)+ ;Put in ^C to abort program after 1 line CLRB (R0)+ ;Put in terminator SUB R2,R0 ;How much data to we have to pass MOV R0,R5 ;Save copy so we know how much to move MOV @#$JSW,-(SP) ;Save JSW because DCLSPC can get it cleared! OCALL DCLSPC ;Ask for the space, we may move!! MOV (SP)+,@#$JSW ;Restore JSW SUB R0,R2 ;Form new pointer to FILST SUB R0,@SP ;Adjust return address 210$: MOVB (R2)+,(R1)+ ;Move up the data line SOB R5,210$ ;Loop till done 220$: ;VBG+ .IF NE MMG$T .ASSUME VBGEX$ EQ 200 OINST TSTB VBGFLG,,* ;Do we need to load VBGEXE? BEQ 230$ ;Branch if not JMP 40$ ;Go load VBGEXE 230$: .ENDC ;NE MMG$T ;VBG- OCALL CCBB0 ;Get CCB and block 0 CMP <0-360>(R5),# ;Handlers don't have a CCB bitmap BNE 250$ ;Branch if not a handler -- got the bitmap MOV R1,-(SP) ;Need to create CCB for handler (preserve R1) MOV R2,-(SP) ;Save R2 MOV R2,R0 ;NOTHIR needs ptr to local CCB bitmap in R0 240$: CLR (R2)+ ;Clear out local CCB bitmap first SOB R1,240$ ;Loop until done clearing CLR R2 ;Beginning address to represent in bitmap is 0 MOV <$USRTO-360>(R5),R4 ;Top address to represent in bitmap OCALL NOTHIR ;Create the CCB bitmap for the handler MOV (SP)+,R2 ;Restore R2 MOV (SP)+,R1 ; and R1 and go use the new CCB bitmap 250$: CLR R5 ;Zero the block number ASL R1 ;Set CCB byte count to 16 MOV #<200>,R4 ;Initialize test bit (start at block 1) CLRSB: CLR R0 ;Indicate no starting block number GETBIT: RORB R4 ;Shift test bit BCS ORCCB ;If Carry Set, done with this byte INC R5 ;Increment block number BITB R4,@R2 ;Test bit of save file's CCB BEQ GETBNU ;This block not used TST R0 ;Is this first block of a sequence ? BNE GETBIT ;No, starting block already set MOV R5,R0 ;Yes, set starting block of sequence BR GETBIT ;Go look at next bit of map .............. ORCCB: BISB (R2)+,(R3)+ ;Set bits in resident CCB SOB R1,GETBIT ;*C* Process another byte RETRED: RETURN ............ GETBNU: TST R0 ;Was preceeding block(s) used ? BEQ GETBIT ;No, no reads OADDR KMON,R4,PUSH ;Save R4, point to KMON MOV R5,-(SP) ;Save block number for later .IF NE MMG$T OINST SUB VBIAS,R4,* ;Bias for KMON's loc in job space .ENDC ;NE MMG$T CLRB R4 ;Make it an exact block SWAB R4 ASR R4 ;Make it a block number CMP R5,R4 ;Does this set of blocks overlay KMON ? BLE NOSCRA ;No, nothing into the system scratch CMP R0,R4 ;Does starting block overlay KMON ? BGE ALSCRA ;Yes, all into system scratch area MOV R4,R5 ;This set of blocks lays across boundary CALL READSF ;Read part that fits into real core MOV R4,R0 ;Set start block to start of virt core ALSCRA: SUB R4,R0 ;Get block # in virt core into R0 ADD R0,R4 ;R4 has starting block in file ALSCR1: MOV @SP,R5 ;Get number of last block + 1 SUB R4,R5 ;Number of blocks remaining to GET BLE ENDSCR ;None left in this sequence MOV R5,-(SP) ;Compute block number + 1 in SWAP file ADD R0,@SP ; of last block to read CMP (SP)+,# ;Will data fit in SWAP file? BHI OVERC1 ;It doesn't, so give error MOV R0,-(SP) ;Save virt core block # MOV R4,R0 ;R0 contains block to read in save file CLR -(SP) ;Use wait I/O MOV #,-(SP) ;Read two blocks DEC R5 ;If there are two left BNE 260$ ASR @SP ;Nope, only one left 260$: OADDR SYSIOB+2,R5 ;Setup pointer to System IO Block MOV @SP,@R5 ;Copy word count into SYS IO Block NEG @R5 ;Make it neg.--a write operation MOV -(R5),-(SP) ;Copy buffer pointer to stack EMT ..1REA+CHOVLY ;Read from save file (V1) SFELNK: BCS SFERR1 ;Error reading save file MOV @SP,R0 ;Restore block # in virt core to R0 OCALL SYSK ;Write into sys scratch MOV (SP)+,R0 ;Restore starting block again CMPB (R0)+,(R0)+ ;Increment it by two CMPB (R4)+,(R4)+ ;Increment input block # as well BR ALSCR1 ;Go do next 2 blocks ............ NOSCRA: CALL READSF ;Read from save file direct to core ENDSCR: MOV (SP)+,R5 ;Restore current block number MOV (SP)+,R4 ;Also restore mask BR CLRSB ;Go test next bit ............ READSF: CLR -(SP) ;Use wait I/O SUB R0,R5 ;Number of blocks SWAB R5 ;Get word count MOV R5,-(SP) ;Onto stack MOV R0,-(SP) ;Starting block number to stack SWAB @SP ;Make it an address ASL @SP .IF NE MMG$T OINST ADD VBIAS,@SP,* ;Bias starting address for job type .ENDC ;NE MMG$T EMT ..1REA+CHOVLY ;Read the file (V1) SFELK1: BCC RETRED ;Return from good read SFERR1: OCALLR FIPERR ............ OVERC1: OCALLR OVERC ............ .DSABL LSB .SBTTL AT2 - Scan Line For @File (Cont'd) ;+ ; AT2 - Continuation of ATSCAN routine. ; ; OVCMD AT2 is located above because the table codes require OVCMD labels ; to be in first block of overlay. ; ; If an '@' is found the line is searched for a dollar character. If ; a dollar sign preceeds the '@', the dollar sign is replaced w/ a space. ;- .ENABL LSB AT2BEG: MOV R5,-(SP) ;Save current pointer into line command buffer TSTB (R5)+ ;Point to previous character CMPB (R5)+,#<' > ;Was it a space? BNE 10$ ;No, don't adjust pointer TSTB (R5)+ ;Point to next character 10$: CMPB -(R5),#<'$> ;Was the character a dollar sign? BNE 20$ ;Branch if not MOVB #<' >,@R5 ;Yes, replace dollar with space 20$: MOV (SP)+,R5 ;Restore pointer to line buffer MOV R5,-(SP) ;Save pointer to '@' in command line INC @SP ;Bump pointer to overwrite the '@' 30$: CMPB -(R5),#<' > ;Skip spaces ... BEQ 30$ ; ... after the '@' INC R5 ;Point to non-blank next OINST MOV .STATWD,R3,* ;Use R3 to point to STATWD BIT #,@R3 ;Was dollar sign in command? BNE 50$ ;Branch if yes to do regular indirect OINST BITB #,@.INDSTA,,* ;Is IND in effect? BEQ 40$ ;No OINST BITB #,@.INDSTA,,* ;Command line come directly from IND? BNE 50$ ;Branch if yes 40$: OADDR KMCBUF,R2 ;Get KMON buffer address CMP R2,@SP ;Command from Command buffer? BNE 50$ ;Branch if no BIT #,@R3 ;Is KMON set to IND processing? BNE 80$ ;Yes, run IND 50$: OINST BICB #,@.INDSTA,,* ;Make sure "line from IND" is reset OINST CLR @.CURLEV,,* ;Zero denotes new current level BIC #,@R3 ;Init. dollar bit before processing line BIT #,@R3 ;Is there an active indirect file? BEQ 60$ ;No, no need to push file context OCALL SVST ;Save current indirect file status CMP -(R2),-(R2) ;Backup to check nesting depth CMPB -(R2),-(R2) ;Is current nesting depth at the maximum? BEQ 130$ ;Yes, error - attempt to nest too deeply MOV @R2,-(SP) ;Save current nesting level ADD #,R2 ;Point to space for next nesting level MOV (SP)+,@R2 ;Move in header word: current depth/maximum INC (R2)+ ;Bump current depth in low byte CLR (R2)+ ;Clear character count CLR (R2)+ ; and current block number for this @ file OINST MOV R2,@.IFSVST,,* ;Save pointer to SAVESTATUS info for @ file 60$: MOV (PC)+,R3 ;Use DK as default device name ..ATDK:: .RAD50 /DK / ;**PATCH** Default Device Name for @ Files OCALL IFILE ;Get file descriptor INC R5 ;Bump pointer to check trailing blanks 70$: CMPB -(R5),#<' > ;More spaces? BEQ 70$ ;Yes, continue looping TSTB @R5 ;No, is it end of line? BNE 120$ ;Syntax error OINST MOV ACCUM,-(SP),* ;Save value of ACCUM = amount KMON moves OCALLR AT3 ;Back to resident to call GETHAR ............ 80$: TSTB -1(R5) ;Did anything follow the '@'? BEQ 140$ ;Branch if no to display error OINST MOV SP,@.CURLEV,,* ;Make current level non-zero to denote not ; current level MOV #,R1 ;Point to location 512 of chain area OADDR INDCNT+2,R0 ;Point to ASCII "RUN" MOV (R0)+,(R1)+ ;Copy ASCII text into chain buffer MOV (R0)+,(R1)+ OINST MOV NMIND,R0,* ;Get RAD50 device name to run IND from OCALL R50ASC ;Convert RAD50 name to ASCII and store 90$: CMPB #<' >,-(R1) ;Was last character a space? BEQ 90$ ;Yes, check next character TSTB (R1)+ ;Point past first non space character OADDR INDCNT+11,R0 ;Point to ASCII "IND.SAV" text 100$: MOVB (R0)+,(R1)+ ;Copy rest of text into chain buffer BNE 100$ ;Branch until done MOVB #<' >,-1(R1) ;Next store space before passing CSI text 110$: MOVB -(R5),(R1)+ ;Store CSI string into chain area BNE 110$ ;Loop until done SUB #,R1 ;Get number of characters stored in chain area MOV R1,@#CCL.CT ;Put that in location 510 of the chain area BIS #,@#$JSW ;Set special chain exit bit in $JSW .IF NE MMG$T BIC #,@#$JSW ;Ensure that the virtual bit is off .ENDC ;NE MMG$T CLR R0 ;R0 = 0 for exit .EXIT ............ 120$: OCALLR BADCOM ;Invalid command ............ ;+ ;ERROR 130$: KMEROR ;@File nesting too deep ;- ............ 140$: OCALLR NOFILE ;No file error ............ .DSABL LSB .SBTTL STUFIT - Copy Routine .ENABL LSB STUFIT: MOV #,R0 ;Point to chain area to store command string 10$: MOVB -(R2),(R0)+ ;Move string into chain area BNE 10$ ;Loop til done SUB #,R0 ;Count all chars up to AND including null MOV R0,@#CCL.CT ;Store it in chain area RETURN ............ .DSABL LSB .SBTTL FACTOR/SAVE (Part 2) Overlay OVERLAY .IF NE SAVE$$ ;If SAVE command OVCMD SAV1 CALLR SAVP2 ............ .ENDC ;NE SAVE$$ .SBTTL FACTOR - Factoring Expander Routine .ENABL LSB OVCMD FACTOR ;+ ; 'FACTORING' String Expander ; This code does a brute force string expansion as follows: ; delim1 text1'('text3 delim3 text4 delim4 ...textn')'text2 delim2 ; => delim1 text1 text3 text2 delim3 text1 text4 text2 delim4 ... ; text1 textn text2 delim2 ; Where delim1 is ',' or ' ' or ; delim2 is ',' or ' ' or ; delim3,... is ',' or ' ' ;- MOV R5,R0 ;Set up to find logical text1 field 10$: INC R5 ;Bump pointer CALL TESTD1 ;Look for a ',' or ' ' or '+' ;KMCBUF starts with ' ' BNE 10$ ;Loop until one found MOV R5,R1 ;Save start of text1 field OADDR FILST,R5 ;Point to a temp work area ;Its useable size is bigger than KMCBUF MOV R5,R3 ;Save for later MOV R0,R4 ;Save end of text1 field for later 20$: MOVB -(R4),(R5)+ ;Move the remainder of the line to area BNE 20$ ;Loop until end of line MOV R3,R5 ;Point back to area start ;Look for the text2 field 30$: CALL TESTD2 ;Look for a ')' INC R5 ;Bump to next char BCC 30$ ;Loop until it's found MOV R5,R4 ;Save pointer to start of text2 field MOV R1,R5 ;Set text ptr into command string again 40$: MOV R1,R2 ;Get ptr to start of text1 into work reg 50$: CMP R5,@SP ;At end of input buffer? BLO 110$ ;Yes. too many chars MOVB -(R2),-(R5) ;Put in a byte CMP R2,R0 ;At end of field? BNE 50$ ;No, loop until pointers line up INC R5 ;Text pointer went 1 too many 60$: CMP R5,@SP ;At end of input buffer? BLO 110$ ;Yes, too many chars MOVB (R3)+,-(R5) ;Put in textn bytes BEQ 120$ ; within parentheses: treat as ')' CALL TESTD2 ;Look for a ',',' ',')' or BNE 60$ ;Loop until we find one INC R5 ;Text ptr went 1 too many again BCS 90$ ;Branch if stopped on ')' MOV R4,R2 ;Get ptr to start of text2 into work reg 70$: CMP R5,@SP ;At end of input buffer? BLO 110$ ;Yes, too many chars MOVB (R2)+,-(R5) ;Put in a text2 byte CALL TESTD1 ;Look for end of TEXT2 (,' ',',') BEQ 80$ ;Found it CMPB #<'/>,@R5 ;Also stop text2 field on option char BNE 70$ ;Loop until end of text2 field 80$: MOVB -1(R3),@R5 ;Put the ',' or ' ' delimiter in BR 40$ ;Loop ............ 90$: MOV R5,R1 ;Save text ptr so next '(' is found from there 100$: CMP R1,@SP ;At end of input buffer? BLO 110$ ;Yes, too many chars MOVB (R3)+,-(R1) ;Move the rest of the line back in BNE 100$ ;Loop until hit the end OCALLR SCNLIN ;Look for the next factored field ............ 110$: OCALLR LTL ;Line too long error ............ 120$: OCALLR CLASIFY ;When at end of line goto CLASIFY ............ .DSABL LSB ;+ ; Test Delimiter Subroutines for Factoring Expander ; Z Set means delimiter found ( or ' ' or '(' or ',' or '+') ; C Set means or ')' ;- .ENABL LSB TESTD2: CMPB #<')>,@R5 ;At a closing (right) paren? BEQ 10$ ;Yes, stop TESTD1: CMPB #<',>,@R5 ;At a comma? BEQ 20$ ;Yes, stop CMPB #<' >,@R5 ;At a space? BEQ 20$ ;Yes, stop CMPB #<'+>,@R5 ;At a plus sign? BEQ 20$ ;Yes, stop TSTB @R5 ;At ? BNE 20$ ;No, C,Z Clear 10$: SEC ;Set C on or ')' 20$: RETURN ............ .DSABL LSB .IF NE SAVE$$ ;If SAVE command (for next page) .SBTTL SAVE Command (Part 2) ;+ ; Ptr to file name is on stack ;- .ENABL LSB SAVP2: MOV (PC)+,R4 ;Counters in R4 .BYTE <8.>,<9.> OADDR FILST,R1 ;R1 -> internal copy (FILST is a ;Scratch area during SAVE from DCL) MOV @#$USRTO,(R1)+ ;Save a copy of the top MOV @#$SYPTR,R3 ;R3 -> CCB in RMON ADD #,R3 10$: MOV (R3)+,(R1)+ ;Copy a word DECB R4 BNE 10$ TSTB @R5 ;Is it eol? BEQ DOSAVE ;Yes, do the SAVE SWAB R4 ;Get count of 9 20$: CLR -(R1) ;Clear out temp CCB and temp $USRTO SOB R4,20$ MOV R1,R3 ;R3 -> temp $USRTO 30$: TSTB @R5 ;End of line? BEQ DOSAVE ;Yes, now do the SAVE CMPB #<' >,@R5 ;Check for addresses BEQ 40$ ;Delimited by blank or comma CMPB #<',>,@R5 BNE BADSAV ;No, it's bad 40$: CALL SAVNUM ;Get a low address MOV R4,R2 ;Put it in R2 CMPB @R5,#<'-> ;Is it a range? BNE 50$ ;No CALL SAVNUM ;Yup, get a high address CMP R4,R2 ;Check legality BLO BADSAV ;High address < low address 50$: MOV R3,R0 ;Copy pointer CMP (R0)+,R4 ;Is this the largest so far? BHI 60$ ;No MOV @#$SYPTR,R1 ;Is this too big for comfort? CMP R4,SYSLOW-$RMON(R1) BHIS BADSAV ;Trying to SAVE out of range MOV R4,@R3 ;Save temp $USRTO 60$: OCALL NOTHIR ;Set bit map (R0 -> temp bitmap) BR 30$ ;And try for more ............ .DSABL LSB .ENABL LSB DOSAVE: OADDR KMON,R4 ;R4 -> KMON CLRB R4 ;Round down to a block boundary SWAB R4 ;Make it a block count ASR R4 OINST MOV FILST,R1,* ;Get SAVE file's $USRTO BEQ BADSAV ;Can't SAVE nothing ADD #,R1 ;Round size up to exact block multiple CLRB R1 ;Make a block count of SAVE file SWAB R1 ASR R1 .PURGE # ;PURGE the overlay channel ;;; MOV (PC)+,R0 ;Get code to PURGE overlay channel ;;; .BYTE ,<.PURGE> ;;; EMT ...PUR MOV @SP,R0 ;Point at the filename OCALL COPYFN ;Save the filename incase of error .ENTER CHOVLY,(SP)+,R1 ;Enter a file of the right size BCS ENTERR ;Oops, somethings amiss SUB R4,R1 ;R1 = count of blocks in scratch area BPL 10$ ;There's something there ADD R1,R4 ;It's shorter than scratch, adjust R4 10$: MOV #,R0 ;Now copy block 0 to the USR buffer OINST MOV .USRTOP,R3,* OINST CLR @.BLKEY,,* ;The buffer is dead 20$: MOV -(R0),-(R3) ;Copy it TST R0 ;Down to the beginning BNE 20$ OADDR FILST,R2 ;Point to temp area in KMON MOV (R2)+,$USRTO(R3) ;Put in the proper top address MOV R3,R5 ;R3 -> USR buffer ADD #<360>,R5 ;R5 -> CCB in USR buffer MOV #<8.>,R0 ;Count to move 30$: MOV (R2)+,(R5)+ SOB R0,30$ .WRITW CHOVLY,R3,# ;Write the USR buffer as block 0 (R0=0) BCS WSVERR ;Oops,an output error DEC R4 ;Count down blocks to do BLE 40$ ;Done already! CLR -(SP) ;Wait I/O MOV R4,-(SP) ;Block count to do from in core SWAB @SP ;Word count MOV #<1000>,-(SP) ;Address to start writing MOV #<1>,R0 ;Start at block 1 EMT ..1WRI+CHOVLY ;Write the file (V1) BCS WSVERR ;Oops, another write error 40$: CLR R3 ;Clear scratch area block number INC R4 ;Bump blk # to write in save file 50$: DEC R1 ;Any more to do in scratch area? BMI 70$ ;No CLR -(SP) ;Wait I/O MOV #,-(SP) ;Normally do 2 blocks DEC R1 ;But if only one is left BPL 60$ ; then ASR @SP ; only do one 60$: OADDR SYSIOB+2,R5 ;R5 -> IOB for scratch area MOV @SP,@R5 ;Insert proper read length MOV -(R5),-(SP) ;Save address of buffer MOV R3,R0 ;R3 has system scratch block # OCALL SYSK ;Do the read MOV R4,R0 ;R4 = block number in save file EMT ..1WRI+CHOVLY ;Write the file (V1) BCS WSVERR ;Oops,an yet another write error TST (R3)+ ;Bump scratch block # by 2 CMPB (R4)+,(R4)+ ;Bump save file block # by 2 BR 50$ ;And loop ............ 70$: .CLOSE CHOVLY ;Done BCC SVRTS ;Some are lucky,some aren't ;+ ;ERROR KMRTMG ,WARN$,PFILE ;- ............ SVRTS: RETURN ............ .DSABL LSB SAVNUM: MOV R5,-(SP) ;Save pointer DEC @SP OCALL OCTNUM ;Get a number MOV (SP)+,R4 ; in R4 CMP (SP)+,R5 ;Got anything? BNE SVRTS ;If NE-yes, return No-error ;+ ;ERROR BADSAV: KMEROR ............ WSVERR: KMRTMG ,,PFILE ;Output error ;- ............ ENTERR: CMPB @#$ERRBY,#<3> ;Protection violation ? BNE FROOM ;No, just full device ;+ ;ERROR KMRTMG ,,PFILE ............ FROOM: KMRTMG ,,PFILE ;- ............ .ENDC ;NE SAVE$$ .SBTTL @File Expansion (Part 2) Overlay OVERLAY ;+ ;******************************************************************* ; NOTE: This overlay !!!MUST!!! be the !!!LAST!!! KMON overlay ... ; I.E. ABSOLUTELY, NO EXCEPTIONS, P E R I O D ! ! ! ;******************************************************************* ;- OVCMD INDF1 .ENABL LSB INDF1: OINST MOV @.IFSVST,R2,* ;Point to indirect file SAVESTATUS info OINST TST IFOPN,,* ;Indirect file open? BNE 10$ ;Yes, no need to reopen .PURGE # ;PURGE the overlay channel .REOPEN CHOVLY,R2 ;Reopen indirect file on channel CHOVLY ;No error possible we PURGEd the channel OINST MOV SP,IFOPN,,* ;Set indirect file open flag ;OINST MOV #<-1>,IFBN,,* ;Set no indirect file block in core 10$: OADDR IFBUFR,R3 ;Point to indirect file buffer MOV -(R2),R1 ;Get indirect file current block # OINST CMP IFBN,R1,* ;Desired block of file in core? BEQ 20$ ;Yes .READW CHOVLY,R3,#,R1 ;Read the block BCS IFRDER ;Oops, read error OINST MOV R1,IFBN,,* ;Set number of block in core 20$: MOV -(R2),R4 ;Get offset into block ADD R3,R4 ;Point to next character 30$: CMP @R2,# ;Are we at end of block? BLOS 40$ ;No, proceed CLR (R2)+ ;Yes, clear character counter INC (R2)+ ;Increment block number BR 10$ ;Go read next block ............ .ASSUME IFBFSZ EQ 1 40$: INC @R2 ;Bump permanent character counter MOVB (R4)+,R0 ;Get next indirect file character BEQ 30$ ;Null, skip it INDF2: MOV (SP)+,R3 ;Restore KMON line buffer pointer MOV (SP)+,R1 ; and count of space left in buffer OINST MOV SP,DATAFG,,* ;Don't compress spaces, etc. now OJSR R2,CHARC1 ;Check char + store in line bfr if ok BR 100$ ; normal character, get more ...... OJSR R2,CNTCK ;Line end. Check for continuation BR 90$ ;Yes, append another line to this one ...... CMP R5,R3 ;No continuation. Any input? BNE 50$ ;Yes INC R1 ;No, adjust count OINST CMPB CMNTF,#<'!>,* ;Was it a comment line? BEQ 80$ ;Yes, ignore completely 50$: MOV R5,-(SP) ;Save pointer to start of buffer 60$: TSTB -(R5) ;Look for end of line or '@' BNE 70$ ;Not null yet SCNDN1: OCALLR SCNDUN ;Ok, go process it ............ 70$: CMPB @R5,#<'@> ;Is it indirect file? BNE 60$ ;No, keep looking OINST CLR DATAFG,,* ;Yes, set to stop expanding w/this line .IIF EQ LNK$IF, .NLIST .IF NE LNK$IF OINST BIT #,@.STATWD,,* ;Doing LINK overlay @file? BNE IFNERR ;Yes, can't nest .ENDC ;NE LNK$IF .IIF EQ LNK$IF, .LIST BR 60$ ;Go find eol ............ 80$: OINST TST IFOPN,,* ;Is indirect file still open? BNE 100$ ;Yes, try to expand more OINST MOV .STATWD,R3,* ;No, setup to clear @file active bits BR IFEOF2 ;Go clean up ............ 90$: OINST TST IFOPN,,* ;Is indirect file open? BNE 100$ ;Yes, just go on OCALLR ILCNT ;No, then continuation invalid ............ 100$: MOV R1,-(SP) ;Stack count of space in line buffer MOV R3,-(SP) ;Ditto for KMON line buffer pointer BR 30$ ;Get another char ............ .DSABL LSB IFRDER: TSTB @#$ERRBY ;Is it read error or end of file? BEQ IFEOF1 ;Go finish end of file on indirect file ;+ ;ERROR IFERR: KMEROR ,,UNCON$ ............ .IF NE LNK$IF IFNERR: KMEROR ............ .ENDC ;NE LNK$IF ;- .ENABL LSB ;+ ; End of Indirect File: ; If nested indirects, pop context and proceed. ; If no more context to pop, return block of memory used to ; store context to the monitor (possibly sliding KMON/USR up). ;- IFEOF1: OCALL SVST ;SAVESTATUS the indirect file OINST MOV #<-1>,IFBN,,* ;There is now no block in memory SUB #<6>,R2 ;Point back to nesting level data OINST MOV .STATWD,R3,* ;Get pointer to STATWD .IIF EQ LNK$IF, .NLIST .IF NE LNK$IF BIT #,@R3 ;Doing LINK overlay @file? BEQ 10$ ;No, proceed BIS #,@R3 ;Yes, set eof reached .ENDC ;NE LNK$IF .IIF EQ LNK$IF, .LIST 10$: TSTB @R2 ;Are we in a nested indirect file? BEQ 20$ ;No, return space used to save contxt OINST CMPB @.INBFPT,#,* ;IND command processed? BEQ 20$ ;Branch if yes. Don't process KMON yet OINST SUB #,@.IFSVST,,* ;Yes, pop to data for next level up .IIF EQ LNK$IF, .NLIST .IF NE LNK$IF BIT #,@R3 ;Did we hit eof in LINK overlay @file? BNE 30$ ;Yes, don't reopen yet .ENDC ;NE LNK$IF .IIF EQ LNK$IF, .LIST BR INDF1 ;Go reopen this file ............ 20$: OINST BIS #,@.STATWD,,* ;Eof at top level. Set eof bit MOV R2,R4 ;Prepare to free @file context area MOV R1,-(SP) ;Save OINST MOV SP,@.EXTFL,,* ;Inhibit ^C OINST CLR @.IFSVST,,* ;Set no context stack OCALL PUTBLK ;Return the space to free core list MOV (SP)+,R1 ;Restore BCC 30$ ;KMON didn't move ADD R0,R5 ;KMON moved, relocate line buffer ptr ADD R0,@SP ; and pointer on stack 30$: OINST CLR @.EXTFL,,* ;Re-enable ^C MOV #,R0 ;In case of unterminated last line CMP R5,@SP ;Any data in last line? BNE INDF2 ;Yes, use line feed to end it CMP (SP)+,(SP)+ ;No, so clear off stack IFEOF2: OINST CLR DATAFG,,* ;Clear since @file expansion is done 40$: BIC #,@R3 ;No @file active, eof, .IIF EQ LNK$IF, .NLIST .IF NE LNK$IF BIT #,@R3 ;Was this LINK overlay @file? BNE 50$ ;Yes, go finish processing it .ENDC ;NE LNK$IF .IIF EQ LNK$IF, .LIST OCALLR STRT ;Back to main KMON loop ............ .IIF EQ LNK$IF, .NLIST .IF NE LNK$IF 50$: OCALLR SCN2 ;Finish LINK overlay @file ............ .ENDC ;NE LNK$IF .IIF EQ LNK$IF, .LIST .DSABL LSB OVCMD SCN0 ;R0 is on stack .ENABL LSB SCN0: MOV R5,R0 ;Yes, determine line size SUB R4,R0 ;(line start minus line end) BEQ 60$ ;If no data-back to KMON loop MOV R0,-(SP) ;Save byte counter CMPB -(R5),# ;Was line a CTRL/C? BNE 10$ ;No OINST CLR DATAFG,,* ;Yes, clear DATAFG - hit a terminator 10$: .IIF EQ LNK$IF, .NLIST .IF NE LNK$IF OINST BIT #,@.STATWD,,* ;Doing LINK overlay @file? BNE 20$ ;Yes, don't flag for echo .ENDC ;NE LNK$IF .IIF EQ LNK$IF, .LIST BISB #<200>,@R5 ;Set first byte's sign bit-> echo line 20$: INC R5 ;Bump pointer SCN1: OINST BIT #,@.STATWD,,* ;Was end of file detected on @ file? BEQ 30$ ;No OINST BIC #,@.STATWD,,* ;Yes, no eof, no @file active OINST CLR DATAFG,,* ;Clear since @file expand is done 30$: .IIF EQ LNK$IF, .NLIST .IF NE LNK$IF OINST BIT #,@.STATWD,,* ;Doing LINK overlay @file? BNE 40$ ;Yes, call DCLSP1 like DCL does .ENDC ;NE LNK$IF .IIF EQ LNK$IF, .LIST OINST CLRB ATFLAG,,* ;Clear since this is @file data 40$: MOV @SP,R0 ;Get byte counter OCALL DCLSP1 ;Get space for @file data SUB R0,R5 ;Relocate buffer pointer MOV (SP)+,R0 ;Restore byte count 50$: MOVB -(R5),(R1)+ ;Move data from buffer to free blk SOB R0,50$ ;Loop until all of line is done OINST MOV R1,ENBFPT,,* ;Yes, update end pointer OCALL SVST ;SAVESTATUS @file if it's open 60$: OCALLR SCN3 ;Back to main line ............ .DSABL LSB .SBTTL AT4 - Scan Line For @File (Cont'd) OVCMD AT4 .ENABL LSB ;+ ; Continuation of Line Scan for '@' ;- AT4: MOV (SP)+,R3 ;Get saved R3 MOV R3,R0 ;Restore pointer to file descriptor .LOOKUP CHOVLY ;Lookup indirect file BCS CMDFNF ;Error, indirect file not found OINST MOV SP,IFOPN,,* ;Found-set indirect file open flag OINST MOV #<-1>,IFBN,,* ;Set no indirect file block in core OINST BIT #,@.STATWD,,* ;Indirect file already active? BNE 30$ ;Yes, we already have a SAVESTATUS area CLR R4 ;No, (max depth)*(#bytes for status) OINST BISB @.IFMXNST,R4,* ; = amount of core needed for stack MOV #,R0 10$: DEC R4 ;Done multiplying? BEQ 20$ ;Yes ADD #,R0 ;No, add in SAVESTAT size BR 10$ ;Keep looping ............ 20$: OINST MOV SP,@.EXTFL,,* ;Inhibit ^C OCALL GETBLK ;Get a block of memory for @file stack CLRB (R4)+ ;Set current depth to 0 OINST MOVB @.IFMXNST,@R4,* ;Store maximum nesting depth DECB (R4)+ ;Minus 1 for 0 to n CLR (R4)+ ;Clear char count for @file CLR (R4)+ ;And block # OINST MOV R4,@.IFSVST,,* ;Store ptr to @file save status area 30$: OINST CLR @.EXTFL,,* ;Re-enable ^C OINST BIS #,@.STATWD,,* ;Set indirect file active bit OINST SUB ACCUM,@SP,* ;Find out how much KMON has moved MOV (SP)+,R0 ;R0 has accumulated relocation count ;From GETBLK and possible 'LOAD' of ;Handler by GETHAR routine. MOV (SP)+,R3 ;Point to '@' in command buffer MOV (SP)+,R1 ;Restore count of room left in line bfr SUB R3,R5 ;Calc # of chars from '@' to line end SUB R5,R1 ;Fix count to remove '@file' construct MOV (SP)+,R5 ;Restore R5 to point to begin of cmd SUB R0,R5 ;Relocate it if KMON moved SUB R0,R3 ;Relocate pointer into command OCALLR INDFIL ;Go expand the file ............ CMDFNF: OINST TST @.IFSVST,,* ;Are we in first level? BEQ 40$ ;Yes, don't restore level OINST SUB #,@.IFSVST,,* ;Point to previous level status 40$: MOV R3,R0 ;Pass file name in R0 OCALL COPYFN ;Copy filename for error message OCALLR NOTFND ;File not found DEV:FILENAME.EXT ............ .DSABL LSB ;+ ;*********************************************************************** ; ; NOTE!! Indirect Command File Buffer Starts at Relative ; ; Location 1000 of This Overlay!!!! ; ;*********************************************************************** ;- .ASSUME <.-OVLYST> LE BK.BYT, MESSAGE= .SBTTL END .IIF DF NLOVLY, .LIST .END