.MCALL .MODULE .MODULE VBGEXE,VERSION=40,COMMENT=,AUDIT=YES ; 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. .ENABLE LC .NLIST BEX ;+ ; Macros ;- .MCALL .ASSUME .ADDR .BR .CALLK .CMAP .MCALL .EXIT .PRINT .SETTOP .TWAIT .READW .MCALL .GTJB .PURGE .LOOKUP .CSISP .CSTAT .MCALL .GTLIN .MTPS .CRRG .CRAW .ELRG .MCALL .RDBBK .RDBDF .WDBBK .WDBBK .FETCH .MCALL .GVAL .PEEK .POKE .DSTAT .RCTRLO .MCALL .SRESET .GTIM .LIBRARY "SRC:SYSTEM" .MCALL .ERRDF .FIXDF .GRBDF .HANDF .IMPDF ;SYSTEM .MCALL .ISTDF .JSWDF .JSXDF .RCBDF .SAVDF ;SYSTEM .MCALL .SYCDF .UEBDF .WCBDF ;SYSTEM .ERRDF ;Define programmed request error codes .FIXDF ;Define RMON fixed offsets .GRBDF ;Define offsets and bits global RCBs .HANDF ;Define offsets in handler file SB=1 ;Impure area requires some MMG$T=1 ; defined symbols to generate SUP$Y=0 ; the impure area SYT$K=0 FPU$11=0 SPC$PS=0 FIX$ED=0 ;allow definition of floating symbols .IMPDF ;Impure Area Layout FIX$ED=1 .ISTDF ;Define bits in I.STATE word .JSWDF ;Define bits in Job Status Word .JSXDF ;Define bits in Extended Job Status Word .RCBDF ;Define offsets and bits in region control block .SAVDF ;Define offsets in save file header .SYCDF ;Define offsets in system communications area .UEBDF ;Define bits in user error byte .WCBDF ;Define offsets for window control block .MACRO .ERRLO ERRMSG JSR R1,ERRLO .WORD ERRMSG .ENDM .MACRO .ERRHI ERRMSG,TYPE JSR R1,ERRHI .WORD ERRMSG-. .IF IDN DEV .WORD DEVSPC-. .IFF .IF IDN FILE .WORD FILSPC-. .IFF .WORD 0 .ENDC .ENDC .ENDM ..VMON = 0 .MACRO $VMON SYMBOL,TYPE,VALUE,COUNT,UNIT .IF NB ...VAL = VALUE .IFF ...VAL = 0 .ENDC ...COD = 0 .IIF IDN MODIFY, ...COD = ...COD + 100 .IIF IDN BYTE, ...COD = ...COD + 200 ...CNT = 1 .IIF NB , ...CNT = COUNT .SAVE .PSECT .COPY. .IIF NDF .COPY., .COPY. = . .IIF EQ ..VMON, .BYTE ^O377 . = . - 1 .PSECT .MDFY. .IIF NDF .MDFY., .MDFY. = . .IIF NB , SYMBOL = . - .MDFY. .IF DIF BYTE .REPT ...CNT .PSECT .COPY. .BYTE ...COD .PSECT .MDFY. .WORD ...VAL ..VMON = ..VMON + 2 .ENDR .IFF .REPT ...CNT .PSECT .COPY. .BYTE ...COD .PSECT .MDFY. .BYTE ...VAL ..VMON = ..VMON + 1 .ENDR .ENDC .PSECT .COPY. .BYTE ^O377 .RESTORE .ENDM ;+ ; General definitions ;- $60KW = 3600 ;Number of 32-word blocks in 60KW $32KW = 2000 ;Number of 32-word blocks in 32KW $28KW = 1600 ;Number of 32-word blocks in 28KW $24KW = 1400 ;Number of 32-word blocks in 24KW $20KW = 1200 ;Number of 32-word blocks in 20KW $8KW = 400 ;Number of 32-word blocks in 8KW $4KW = 200 ;Number of 32-word blocks in 4KW X.TOP = 177776 ;Top useable memory location X.LOAD = 174400 ;- 177776 ;Load code (free once running) X.STACK = 177776 ; and down ;VBGEXE's substitute stack X.LIM = 176000 ;Cannot read job above here directly X.LIM2 = & 077777 ;Word count of maximum read X.LMBK = > ;Block number of kernel read X.BLK0 = 164000 ;- 164777 ;Job's read-in block 0 X.VEC = 163000 ;- 163777 ;Locations 0 - 77 of VBGEXE X.RMON = 160000 ;- 162777 ;Pseudo RMON image KISAR0 = 172340 ;KERNEL I-SPACE ADDRESS REGISTER 0 KISAR1 = 172342 ;KERNEL I-SPACE ADDRESS REGISTER 1 KISDR0 = 172300 ;KERNEL I-SPACE DESCRIPTOR REGISTER 0 UISAR0 = 177640 ;USER I-SPACE ADDRESS REGISTER 0 UISAR7 = 177656 ;USER I-SPACE ADDRESS REGISTER 7 UDSAR7 = 177676 ;USER D-SPACE ADDRESS REGISTER 7 UISDR0 = 177600 ;USER I-SPACE DESCRIPTOR REGISTER 0 PAR1 = 20000 ;Base address of PAR 1 PAR6 = 140000 ;Base address of PAR 6 PS = 177776 PR0 = 0*40 PR7 = 7*40 JB.NAM = 22 ;Offset in .GTJB area for job name JB.LIM = 2 ;Offset in .GTJB for priv hi limit JB.CTX = 10 ;Offset in .GTJB to impure area ptr V.MMU = 250 ;Vector for MMU traps V$ODF2 = 2 V$ODF1 = 4 V$REG = 12 V$END = 16 EMTVEC = 30 ;EMT vector SYSVER = 276 ;Fixed offset for release number MINREL = 5. ;A V05 release (or later) is required MINVER = 6. ;UPDATE version >= 6. required CONFIG = 300 ;System configuration word XMMON$ = 10000 ;If set, XM monitor SYSGEN = 372 ;Monitor sysgen word SYSJOB = 40000 ;System job support P1EXT = 432 ;Fixed offset for pointer to $P1EXT XALLOC = -6 ;Offset from $P1EXT to XALLOC FINDGR = -12 ;Offset from $P1EXT to FINDGR CONFG3 = 466 CF3.HI =100000 CF3.SI = 40000 CMDLEN = 510 ;Command length word for KMON CMDSTR = 512 ;Command string for KMON ;+ ; Some special character definitions for file specifications ;- SPACE = 040 PERIOD = 056 COLON = 072 EQUALS = 075 CM.UID = 140000 ;.CMAP request to enable U-D space ;+ ; Program section definitions ;- .ASECT . = $JSX .WORD NOVBG$ ;Don't allow VBGEXE to run itself . = $JSW .WORD ;VBGEXE uses overlay channel . = $USRTO .WORD ENDROT-2 . = 360 .WORD 360,0,0,0,0,0,0,0 ;+ ; Order the program sections ;- .PSECT .KERN.,I ;Section for instructions KERCOD:: .PSECT .DATA.,D ;Section for general data DATA:: .PSECT .TEXT.,D ;Section for ASCII text TEXT:: .PSECT .ENDRT,D ;+ ; Relocate pool handler to where VBGEXE's virt addr 0 used to be ;- RELPLH: MOV @#KISAR1,-(SP) ;Save kernel PAR1 so we can borrow it MOV @#UISAR7,@#KISAR1 ;Map it to user PAR7 MOV BASADR,R2 ;-> start of VBGEXE in kernel space MOV #<+20000+GTPOOL-RI.BEG>,R3 ;-> pool handler MOV #<+20000+ENDPLH-RI.BEG>,R4 ;-> pool handler end 10$: MOV (R3)+,(R2)+ ;Move a word of local pool handler CMP R3,R4 ;Are we done relocating pool handler? BLO 10$ ;Branch if not MOV (SP)+,@#KISAR1 ;Restore kernel PAR1 RETURN ENDROT:: .PSECT .VOVLY,I .PSECT .COPY.,D .EVEN .PSECT .MDFY.,D .PSECT .CTRL.,D ;Section for matching control lists CTRL:: .PSECT .LIST.,D ;Section for matching data LIST:: .PSECT .VDATA,D ;+ ; Data starts here ;- .PSECT .DATA. AREA: .BLKW 10. ;EMT parameter area WADR2: .WDBBK 7,$4KW,0,$28KW,$4KW,WS.MAP WNSIZ2 = WADR2+W.NSIZ WNRID2 = WADR2+W.NRID WNOFF2 = WADR2+W.NOFF WNLEN2 = WADR2+W.NLEN WNSTS2 = WADR2+W.NSTS VOVREG: .RDBBK </100> VOVWIN: .WDBBK 1,</100>,0,0,</100>,WS.MAP VOVSIZ = VOVWIN+W.NSIZ VOVRID = VOVWIN+W.NRID VOVOFF = VOVWIN+W.NOFF VOVLEN = VOVWIN+W.NLEN ;+ ; Virtual monitor image ;- $VMON $RMON,MODIFY,137 $VMON ,MODIFY, $VMON $CSW,MODIFY,0,80. $VMON ,MODIFY,0 $VMON ,MODIFY,0 $VMON ,MODIFY,0 $VMON ,MODIFY,0 $VMON ,MODIFY,0 $VMON BLKEY,MODIFY,0 $VMON CHKEY,MODIFY,0 $VMON $DATE,COPY $VMON DFLG,MODIFY,0 $VMON $USRLC,COPY $VMON QCOMP,MODIFY, $VMON SPUSR,MODIFY,0 $VMON SYUNIT,COPY $VMON SYSVER,COPY,,1,BYTE $VMON SYSUPD,COPY,,1,BYTE $VMON CONFIG,COPY $VMON SCROLL,MODIFY,0 $VMON TTKS,COPY $VMON TTKB,COPY $VMON TTPS,COPY $VMON TTPB,COPY $VMON MAXBLK,COPY $VMON E16LST,MODIFY,0 $VMON CNTXT,COPY $VMON JOBNUM,COPY $VMON SYNCH,MODIFY, $VMON LOWMAP,COPY,,10. $VMON USRLOC,COPY $VMON GTVECT,MODIFY,0 $VMON ERRCNT,COPY $VMON $MTPS,MODIFY, $VMON $MFPS,MODIFY, $VMON SYINDX,COPY $VMON STATWD,MODIFY,0 $VMON CONFG2,COPY $VMON SYSGEN,COPY $VMON USRARE,COPY $VMON ERRLEV,COPY,,1,BYTE $VMON IFMXNS,COPY,,1,BYTE $VMON EMTRTN,MODIFY,$RMON $VMON FORK,MODIFY,$RMON $VMON PNPTR,MODIFY,$PNAME $VMON MONAME,COPY,,2 $VMON SUFFIX,COPY $VMON SPSTAT,MODIFY,0 $VMON EXTIND,COPY,,1,BYTE $VMON INDSTA,COPY,,1,BYTE $VMON $MEMSZ,COPY $VMON ,MODIFY,0 $VMON $TCFIG,MODIFY, $VMON $INDDV,COPY $VMON MEMPTR,MODIFY,0 $VMON P1EXT,MODIFY, $VMON $TRPLS,MODIFY,0 $VMON GETVEC,MODIFY, $VMON DWTYPE,COPY ;Following added -- some may need to be modified $VMON TRPSET,COPY $VMON $NULJB,COPY $VMON IMPLOC,COPY $VMON KMONIN,COPY $VMON PROGDF,COPY,,1,BYTE $VMON $PROGF,COPY,,1,BYTE $VMON WILDEF,COPY,,1,BYTE $VMON JOBS,COPY,,1,BYTE $VMON $QHOOK,COPY $VMON $H2UB,COPY $VMON $XOFF,COPY $VMON $RTSPC,COPY $VMON CONFG3,COPY $VMON $TT2RM,COPY $VMON $THKPT,COPY $VMON $DECNT,COPY $VMON $XTTPS,COPY $VMON $XTTPB,COPY $VMON $SLOT2,COPY,,1,BYTE $VMON ,COPY,,1,BYTE $VMON SPSIZE,COPY ;+ ; End of fixed offset area ;- $VMON TTCNFG,MODIFY,0 $VMON EMTPRO,MODIFY,137 $VMON ,MODIFY, $VMON ,MODIFY,0,<<31.+2.>*2.> $VMON $PNAME,MODIFY,0,<31.*9.+4.> ;+ ; This is here to error in case program tries to use .INTEN ;- .SAVE .PSECT .MDFY. .IIF NDF .MDFY., .MDFY. = . $HALT$ = . - .MDFY. JSR R0,10$ ;R0 -> error message .ASCIZ "?VBGEXE-F-RMON fixed offset routine not supported" .EVEN 10$: .PRINT BISB #FATAL$,@#$USRRB ;Set the error level CLR R0 ;Flag the error exit .EXIT .INTN. = <. - .MDFY. - $HALT$>/2 .PSECT .COPY. .IIF NDF .COPY., .COPY. = . .IIF EQ ..VMON, .BYTE ^O377 . = . - 1 .REPT .INTN. .BYTE ^O100 ..VMON = ..VMON + 2 .ENDR .BYTE ^O377 .RESTORE ;+ ; Text starts here ;- .PSECT .TEXT. ;+ ;ERROR VBGPFF: .ASCII "?VBGEXE-F-"<200> NOTXM: .ASCIZ "Mapped monitor required" INTMSG: .ASCIZ "Internal error" INSMEM: .ASCIZ "Insufficient memory for region" ;- .EVEN ;+ ; Code starts here ;- .PSECT .KERN. ERRLO: .PRINT #VBGPFF ;Print "?VBGEXE-F-" prefix .PRINT @R1 ;Print error message BISB #FATAL$,@#$USRRB ;Set the error level CLR R0 ;Flag the error exit .EXIT .ENABL LSB VBGEXE:: MOV #AREA,R4 ;R4 -> AREA until VOVLY code .GVAL R4,#CONFIG ;Get monitor's configuration word BIT #XMMON$,R0 ;Are we running XM? BNE 10$ ;Branch if yes, we're ok ;+ ;ERROR .ERRLO NOTXM ;Say we require a mapped monitor ;- 10$: CALL ALLALL ;Find out size of largest memory chunk CMP R2,VOVSIZ ;Sufficient memory for VBGEXE overlay? BHIS 20$ ;Branch if so ;+ ;ERROR INSERR: .ERRLO INSMEM ;Region create failed ;- 20$: MOV R2,RGSIZ ;Try to get all of biggest chunk MOV #RGADR,R5 ;Point to temporary RDB CALL CRRG ;Allocate all of biggest chunk BCS FALLBK ;Try fall-back strategy if alloc fails CALL ALLALL ;Get size of next largest memory chunk BEQ 30$ ;There isn't any more memory CMP R2,VOVSIZ ;Is there enough for VBGEXE's overlay? BHIS 40$ ;Branch if so 30$: CALL ELRG ;Return temporary region to system BCS INTERR ;Error cannot happen SUB VOVSIZ,RGSIZ ;Make room for VBGEXE's overlay BLOS FALLBK ;If not enough, try fall-back strategy CALL CRRG ;Create temp region to hold memory and ; /V region for possible use by job BCS FALLBK ;Try fall-back strategy if alloc fails 40$: CALL ALLVOV ;Create a region for VBGEXE extended ; memory code BCC GETVOV ;Read VBGEXE's overlay and go to it FALBKE: CALL ELRG ;Dump temp region, we're done with it BCC FALLBK ;Eliminate can't fail ;+ ;ERROR INTERR: .ERRLO INTMSG ;Internal error ;- FALLBK: MOV #IOREG,R5 CALL CRRG ;Attach to I/O page to hold /V region BCS INTERR ;Internal error if this fails CALL ALLVOV ;Create a region for VBGEXE extended ; memory code BCS INSERR ;Insufficient memory if alloc fails GETVOV: .READW R4,#17,#20000,#/2,#</1000> BCS INTERR JMP @#VOVLY ALLVOV: MOV R5,-(SP) ;Save R5 MOV #VOVREG,R5 ;R5 -> RDB CALL CRRG ;Create a region for VBGEXE extended ; memory code MOV (SP)+,R5 ;*C* Restore R5 BCS 50$ ;Branch if region create failed MOV VOVREG,VOVRID ;Point window to region to map .CRAW R4,#VOVWIN ;Create and map window BCS 50$ ;Return with carry set .BR ELRG ;Detach (region is now avail for /V) ELRG: .ELRG R4,R5 ;Eliminate region 50$: RETURN CRRG: .CRRG R4,R5 ;Create region RETURN ALLALL: MOV R5,-(SP) ;Save R5 MOV #RGADRT,R5 ;R5 -> RDB CALL CRRG ;Get size of largest free chunk MOV (SP)+,R5 ;*C* Restore R5 BCC INTERR ;This cannot happen MOVB @#$ERRBY,R1 ;R1 = error code CMP R1,# ;Error code must be ER.MEM BNE INTERR ;It cannot be anything else! MOV R0,R2 ;*C* C=0 here from CMP RETURN .DSABL LSB RGADRT: .RDBBK -1 RGADR: .RDBBK 0 RGSIZ = RGADR+R.GSIZ WADR1: .WDBBK 0,$4KW,0,0,$4KW,WS.MAP WNSIZ1 = WADR1+W.NSIZ WNRID1 = WADR1+W.NRID WNOFF1 = WADR1+W.NOFF WNLEN1 = WADR1+W.NLEN WNSTS1 = WADR1+W.NSTS ROTWIN: .WDBBK 0,,,,,WS.MAP ROTSIZ = ROTWIN+W.NSIZ ROTRID = ROTWIN+W.NRID ROTOFF = ROTWIN+W.NOFF ROTLEN = ROTWIN+W.NLEN RMON$: .WORD 0 ;-> $RMON (don't .PEEK every time!) CONTXT: .WORD 0 ;-> impure area BASADR: .WORD 0 ;Physical address of virt addr 0 IOREG: .RDBBK $4KW,,NAME=IOPAGE IOWIN: .WDBBK 7,$4KW,,0,$4KW,WS.MAP IOSIZ = IOWIN+W.NSIZ IORID = IOWIN+W.NRID IOOFF = IOWIN+W.NOFF IOLEN = IOWIN+W.NLEN KERRG1: .WORD 0 KERWIN: .WDBBK 2,$20KW,,$8KW,$20KW,WS.MAP KERSIZ = KERWIN+W.NSIZ KERRID = KERWIN+W.NRID KEROFF = KERWIN+W.NOFF KERLEN = KERWIN+W.NLEN .SBTTL CREATE AN EXTENDED MEMORY REGION ;+ ; CRRG0 - Create an extended memory region of requested size ; allocate a region in extended memor and fill in RCB 0 for it. ; ; R0 -> User Region Definition Block with the following fields set: ; R.GSIZ - Size of region requested ; ; .ADDR #CRRG0,-(SP) ;Get address PICly ; .CALLK ; ; C=0 if request successful ; C=1 if error ; output fields in Region Definition Block: ; R.GID - Region identifier ; R.GSTS - Region status word ; RS.CRR=1 if region created successfully ;- CRRG0: MOV CONTXT,R5 ;R5 -> impure area BIC #RS.CRR,R.GSTS(R0) ;Region not created yet MOV R.GSIZ(R0),R2 ;Get size requested BEQ 10$ ;Zero is invalid ; TRY TO ALLOCATE MEMORY FOR THE REGION. R2 = SIZE TO ALLOCATE. MOV @#$SYPTR,R1 ;Get pointer to fixed area MOV P1EXT(R1),R1 ;Get address of $P1EXT CALL XALLOC(R1) ;Allocate extended memory BCS 10$ ;Branch if not available, return error MOV @#KISAR1,-(SP) ;Save kernel PAR1 MOV KERRG1,-(SP) ;Save kernel region's RCB address I.MPT. =: . + 2 MOV I.MPTR(R5),-(SP) ;Save chunk address of job's MCA M.RGN. =: . + 2 MOV #,R5 ;R5 -> job's RCBs MOV R5,(R0)+ ;Return region id MOV R2,(R0)+ ; and size BIS #RS.CRR,@R0 ;Flag success MOV (SP)+,@#KISAR1 ;Map kernel PAR1 to job's MCA MOV R1,(R5)+ ;Store physical addr (R.BADD) MOV R2,(R5)+ ; and size (R.BSIZ) CLR (R5)+ ;Clear status byte and ; number of windows mapped M.WCB. =: . + 2 MOV #,R1 ;R1 -> WCBs MOV (SP)+,R0 ;Get kernel region's RCB address MOV R0,@R1 ;Static window is mapped there MOV @#UISAR0,W.BOFF(R1) ;Get User PAR0 for offset to ; begin mapping kernel INCB R.BNWD(R0) ;Say that 1 more window is mapped .ASSUME R.BADD EQ 0 ADD @R0,@#UISAR0 ;Should always add 0 to UISAR0 ; because kernel region starts at 0 MOV (SP)+,@#KISAR1 ;Restore kernel PAR1 MOV KERRG1,ROTRID ;Update WDB W.NRID information MOV @#UISDR0,R0 ;Get size of static window SWAB R0 ; to low byte BIC #177600,R0 ; and strip off other junk INC R0 ;Now it's really the size MOV R0,ROTSIZ ;Update WDB W.NSIZ MOV R0,ROTLEN ; and W.NLEN MOV @#UISAR0,R0 ; and W.NOFF MOV R0,ROTOFF TST (PC)+ ;Clear carry and return 10$: SEC ;Set carry and return RETURN VBGSTK ==: <. + 300> ;Start-up stack for VBGEXE . = .WORD 0 .ASSUME . GE VBGSTK .PSECT .VOVLY,I VOVLY:: .GTIM #AREA,#AREA ;Do day rollover CMP #,#ENDROT ;Is there enough kernel memory? BLOS 10$ ;Branch if so JMP INTERR ;Internal error 10$: ;+ ; Make sure we have the correct monitor support level ;- CHKVER: .GVAL #AREA,#SYSVER ;Get the version number SWAB R0 ;Make release high order for compare CMP R0,# ;Is release/version acceptable? BHIS 20$ ;Yes, carry on ;+ ;ERROR 10$: .ERRHI WVOFRT ;No, print wrong version message ;- 20$: MOV #GETJOB,R2 ;R2 -> data return area for .GTJB .GTJB #AREA,R2,#-1 ;Ask about our name MOV JB.CTX(R2),CONTXT ;CONTXT -> job's impure area ;+ ; Determine what program he wants us to run ;- MOV @#$JSW,JSWFLG ;Save CHAIN$ and VRUNV$ bits BIS #,JSWFLG ; and force VBGEX$ on BIC #^c,JSWFLG ;Isolate only those bits .ASSUME VBGEX$ EQ 200 TSTB @#$JSW ;Is KMON calling? BPL GETPRG ;Branch if not BIC #,@#$JSW ;For extra safety MOV #500,R3 ;R3 -> .RAD50 program dblk MOV #FILSPC,R1 ;R1 -> buffer for .ASCIZ file spec CALL DBKASC ;Convert program's dblk to .ASCIZ .PURGE #17 ;Purge the overlay channel .LOOKUP #AREA,#17,#500 ;Lookup the file on the overlay chan BCS 30$ ;Branch if file not found JMP FILFND ;KMON has already set up command lines 30$: ;+ ;ERROR .ERRHI NOFILE,FILE ;Not found; print a message and ;- GETPRG: CLR PMPTFL ;Assume we allowed to reprompt .CSTAT #AREA,#17,#CSTAT ;Get device of VBGEXE.SAV BCC GETPG1 ;Branch on success JMP INTERR ;Channel not open is internal error ERXITL: JMP ERRXIT GETPG1: .SRESET ;Release all fetched handlers MOV #GETJOB,R2 ;R2 -> .GTJB information TST PMPTFL ;Are we allowed to reprompt? BNE ERXITL ;Branch if not to exit with error TST @R2 ;Are we the background? BEQ 20$ ;Branch if we are ADD #JB.NAM,R2 ;R2 -> our job name MOV R2,R5 ;Assume it has been assigned TST @R2 ;If null then BEQ 40$ ; branch to prompt for job to load MOV #PROGID,R1 ;See if it is VBGEXE MOV #3,R0 ;Three words to compare 10$: CMP (R2)+,(R1)+ ;Is it VBGEXE? BNE 60$ ;Branch if it isn't SOB R0,10$ ;Do all three words of job name BR 40$ 20$: MOV #CMDLEN,R2 ;Point to command line buffer MOV (R2)+,R1 ;Get character count CMP R1,#1 ;Was anything passed? BLOS 40$ ;Branch if not .GTLIN #LINBUF,#0 ;Eat bogus .GTLIN line (command line) MOV #LINBUF,R5 ;Get set to copy command string 30$: MOVB (R2)+,(R5)+ ;Copy a byte SOB R1,30$ ;Branch if more bytes to copy BR 50$ 40$: ;It's VBGEXE so prompt for job to load .GTLIN #LINBUF,#PROMPT ;Ask him what program he wants 50$: MOV #LINBUF,R5 ;R5 -> Input string TSTB @R5 ;Null string? BNE 70$ ;Branch if not .PRINT #PROGID ;Print program version number BR GETPG1 ;Get another input string 60$: MOV SP,PMPTFL ;Say we aren't allowed to reprompt 70$: MOV #WHO,R2 ;R2 -> Area for file descriptor MOV #DEFEXT,R1 ;R1 -> Default file extension CALL GETFD ;Parse input and build file descriptor BCC 100$ ;Branch if valid file spec ;+ ;ERROR 80$: .PRINT #VBGPFW ;Print "?VBGEXE-W-" .PRINT #INVSPC ;Print invalid file spec error message ;- 90$: BR GETPG1 ;Get another input string 100$: TSTB @R5 ;Just program specified? BEQ 160$ ;Branch if yes TST GETJOB ;Is this the background? BNE 80$ ;Branch if not -- cannot do CCL style! MOVB #200,(R5)+ ;Put in special terminator MOV R5,R2 ;Save pointer MOV #X.BUFF,R1 ;Point to scratch buffer ;+ ; Copy first command word (terminated by or <0>) into scratch buffer ;- 110$: MOVB @R5,(R1)+ ;Move a byte BEQ 150$ ;Branch if null terminator CMPB (R5)+,#SPACE ;Was it a ? BNE 110$ ;Keep copying if not CLRB -(R1) ;Terminate scratch copy with null ;+ ; Copy second command word (terminated by or <0>) over first ;- 120$: MOVB (R5)+,@R2 ;Move a byte BEQ 130$ ;Branch if null terminator CMPB (R2)+,#SPACE ;Was it a ? BNE 120$ ;Keep copying if not DEC R2 ;Point to terminator byte 130$: MOVB -(R5),R0 ;Save second command word terminator MOVB #EQUALS,(R2)+ ;Stuff an "=" into string MOV #X.BUFF,R1 ;Copy first command word into org buff 140$: MOVB (R1)+,(R2)+ ;Move a byte BNE 140$ ;Until we hit null terminator MOVB R0,(R5)+ ;Replace original terminator 150$: MOV #RUNCMD,R5 ;Point to "RUN VBGEXE" command JMP STUFIT ;Go re-issue command 160$: TST @R2 ;Did user specify a device name? BNE 170$ ;Branch if he did MOV #<^RSY >,@R2 ;Try SY: first CALL GETFIL ;Open file on channel 17 BCC FILFND ;Branch if we are successful MOV #<^RDK >,@R2 ;SY: failed so try DK: 170$: CALL GETFIL ;LOAD device and open file on chan 17 BCC FILFND ;Branch if we are successful ;+ ;ERROR .PRINT #VBGPFW ;Print "?VBGEXE-W-" .PRINT #NOFILE ;Not found; print a message .PRINT #FILSPC ; with file spec BR 90$ ; and try again ;- FILFND: CLR KERFLG ;Say I/O page is not mapped ;+ ; Check for /V overlays in program and if present, do initialization ;- .ENABL LSB VRAW: MOV #<$32KW>,RGSIZ ;Set default space for region MOV #X.BUFF,R2 ;R2 -> Buffer to get block 0 .READW #AREA,#17,R2,#256.,#0 ;Read block 0 BCC 10$ ;Branch if read succeeded ;+ ;ERROR .ERRHI RDERR,FILE ;Print error ;- 10$: .ASSUME H.HAN EQ 0 CMP @R2,# ;Is job a handler? BEQ 20$ ;If so, can't use VBGEXE BIT #,$JSX(R2) ;Is job prohibited from running ; under VBGEXE? BEQ 30$ ;Branch if not ;+ ;ERROR 20$: .ERRHI NOVBG,FILE ;Print error ;- 30$: CLR ROOTSZ ;Assume no /V overlays ;I&D+ CLR IDSPAC ;Assume I-space only job CLR IROTSZ ;Assume no /V overlays MOV $JSX(R2),R0 ;Get explicit 64KB BIC #^C,R0 ; allocation flag MOV $VIRTO(R2),VIRTOP ;Save job's $VIRTO CMP $VIRTO(R2),#157776 ;Is job's virtual high limit in PAR 7? BLOS 40$ ;Branch if not MOV #,R0 ;Force 64KB allocation 40$: MOV $USRTO(R2),USRTOP ;Get top of job CLR XWCNT ;Assume we don't need kernel read CLR XIWCNT ;Assume we don't need kernel read MOV USRTOP,R3 ;Get size of job's root CLC ;Change byte count ROR R3 ; to word count ADC R3 ;Round up for odd byte count INC R3 ; and add in last word CMP R3,# ;Will job fit with 1 read? BLOS 50$ ;Branch if so MOV R3,XWCNT ;Size of total read MOV #,R3 ;Size of first read SUB R3,XWCNT ;Size of extra read 50$: MOV R3,WCNT ;Save size of first read CMP $USRTO(R2),#157776 ;Does job load into PAR 7? BLOS 60$ ;Branch if not MOV #,R0 ;Force 64KB allocation 60$: MOV R0,ALL64K ;Set 64KB allocation flag accordingly CMP SV.SID(R2),# ;Is job I and D separated? BNE 70$ ;Branch if not TST SV.NID(R2) ;Is separated I&D disallowed? BEQ 80$ ;Branch if not ;+ ;ERROR .ERRHI FORBID,FILE ;Print error ;- 70$: BIT #,$JSX(R2) ;Is ZB/ZM monitor required? BEQ 100$ ;Branch if not 80$: .GVAL #AREA,#CONFG3 ;Check for monitor support BIC #^C,R0 ;Isolate supervisor/I&D support bits CMP #,R0 ;Running system supports I&D space? BEQ 90$ ;Branch if so ;+ ;ERROR .ERRHI NOID,FILE ;No I&D support in running system ;- 90$: CMP SV.SID(R2),# ;Is job I and D separated? BNE 100$ ;Branch if not MOV SP,IDSPAC ;We are loading an I and D space job MOV #,230$ ;Change segment # initialization MOV #<$60KW>,RGSIZ ;Increase default space for region ;I&D- 100$: MOV $USRTO(R2),-(SP) ;/V root size ;I&D+ MOV SV.OVR(R2),R4 ;R4 -> $OVTAB (overlay handler tables) MOV SV.SEG(R2),R1 ;/V overlays? TST IDSPAC ;I&D space separated job? BEQ 150$ ;Branch if not MOV SV.BLK(R2),R3 ;Get block number of I-space block 0 CLC ; and ROR R3 ; decode it BCC 110$ ;Even SV.BLK is invalid format BNE 120$ ;SV.BLK = 1 is invalid format too ;+ ;ERROR 110$: .ERRHI INVFMT,FILE ;Print invalid format error ;- 120$: MOV R3,IBLK0 ;Save it for loading I-space code MOV R2,R5 ;R5 -> buffer .READW #AREA,#17,R5,#256.,R3 BCS 170$ ;Branch if read failed CMP $USRTO(R5),#157776 ;Does job load into PAR 7? BLOS 130$ ;Branch if not MOV #,ALL64K ;Force 64KB allocation 130$: MOV $USRTO(R5),IROTSZ MOV $USRTO(R5),IPHI ;Save I-space high limit for later MOV $USRPC(R5),STADDR ;Save transfer address MOV IPHI,R3 ;Get size of job's root CLC ;Change byte count ROR R3 ; to word count ADC R3 ;Round up for odd byte count INC R3 ; and add in last word CMP R3,# ;Will job fit with 1 read? BLOS 140$ ;Branch if so MOV R3,XIWCNT ;Size of total read MOV #,R3 ;Size of first read SUB R3,XIWCNT ;Size of extra read 140$: MOV R3,IWCNT ;Save size of first read ;I&D- 150$: TST R4 ;/V overlays? BNE 160$ ;Branch if /V overlays JMP 250$ ;Jump if no /V overlays 160$: SUB #V$END,R4 ;First address we need MOV R4,R2 ;Make another copy CLRB R2 ;Compute block SWAB R2 ; number in which ROR R2 ; V$END lies MOV R2,-(SP) ;Save block number MOV R2,-(SP) ;Save block number MOV #X.BUFF,R5 ;R5 -> buffer .READW #AREA,#17,R5,#1000,R2 170$: BCS 200$ ;Branch if read failed BIC #177000,R4 ;Compute offset in buffer ADD R5,R4 ;R4 -> start of WDBs ;I&D+ MOV (R4),$ODF1 ;Save starting location to init MOV (R4),$ODF2 ;Save first address not to init ;I&D- TST R1 ;/V overlays? BNE 180$ ;Branch if /V overlays JMP 240$ ;Jump if no /V overlays 180$: ADD #2000,R5 ;R5 -> word after buffer ADD #,R4 ;R4 -> RDB for /V region TST 2(R4) ;Is size of /V region zero? BEQ 240$ ;Branch if yes; no /V overlays .CRRG #AREA,R4 ;Create the /V region BCS INSERL ;Branch if create region failed CALL MAPKER ;Map PAR 2-7 to kernel MOV @SP,R2 ;Get block number SWAB R2 ;Compute an ASL R2 ; absolute address MOV CONTXT,R1 ;R1 -> our impure area ADD I.MPT.,R1 ;R1 -> chunk address of job's MCA MOV @R1,@#UISAR0+<6*2> ;Map to PAR 6 MOV @R4,R1 ;Get PAR1 biased pointer to RCB MOV (R1),@SP ;Get chunk address of /V region MOV #<1400>,@#UISAR0+<6*2> ;Remap the way we were MOV -(R4),R1 ;Get address of start of WDBs ADD #W.NOFF,R1 ;R1 -> offset into region to ; start mapping MOV -(R4),R4 ;Get address of end of WDBs SUB R2,R1 ;Convert .SAV image pointers SUB R2,R4 ; to offsets within buffer MOV #X.BUFF,R2 ;R2 -> start of buffer ADD R2,R1 ;Convert offsets within ADD R2,R4 ; buffer to pointers within buffer MOV 2(SP),R2 ;R2 = block number 190$: CMP R1,R5 ;Is WDB offset word in the buffer? BLO 220$ ;Branch if it is MOV #X.BUFF,R3 ;R3 -> buffer ADD #2,R2 ;Add 2 to block number .READW #AREA,#17,R3,#1000,R2 BCC 210$ ;Branch if read succeeded ;+ ;ERROR 200$: .ERRHI RDERR,FILE ;Print error ;- INSERL: JMP INSERR ;Insufficient memory error 210$: SUB R5,R3 ;Calculate amount to bias pointers ADD R3,R1 ;Bias pointers into ADD R3,R4 ; new buffer BR 190$ ;Rejoin code to clear segment ids 220$: ADD @R1,@SP ;Add offset to start of region address MOV @SP,@#UISAR0+<6*2> ;Map to PAR 6 MOV (PC)+,@(PC)+ ;Clear segment id -- it's not resident 230$: .WORD 0 .WORD 140000 MOV #<1400>,@#UISAR0+<6*2> ;Remap the way we were SUB @R1,@SP ;Compute start of region address again ADD #W.NLGH,R1 ;Point to next WDB at W.NOFF word CMP R1,R4 ;Are there any more WDBs? BLO 190$ ;Branch if yes MOV 4(SP),ROOTSZ ;Save hi limit for mapping calculation 240$: CMP (SP)+,(SP)+ ;Pop 2 words from stack 250$: TST (SP)+ ;Pop 1 word from stack 260$: CALL MAPKER ;Map PAR 2-7 to kernel if not already .DSABL LSB ;+ ; Calculate the size of the job's root region. It is 32KW if /V overlays ; are not used. Else it is the amount indicated by the job's high limit ; plus 4KW. ;- SIZREG: MOV ROOTSZ,R3 ;Any /V overlays? BNE 10$ ;Branch if so CLR IROTSZ ;Mark IROTSZ no /V too ; (ignored if not I&D space job) BR 30$ ;Use default root size 10$: CLC ;Round up ROR R3 ; to word ADC R3 ; basis ADD #10000,R3 ;Round up to fill BIC #7777,R3 ; up whole PAR SWAB R3 ;Divide ASL R3 ; by ASL R3 ; 32. ASL R3 ; to get chunk size MOV R3,ROOTSZ ;Round up ROOTSZ ;I&D+ TST IDSPAC ;Is job I&D separated? BEQ 20$ ;Branch if not MOV IROTSZ,R3 ;Any /V overlays? CLC ;Round up ROR R3 ; to word ADC R3 ; basis ADD #10000,R3 ;Round up to fill BIC #7777,R3 ; up whole PAR SWAB R3 ;Divide ASL R3 ; by ASL R3 ; 32. ASL R3 ; to get chunk size MOV R3,IROTSZ ;Round up IROTSZ ADD ROOTSZ,R3 ;I&D- 20$: ADD #200,R3 ;Include VMON in region size MOV R3,RGSIZ ;Store size of region in RDB 30$: ;I&D+ TST IDSPAC ;Do we need separate I-D mapping? BEQ 40$ ;Branch if no TST ALL64K ;Separate I-D mapping for PAR 7? BEQ 40$ ;Branch if no ADD #<$4KW>,RGSIZ ;Increase space for region 40$: ;I&D- ;+ ; Create a region in which to load the job ;- VMON: MOV BASADR,-(SP) ;Get base physical address of this job ADD #CRRG0,@SP ;@SP -> Create region 0 routine MOV BASADR,R0 ;Get base physical address of this job ADD #RGADR,R0 ;R0 -> region definition block .CALLK ;Create a region for job BCS INSERL ;Branch if create region failed ;+ ; Map virtual monitor (top 4KW of job). ;- MAPTOP: .ELRG #AREA,#IOREG ;Eliminate local I/O page region MOV RGADR,WNRID2 ;Tell create window which region MOV RGSIZ,R3 ;Get size of region SUB #$4KW,R3 ;Calculate offset to start mapping MOV R3,WNOFF2 ;Store offset in WDB .CRAW #AREA,#WADR2 ;Window and map top 4KW of region BCS INSERL ;Branch if .CRAW failed -- error ;Fall through to next block ;+ ; Get block 0 into memory ;- BLOCK0: MOV #X.BLK0,R2 ;R2 -> Buffer to get block 0 .READW #AREA,#17,R2,#256.,#0 ;Read block 0 BCC 10$ ;Branch if read succeeded ;+ ;ERROR .ERRHI RDERR,FILE ;Print error ;- 10$: ;Fall through to the next block ;+ ; Load the pseudo monitor image ;- LODMON: MOV RMON$,R2 ;R2 -> $RMON MOV #.COPY.,R3 ;R3 -> RMON Instruction stream MOV #.MDFY.,R4 ;R4 -> Change values table MOV #X.RMON,R5 ;R5 -> Pseudo monitor location MOV @$TCFIG(R2),TTCNFG(R4) ;Copy terminal SET option status word 10$: MOVB (R3)+,R0 ;R0 = instruction code CMPB R0,#377 ;End of table? BEQ 60$ ;Branch if yes ROLB R0 ;Get word/byte indicator in carry BCS 30$ ;Branch if byte mode ROLB R0 ;Get copy/modify indicator in carry BCS 20$ ;Branch if modify type MOV (R2)+,(R5)+ ;Move RMON entry into VMON TST (R4)+ ;Skip over modification table entry BR 50$ 20$: TST (R2)+ ;Skip over real RMON entry MOV (R4)+,(R5)+ ;Move in modification to VMON BR 50$ 30$: ROLB R0 ;Get copy/modify indicator in carry BCS 40$ ;Branch if modify type MOVB (R2)+,(R5)+ ;Move RMON entry into VMON TSTB (R4)+ ;Skip over modification table entry BR 50$ 40$: TSTB (R2)+ ;Skip over real RMON entry MOVB (R4)+,(R5)+ ;Move in modification to VMON 50$: BR 10$ ;Continue building VMON 60$: MOV RMON$,R2 ;R2 -> $RMON ADD PNPTR(R2),R2 ;R2 -> $PNAME table MOV R2,R3 ;R3 -> $PNAME table 70$: MOV (R2)+,R0 ;Search for -1 at end of $ENTRY table CMP R0,#-1 ;Found it? BNE 70$ ;Branch if not TST -(R2) ;Back up to -1 marker SUB R3,R2 ;R2 = size of $PNAME + $ENTRY tables SUB R2,R3 ;Calculate start of SUB #8.,R3 ; real $UNAM1 table MOV #,R4 ;R4 -> VMON $PNAME table location SUB R2,R4 ;Calculate start of fake SUB #8.,R4 ; $UNAM1 table in VMON ASR R2 ;R2 = byte size of $PNAME table ASR R2 ;R2 = word size of $PNAME table MOV R2,R0 ;Multiply contents of R2 by ASL R2 ; 11. and add 8. storing the ADD R2,R0 ; result in R2. This is the total ASL R2 ; word size of $UNAM1,$UNAM2,$PNAME, ASL R2 ; $ENTRY,$STAT,$DVREC,$HSIZE, ADD R0,R2 ; $DVSIZ, and $DVINT tables ADD #8.,R2 80$: MOV (R3)+,(R4)+ ;Move real device tables to fake ones SOB R2,80$ ;+ ; Copy the vectors and stuff from locations 0 to 77 ;- COPVEC: MOV #X.VEC,R4 ;R4 -> Buffer to store vectors CLR R3 ;R3 -> start of vector area (loc. 0) 10$: MOV (R3)+,(R4)+ ;Copy a word CMP R3,#100 ;More to do? BLO 10$ ;Branch if so ;+ ; Relocate the read-in/initialization code ;- RELOC: MOV @#$JSX+X.BLK0,JSX ;Save job's $JSX MOV @#$JSX+2+X.BLK0,JSX2 ;Save job's $JSX+2 MOV #/2,R2 ;# of words of data to move .ADDR #KST,R3 ;-> beginning of source data .ADDR #$KST,R4 ;-> beginning of destination data 10$: MOV (R3)+,(R4)+ ;Move a word SOB R2,10$ ;Loop until all are copied MOV #RI.BEG,R3 ;R3 -> old GTPOOL & READIN code MOV #X.LOAD,R4 ;R4 -> new GTPOOL & READIN code 20$: MOV (R3)+,(R4)+ ;Move a word up there CMP R3,#RI.END ;Are we all done? BLO 20$ ;No, then continue ;I&D+ TST IDSPAC ;Do we need separate I-D mapping? BEQ 60$ ;Branch if no .CMAP #AREA,#CM.UID ;Turn on user data space BIS #,@#WNSTS1 ;Indicate that WADR1 .WDBBK is I and D BIS #,@#WNSTS3+ ;Indicate that WADR3 ; .WDBBK is I-space TST ALL64K ;Separate I-D mapping for PAR 7? BEQ 60$ ;Branch if no MOV IROTSZ,R3 ;Get size of root if /V BNE 30$ ; and branch MOV #$28KW,R3 ; else 28KW offset is I-space PAR 7 30$: MOV R3,WNOFF2 ;Store offset to I-space PAR 7 in WDB BIS #,WNSTS2 ;Indicate window is for I-space .CRAW #AREA,#WADR2 ;Window and map I-space PAR 7 BCC 40$ ;Branch if .CRAW is successful JMP INSERR ;Insufficient memory error 40$: .POKE #AREA,#PS,#170000,BIS ;Make sure previous mode is user MOV #160000,R3 ;Need to copy D-space PAR 7 MOV #10000,R4 ; to I-space PAR 7 50$: MFPD @R3 ;Get a D-space word MTPI (R3)+ ; and put it in I-space SOB R4,50$ ;Continue until PAR 7 copy done ;I&D- 60$: JMP @#READIN+ ;Go to the read-in code .SBTTL MAP PAR 2-7 TO KERNEL .ENABL LSB MAPKER: TST KERFLG ;Are we already mapped to kernel? BNE 30$ ;Branch if yes .ASSUME I.STATE EQ 0 .PEEK #AREA,CONTXT ;R0 = I.STATE word in impure area MOV R0,R1 ;R1 = I.STATE word in impure area BIS #WINDW$!VLOAD$,R1 ;Force virtual and VBGEXE load phase .POKE #AREA,CONTXT,R1 ;Replace I.STATE word with mods .CRRG #AREA,#IOREG ;Attach to I/O page BCS 10$ MOV IOREG,IORID ;Point to region to map .CRAW #AREA,#IOWIN ;Map PAR 7 to I/O page BCS 10$ ;Error mapping to I/O page MOV @#UISAR0,R1 ;Get base physical ASH #6,R1 ; address of this job MOV R1,BASADR ;Save base physical add of this job .SETTOP #-4 ;Ask for all of memory ADD #2,R0 ;R0 -> first unavailable word ADD R1,R0 ;Get kernel addr of first unavail word MOV R0,HIPTR ;Tell pool handler about it .CRRG #AREA,#KERREG ;Attach to "KERNEL" BCS 10$ ;Error mapping kernel MOV KERREG,KERRG1 MOV KERREG,KERRID ;Point to region to map .CRAW #AREA,#KERWIN ;Map PAR 2 to PAR 6 to "KERNEL" BCC 20$ ;Branch on success 10$: JMP INTERR 20$: .PEEK #AREA,#$SYPTR ;Get pointer to RMON MOV R0,RMON$ ; and save it for lots of future use! MOV SP,KERFLG ;Say that kernel is mapped GETOFF: ADD MEMPTR(R0),R0 ;R0 -> CORPTR ADD #<6.>,R0 ;Index into RESORC/VBGEXE offset list MOV (R0)+,I.MPT. ;Get I.MPTR (offset to MCA chunk ptr) TST (R0)+ ;Skip # of regions and windows ADD (R0)+,M.RGN. ;Get M.RGN (MCA offset to RCBs) ADD (R0)+,M.WCB. ;Get M.WCB (MCA offset to WCBs) TST (R0)+ ;Skip M.APR (MCA offset to APRs) MOV @R0,I.VHI. ;Get I.VHI (offset to virt. hi limit) 30$: RETURN .DSABL LSB .SBTTL GET FILE DESCRIPTOR SUBROUTINE ;+ ; GETFD - Get a file descriptor from the input string and ; store 4 words of Radix 50 information of the form: ; .RAD50 "DEV" ; .RAD50 "FILNAM" ; .RAD50 "EXT" ; ; R1 -> Default extension ; R2 -> Output area (4 words) ; R5 -> Input string ; ; CALL GETFD ; ; R2 -> Output area ; R5 -> Character which delimits file specification ;- GETFD:: MOV R2,-(SP) ;Save R2 (later restored into r0) CLR (R2)+ ;Clear device name field DEC R5 ;GETNM1 will pre-increment R5 pointer CALL GETNAM ;Look for name BEQ 40$ ;Null file spec CMPB @R5,#COLON ;Device name followed by colon BNE 10$ ;Not colon, so not a device name TST 2(R2) ;Test for only 3 characters in name BNE 40$ ;Error in device name MOV @R2,-2(R2) ;Save device name CALL GETNAM ;Now look for file name BEQ 40$ ;Error in file name 10$: CMP (R2)+,(R2)+ ;Point to extension field MOV @R1,@R2 ;Assume default CMPB @R5,#PERIOD ;If period, extension follows BNE 20$ ;No extension CALL GETNM1 ;Get extension 20$: TSTB @R5 ;Null terminator? BEQ 30$ ;File spec properly terminated CMPB @R5,#SPACE ;Blank terminator? BNE 40$ ;File spec not properly terminated 30$: TST (PC)+ ;Clear carry and skip "SEC" 40$: SEC ;Set carry to indicate error MOV (SP)+,R2 ;*C* R2->4-word Rad50 file descriptor RETURN .SBTTL GET NAME SUBROUTINE ;+ ; GETNAM - Convert a sequence of 0 to 6 alphanumerics to Rad50. ; A 2-word result is stored at the place pointed to by R2. ; The result is padded with 0's (Rad50 blank) if < 6 characters. ; ; R2 -> 2-word result area ; R5 -> Source string ; ; CALL GETNAM ; ; R0 = Undefined ; R5 -> Character that delimited the name ; Condition code 'zero' if name is all zeros ;- GETNAM: CALL GETNM1 ;Get the first 3 assembled CMP (R2)+,(R2)+ ;GETNM1 returns R2-2 DEC R5 ;Get next 3 by falling into ;GETNM1 which will return with ;R2 correct and Z-bit flag GETNM1: MOV #3,R0 ;Set character count CLR @R2 ;Init output area INC R5 10$: DEC R0 ;Adjust counter for later JSR R0,40$ ;Save r0 and for PIC address of table .ASCII "09" ;Range for 0-9 20$: .ASCII "AZ" ;Range for A-Z .BYTE 'A+40,'Z+40 ;Range for a-z (lower case) 30$: .WORD -22 ;Rad50 adjust amount for 0-9 .WORD -100 ;Rad50 adjust amount for A-Z .WORD -140 ;Rad50 adjust amount for a-z, (l.c.) 40$: CLR -(SP) ;Init location for next Rad50 char 50$: CMPB (R0)+,@R5 ;Is character in range? BHI 60$ ;No, or at end of table, fill with 0's CMPB (R0)+,@R5 ;Check other end of range BLT 50$ ;Try next set MOVB @R5,@SP ;Get the character ADD 30$-20$(R0),@SP ;Adjust the character to Rad50 INC R5 ;Point to next character 60$: ASL @R2 ;Multiply ASL @R2 ; total ASL @R2 ; by 50 ADD @R2,@SP ; to make room ASL @R2 ; for the ASL @R2 ; new character ADD (SP)+,@R2 ;Add new character to total ; as low order MOV (SP)+,R0 ;Get loop count word BNE 10$ ;Do 3 characters TST -(R2) ;For GETNAM to adjust R2 and set Z RETURN ;+ ; GETFIL - Open file on channel 17 whose file desciptor is pointed to by R2 ;- .ENABL LSB GETFIL: MOV R2,R3 ;R3 -> .RAD50 program dblk MOV #FILSPC,R1 ;R1 -> buffer for .ASCIZ file spec CALL DBKASC ;Convert program's dblk to .ASCIZ .PURGE #17 ;Close the overlay channel .DSTAT #DSTAT,R2 ;Get info about device BCC 10$ ;Branch if device exists ;+ ;ERROR MOV R2,R3 ;R3 -> .RAD50 program dev MOV #DEVSPC,R1 ;R1 -> buffer for .ASCIZ dev spec CALL DEVASC ;Convert prog's .RAD50 dev to .ASCIZ .PRINT #VBGPFW ;Print "?VBGEXE-W-" .PRINT #INVDEV ;Give invalid device error .PRINT #DEVSPC ; with device spec ;- TST (SP)+ ;Get rid of return address JMP GETPG1 ; and try again 10$: ;+ ; We cannot run unless the program's device handler is loaded! ;- TST DSTAT+4 ;Is device loaded? BEQ 20$ ;Branch if not .LOOKUP #AREA,#17,R2 ;Lookup the file on the overlay chan RETURN 20$: MOV R2,R3 ;R3 -> RAD50 word to convert MOV #LOADEV,R1 ; to ASCII at LOADEV CALL R50ASC ;Do RAD50 to ASCII conversion MOV #LDCMD,R5 ;Point to LOAD dev/RUN VBGEXE TST GETJOB ;Is this the background? BEQ STUFIT ;Branch if it is ;+ ;ERROR MOVB #COLON,(R1)+ CLRB @R1 .PRINT #VBGPFX ;Print "?VBGEXE-F-" .PRINT #NODEV ;Say that device .PRINT #LOADEV ; is not loaded ;- JMP ERRXIT STUFIT: MOV #CSTAT+8.,R3 ;R3 -> unit # of VBGEXE.SAV's device MOV (R3)+,R1 ;Get unit # of VBGEXE.SAV's device MOV @R3,R0 ;Get VBGEXE.SAV's device name CALL DEVTR ;R0 = .RAD50 physical device spec MOV R0,@R3 ;Store in CSTAT area MOV #RUNDEV,R1 ;Point to end of device name buffer CALL R50ASC ;Do RAD50 to ASCII conversion MOV #CMDSTR,R0 ;Point to area for command string CLR R2 ;Init counter register CALL MOVCMD ;Move into chain area MOV #LINBUF,R5 ;Point to edited command string CALL MOVCMD ;Move into chain area MOV R2,@#CMDLEN ;Put in low memory CLR R0 ;Indicate hard exit BIS #SPXIT$,@#$JSW ;Indicate command to do .EXIT ; and exit .DSABL LSB LDCMD: .ASCII "$LOAD " LOADEV: .ASCII "xxx" ;xxx is device spec of program .BYTE 200 RUNCMD: .ASCII "$RUN " RUNDEV: .ASCIZ "xxx:VBGEXE" ;xxx is device spec for VBGEXE .EVEN MOVCMD: INC R2 ;Count char MOVB (R5)+,@R0 ;Copy command string BEQ 10$ BICB #200,(R0)+ BR MOVCMD 10$: INC R0 RETURN .SBTTL R50ASC: RAD50 TO ASCII CONVERSION ;+ ; Input: R3 -> RAD50 word to convert ; R1 -> ASCII char output area ;- R50ASC: MOV #SPACE,-(SP) ;Put on stack CMPB (R1)+,(R1)+ ;Skip 2 bytes MOVB @SP,@R1 ;Put in the MOVB @SP,-(R1) ; 3 bytes starting where MOVB (SP)+,-(R1) ; R1 began without changing R1 R50AS1: MOV (R3)+,R0 ;Get RAD50 word to convert MOV R3,-(SP) ;Save pointer MOV R2,-(SP) MOV #DIVTAB,R3 ;R3 -> table of divisors 10$: MOV #-1,R2 ;Init quotient accumulator 20$: INC R2 ;Increment quotient SUB @R3,R0 ;Subtract out divisor BHIS 20$ ;Branch if more subtracts ADD (R3)+,R0 ;Add back divisor to get remainder TST R2 ;Character is a blank? BEQ 50$ ;Yes CMP #33,R2 ;Dollar sign, period, or digit? BLO 30$ ;Period or digit BEQ 40$ ;Dollar sign ADD #40,R2 ;Else alpha (A-Z) or question mark ADD #16,R2 30$: ADD #11,R2 40$: ADD #11,R2 MOVB R2,(R1)+ ;Store converted character in output 50$: TST @R3 ;Any more RAD50 characters? BNE 10$ ;Branch if more MOV (SP)+,R2 MOV (SP)+,R3 ;Restore pointer RETURN ; Radix 50(8) Power Table DIVTAB: .WORD 3100 ;50(8)^2 .WORD 50 ;50(8)^1 .WORD 1 ;50(8)^0 .WORD 0 ;Table terminator .ENABL LSB DEVASC: CALL R50AS1 ;Convert "dev" MOVB #COLON,(R1)+ ;Append ":" BR 10$ ; and terminate as .ASCIZ DBKASC: CALL DEVASC ;Convert "dev:" CALL R50AS1 ;Convert "fil" CALL R50AS1 ;Convert "nam" MOVB #PERIOD,(R1)+ ;Insert "." CALL R50AS1 ;Convert "typ" 10$: CLRB @R1 ; and make string .ASCIZ RETURN .DSABL LSB .SBTTL DEVTR - SYSLIB service routine ;+ ; ; Translates RAD50 device name (one or two character) and BINARY unit number ; to RAD50 format of device name and unit number. ; ; INPUT ; R0 = RAD50 dev name, one or two character ; R1 = Binary unit number ; ; This routine assumes that if the device name is two characters, ; then the unit number is 7 or less. It does not chop off the ; second letter of a passed device name. ; ; It does, however, insert a zero for units less than or equal to ; 7, when a one-letter device name is passed. ; ; OUTPUT ; R0 = RAD50 dev name + unit number ; R1 = Destroyed ; ; OUTPUT FORMAT: ; ; DDn - any device with device unit # 0 - 7 ; Dnn - 64 unit device with unit # 10 - 77 ; ;- DEVTR: MOV R0,-(SP) ;Copy for type determination 10$: SUB #<^RA >,@SP ;Is it one or two character? BHI 10$ ;Loop to determine BNE 20$ ;Branch if two-character (not 64unit) ; A one-letter (64-unit) name has been found, do proper unit conversion. ADD R1,R0 ;Add low_ord_unit + high_ord_unit*10 BIC #^C70,R1 ;Isolate high_ord_unit*10 ASL R1 ;High_ord_unit*20 ASL R1 ;High_ord_unit*40 ADD #<^R 0 >,R0 ;Add base RAD50 zero for high digit 20$: ADD #<^R 0>,R0 ;Add base RAD50 zero for low digit ADD R1,R0 ;Add (high_ord_unit*40) to accumulator ;Result = letter + ; TST (SP)+ ;Fix stack RETURN ;Done .PSECT .VDATA,D X.BUFF: .BLKW 256.*2 ;Buffer for /V overlay initialization DEFEXT: .RAD50 "SAV" ;Type is a .SAV file LINBUF: .BLKB 134. ;Area to get .GTLIN line CSTAT: .BLKW 6. ;Area for channel status DSTAT: .BLKW 4. ;Area for device status WHO: .BLKW 4. ;The program we are to run KERFLG: .WORD 0 ;0 <=> not mapped to kernel PMPTFL: .WORD 0 ;non-0 to prevent reprompting GETJOB: .BLKW 12. ;Area for get job job block .BYTE 0 ;Null terminator of job name string DEVSPC: .ASCIZ "dev:" PROMPT: .ASCII "Program? "<200> VBGPFW: .ASCII "?VBGEXE-W-"<200> ;+ ;ERROR INVDEV: .ASCII "Invalid device "<200> NODEV: .ASCII "Handler not loaded "<200> NOFILE: .ASCII "File not found "<200> WVOFRT: .ASCIZ "Wrong version of RT-11" INVSPC: .ASCIZ "Invalid file specification" NOID: .ASCII "Fully mapped monitor required for "<200> INVFMT: .ASCII "Invalid I-D space file format "<200> FORBID: .ASCII "Cannot run with separated I-D space "<200> NOVBG: .ASCII "Cannot run in completely virtual environment "<200> ;- .EVEN PROGID: .NLCSI .EVEN ;+ ; ---------------------------------------------------------------------------- ; ; Read-in code, relocated somewhere in PAR7 ; ; The following code is moved to X.LOAD before being executed. Therefore, ; any absolute memory references must be relocated. ;- RI.BEG: .SBTTL POOL HANDLER ;+ ; R0 = number of bytes of memory requested ; R1 = 0 if pool is unrestricted ; R1 = 1 if pool is restricted to non-PAR1 space only ; ; CALL GTPOOL ; ; R2 = address of start of memory allocated ; C = 0 means memory was allocated successfully ; C = 1 means memory was not allocated ;- .ENABL LSB GTPOOL:: BR HIBND ;Do once-only relocation code ; TST R0 ;Anything requested? BEQ 40$ ;Branch if so (C clear from "TST R0") MOV HIPTR,R2 ;We'll need this later MOV R2,LOBND ;Set up allocation limits MOV LOPTR,HIBND ; for non-PAR1 restricted request MOV #40000,-(SP) MOV R1,-(SP) MOV #20000,R1 TST (SP)+ ;Is request PAR1 restricted? BEQ 20$ ;Branch if not PAR1 restricted CMP R2,R1 BLOS 10$ MOV R1,LOBND ;Change allocation limits 10$: CMP HIBND,@SP BHIS 20$ MOV @SP,HIBND ; for PAR1 restricted request 20$: SUB (SP)+,R2 ;Compute amount of pool above PAR1 BLOS 30$ ;Branch if there isn't any SUB LOPTR,R1 ;Compute amount of pool below PAR1 BLOS 50$ ;Branch if there isn't any CMP R1,R2 ;Is area below PAR1 smaller ; than area above? BHI 50$ ;Branch if not ;+ ; The smallest existing chunk is below PAR1 or is non-existant ;- 30$: CALL ALLOLO ;Try low pool allocation BCS ALLOHI ;On failure, try high pool allocation 40$: RETURN ;+ ; The smallest existing chunk is above PAR1 ;- 50$: CALL ALLOHI ;Try high pool allocation BCC 40$ ;If allocation succeeds, return .BR ALLOLO ;Try low pool allocation ALLOLO: .ADDR #LOPTR,R1 ;R1 -> LOPTR MOV @R1,R2 ;R2 = address of allocated area ADD R0,@R1 ;Allocate requested amount of pool BCS 60$ ;Not enough pool CMP LOBND,@R1 ;Is there enough pool for request? ;C=1 => "lower than" => no ;C=0 => "higher than or same" => yes BCC 70$ ;Branch if yes 60$: MOV R2,@R1 ;*C* Restore pool pointer 70$: RETURN ALLOHI: .ADDR #HIPTR,R1 ;R1 -> HIPTR MOV @R1,R2 ;Save original HIPTR in case we fail SUB R0,@R1 ;Attempt to allocate pool BCS 80$ ;If wrap around, not enough pool CMP @R1,HIBND ;Is there enough pool for request? ;C=1 => "lower than" => no ;C=0 => "higher than or same" => yes BCC 90$ ;Branch if allocation succeeds 80$: MOV R2,@R1 ;*C* Restore pool pointer 90$: MOV @R1,R2 ;R2 = address of allocated area RETURN LOPTR: .WORD FREMEM-FREMEM ;Address of first free location LOBND: .WORD 0 ;Address of first unavailable location HIPTR: .WORD 0 ;Address of first unfree location HIBND: MOV PC,-(SP) ;Address of first available location FREMEM: ADD (SP)+,LOPTR MOV #,GTPOOL ;Patch once-only code with "TST R0" BR GTPOOL MAPIOP: JSR R3,100$ ;R3 -> I/O page WDB and save job's SP .WDBBK 7,$4KW,,0,$4KW,WS.MAP 100$: TST (SP)+ ;Throw away saved R3 ;I&D+ TST IDSPAC+<$KST-KST> ;Is job I&D separated? BEQ 110$ ;Branch if not -- no D-space to do BIS #,W.NSTS(R3) ;Set both I and D spaces in WDB 110$: ;I&D- MOV R4,W.NRID(R3) ;Put region ID in WDB .ADDR #KAREA,R0 ;R0 -> programmed requests area .CRAW R0,R3 ;Map to I/O page BR 120$ ;*C* Branch with C-bit as error flag DSPJOB: CLC ;Set error flag off 120$: BIT (SP)+,(SP)+ ;*C* Dump return address and PS MFPD @#$USRSP ;*C* Get the job's SP MTPI SP ;*C* Set job's SP in user mode SP MOV #<170000>,@SP ;*C* Replace PS with dispatch PS MFPD @#$USRPC ;*C* Replace PC with dispatch PC MOV @#KISAR1,-(SP) ;Save Kernel PAR 1 MOV SP,ERRSTK ;*C* Save SP in case of error BCS 180$ ;Branch on error MOV #+20000,R3 ;R3 -> kernel buffer MOV #X.LMBK,R2 ;Get overflow block number MOV XWCNT+<$KST-KST>,R5 ;R5 = # of words to read/move BEQ 140$ ;Branch if no read to do MOV @#UISAR7,R4 ;Assume I&D not separated ;I&D+ TST IDSPAC+<$KST-KST> ;Is job I&D separated? BEQ 130$ ;Branch if not MOV @#UDSAR7,R4 ;Separated so read into D-space 130$: ;I&D- CALL MVK2U ;Read and move into user memory 140$: ;I&D+ TST IDSPAC+<$KST-KST> ;Is job I&D separated? BEQ 150$ ;Branch if not ADD IBLK0+<$KST-KST>,R2 ;Get I-space overflow block MOV XIWCNT+<$KST-KST>,R5 ;R5 = # of words to read/move BEQ 150$ ;Branch if no read to do MOV @#UISAR7,R4 ;Always read into I-space CALL MVK2U ;Read and move into user memory 150$: ;I&D- ;+ ; Should we purge the overlay channel? ;- MFPD @#$JSW ;Get job's $JSW BIT #,(SP)+ ;Is this overlaid? BNE 160$ ;Yes, then fall through .PURGE #17 ;Purge the overlay channel 160$: ;Fall into next block ;I&D+ TST IDSPAC+<$KST-KST> ;Is job I&D separated? BEQ 210$ ;Branch if not MOV $ODF1+<$KST-KST>,R1 ;Get starting location of /O overlays 170$: CMP R1,$ODF2+<$KST-KST> ;Past the end (or no /O overlay)? BHIS 210$ ;Branch if so MOV (PC)+,-(SP) ;Get a "RETURN" RETURN MTPI (R1)+ ; and store it in I-space BR 170$ ;Loop until done ;I&D- 180$: .ADDR #VBGPFX+<$KST-KST>,R0 ;Get address of "?VBGEXE-F-" prefix .PRINT ; and print it .ADDR #INTMG1+<$KST-KST>,R0 ;Get address of "Internal error" BR 200$ ;Print it and take error exit 190$: .ADDR #VBGPFX+<$KST-KST>,R0 ;Get address of "?VBGEXE-F-" prefix .PRINT ; and print it .ADDR #RDERR+<$KST-KST>,R0 ;Get address of "Input error" .PRINT ; and print it .ADDR #FILSPC+<$KST-KST>,R0 ;Get address of file spec 200$: .PRINT ; and print it MOV ERRSTK,SP ;Dump garbage from stack CLR @SP ;Return to user mode hard exit MFPD @#$ERRBY ;-(SP) = $ERRBY and $USRRB BISB #FATAL$,@SP ;Set the error level MTPD @#$ERRBY ;$ERRBY and $USRRB = (SP)+ 210$: MOV (SP)+,@#KISAR1 ;Restore kernel PAR 1 RTI ;Hard exit through user location 0 MVK2U: .ADDR #KAREA,R0 ;R0 -> programmed requests area MOV R4,@#KISAR1 ;Map kernel PAR1 buffer to user buffer .READW R0,#17,R3,R5,R2 ;Read in job BCS 190$ ;Branch on error RETURN $KST: ;Data that is copied from end of PAR 7 code to here and then into kernel code .BLKW 35. $KEND: ENDPLH: ;ERRSTK:.WORD 0 ;Kernel SP for error processing ;KAREA: .BLKW 10. ;Area for kernel programmed requests ERRSTK = . ;Kernel SP for error processing KAREA = ERRSTK + <1*2> ;Area for kernel programmed requests KTOP = KAREA + +2 ;Top of pool handler and kernel code .DSABL LSB ;Table of vectors to copy COPTBL: .WORD 0 .WORD 2 .WORD 32 .WORD 52 .WORD -1 ;Table of vectors to load from save image SAVTBL: .WORD 14 .WORD 16 .WORD 20 .WORD 22 .WORD 34 .WORD 36 .WORD 40 .WORD 42 .WORD 44 .WORD 46 .WORD -1 KERREG: .RDBBK $28KW,,NAME=KERNEL TOTWSZ: .WORD $24KW ;Chunk size to map of root ; (excludes static window and ; virtual monitor) WADR3: .WDBBK 1,$4KW,0,$4KW,$4KW,WS.MAP WNAPR3 = WADR3+W.NAPR WNBAS3 = WADR3+W.NBAS WNSIZ3 = WADR3+W.NSIZ WNRID3 = WADR3+W.NRID WNOFF3 = WADR3+W.NOFF WNLEN3 = WADR3+W.NLEN WNSTS3 = WADR3+W.NSTS WADR4: .WDBBK 0,$4KW,0,0,$4KW, WNAPR4 = WADR4+W.NAPR WNBAS4 = WADR4+W.NBAS WNSIZ4 = WADR4+W.NSIZ WNRID4 = WADR4+W.NRID WNOFF4 = WADR4+W.NOFF WNLEN4 = WADR4+W.NLEN .ENABL LSB READIN: MOV #X.STACK,SP ;Now use VBGEXE's high memory stack MOV @#CONTXT,R5 ;R5 -> impure area .ADDR #X.AREA,R1 ;R1 -> EMT area BIT #,@# ;Does job load over chain data? BNE 20$ ;Branch if yes MOV #,R2 ;Get pointer to copy chain data 10$: MOV -X.BLK0(R2),(R2)+ ;Copy a word of chain data CMP R2,# ;Copied all of 500-776 yet? BLO 10$ ;Branch if not 20$: BIC #,@# ;Turn off bits we ;need to load BIS JSWFLG,@# ;Load CHAIN$, VBGEX$, and VRUNV$ ;+ ; Window the job's root to the bottom of job's root region. We use WCB 0 ; so that we're creating the virtual job's static region. ; Also, change the JSW to indicate a virtual job. ;- .ELRG R1,#VOVREG BCS INTER1 ;Branch on error MOV @#RGADR,@#WNRID1 ;Tell create window which region MOV @#RGADR,WNRID3 ;Tell create window which region MOV @#RGADR,WNRID4 ;Tell create window which region MOV ROOTSZ,R3 ;Get total size of root (less VMON) ;I&D+ TST IDSPAC ;Is job I&D separated? BEQ 30$ ;Branch if not MOV IROTSZ,R3 ;Get total size of root (less VMON) 30$: TST R3 ;I&D- BEQ 40$ ;Branch if no /V overlays SUB #$4KW,R3 ;Subtract off static window (PAR 0) MOV R3,TOTWSZ ;Store total size of auxiliary window 40$: MOV @#BASADR,R2 ;Get base physical address of this job MOV R2,-(SP) ;Save for .CALLK to DSPJOB later ADD #,@SP ;-> Dispatch routine ADD #RELPLH,R2 ;-> Relocate pool handler routine .CRAW R1,#WADR1 ;Create static window and map it BCS INTER1 ;Branch on error .CALLK R2 ;Relocate pool handler .ADDR #X.AREA,R1 ;R1 -> EMT area (always) 50$: TST TOTWSZ ;Anything to map? BEQ 70$ ;Branch if not CMP #$4KW,TOTWSZ ;Is there at least a full PAR's worth? BLOS 60$ ;Branch if yes MOV TOTWSZ,WNSIZ3 ;Shorten the amount to window and map MOV TOTWSZ,WNLEN3 ;Shorten the amount to window and map 60$: .ADDR #WADR3,R2 ;Point PICly to WDB .CRAW R1,R2 ;Create another window for next PAR INTER1: BCS INTER2 ;Branch on error SUB WNSIZ3,TOTWSZ ;Subtract the size that we just mapped INCB WNAPR3 ;Increment to next APR ADD #20000,WNBAS3 ;Change base virtual addr to next PAR ADD #$4KW,WNOFF3 ;Change offset in region to next 4KW BR 50$ ;Create windows as necessary 70$: ;I&D+ TST IDSPAC ;Is job I&D separated? BEQ 120$ ;Branch if not MOV STADDR,@# ;Save real transfer address MOV IROTSZ,WNOFF4 ;Get amount of region to skip over BNE 80$ ; if /V overlays MOV #$28KW,WNOFF4 ; if no /V overlays (no VMON) 80$: TST ALL64K ;Separate I-D mapping for PAR 7? BEQ 90$ ;Branch if no ADD #$4KW,WNOFF4 90$: MOV ROOTSZ,R4 ;Get total chunk size of D-space BNE 100$ ;Branch if we got it MOV #$32KW,R4 ;Else it's a full 32KW 100$: CMP #$4KW,R4 ;Is there at least a full PAR's worth? BLOS 110$ ;Branch if yes MOV R4,WNSIZ4 ;Shorten the amount to window and map MOV R4,WNLEN4 ;Shorten the amount to window and map 110$: .ADDR #WADR4,R2 ;Point PICly to WDB .CRAW R1,R2 ;Create another window for next PAR BCS INTER2 ;Branch on error INCB WNAPR4 ;Increment to next APR ADD #20000,WNBAS4 ;Change base virtual addr to next PAR ADD #$4KW,WNOFF4 ;Change offset in region to next 4KW SUB WNSIZ4,R4 ;Subtract the size that we just mapped BNE 100$ ;Create windows as necessary 120$: ;I&D- .ADDR #KERREG,R2 .ELRG R1,R2 ;Detach local region from KERNEL BCC 130$ ;Branch on success INTER2: JMP INTER3 ;Internal error 130$: MOV #X.BLK0,R2 ;R2 -> block 0 buffer ;+ ; Transfer valid block 0 data into the jobs image. ;- CLR R3 ;R3 -> virtual vectors 140$: CLR (R3)+ ;Clear a word CMP R3,#100 ;More vectors to clear? BLO 140$ ;Branch if yes .ADDR #COPTBL,R4 ;R4 -> table of vectors to copy 150$: MOV (R4)+,R3 ;R3 = next vector to copy BMI 160$ ;Branch if we're done MOV X.VEC(R3),@R3 ;Copy a vector BR 150$ ;Loop 160$: .ADDR #SAVTBL,R4 ;R4 -> table of vectors to load 170$: MOV (R4)+,R3 ;R3 = next vector to load BMI 180$ ;Branch if we're done MOV X.BLK0(R3),@R3 ;Copy a vector BR 170$ ;Loop 180$: MOV #100,R3 ;R3 -> virtual 100 MOV R2,R4 ;R4 -> block 0 buffer ADD R3,R4 ;R4 -> load area 190$: MOV (R4)+,(R3)+ ;Move a word CMP R3,#1000 ;More words to copy? BLO 190$ ;Branch if yes MOV WCNT,R3 ;Get size of job's root BIT #,JSX ;Does job require I/O page? BEQ 200$ ;Branch if not CMP R3,#70000 ;Does I/O go into PAR 7? BHI 220$ ;Branch if so -- error 200$: SUB #256.,R3 ;We're not reading block 0 .ASSUME GE RI.LAS:: .READW R1,#17,#1000,R3,#1 ;Read in job (except for block 0) BCC 230$ ;Branch if read succeeds ;+ ;ERROR 210$: .ERRHI RDERR,FILE ;Report read error with file spec 220$: .ERRHI IOPOVR,FILE ;Report trying to load over I/O page ;- 230$: ;I&D+ TST IDSPAC ;Is job I&D separated? BEQ 260$ ;Branch if not BIT #,JSX ;Does job require I/O page? BEQ 240$ ;Branch if not CMP IWCNT,#70000 ;Does I/O go into PAR 7? BHI 220$ ;Branch if so -- error 240$: .READW R1,#17,#0,IWCNT,IBLK0,BMODE=UI ;Read in job ; (including block 0) BCS 210$ ;Branch if read fails .POKE R1,#PS,#170000,BIS ;Make sure previous mode is user MOV #100,R3 250$: MFPD -(R3) MTPI @R3 TST R3 BNE 250$ 260$: ;I&D- .DSABL LSB ;+ ; Make the system communication area match the new program. ;- MATCH0: MOV #X.RMON,@#$SYPTR ;Now set his pointer to pseudo RMON MOV #X.RMON+EMTPRO,@#EMTVEC ;Point to a pseudo EMT catcher BIS #,@#$JSW ;Force this job to be VBGEXE virtual .ASSUME I.STATE EQ 0 .PEEK R1,R5 ;R0 = I.STATE word in impure area MOV R0,R4 ;R4 = I.STATE word in impure area BIC #,R4 ;Indicate that VBGEXE is gone away BIS #,R4 ;Force virtual and purely virtual .POKE R1,R5,R4 ;Replace I.STATE word with mods I.VHI. =: . + 2 ADD #I.VHI,R5 ;R5 -> job's virtual high limit word .POKE R1,R5,VIRTOP ;Set job's virtual high limit .ASSUME I.VSTP EQ I.VHI+2 ADD #,R5 ;Point to VBGEXE .SETTOP high limit ;JFW add CODE=NOSET next line .POKE R1,R5,# ;Set job's VBGEXE .SETTOP high limit .SETTOP USRTOP ;Set job's high limit ;Note that this will set loc 50 also MOV JSX,R4 ;Get job's $JSX BIS ALL64K,R4 ;Use implicit 64KB allocation BIT #,R4 ;Does job want a valid VMON? BEQ 20$ ;Branch if yes MOV #-1,@#$SYPTR ;Put a bad pointer in virt system ptr MOV #-1,@#EMTVEC ;Put a bad pointer in virt EMT vector BIT #,R4 ;Does job want I/O page mapped? BNE 20$ ;Branch if yes -- ignore ALL64$ ;JFW+ ; ; this patch allows specifying the highest address that settop ; will return in location 6 of the file, if it is non-zero it is ; used as the highest allowed address; if zero (and ALL64$ set) ; then -2 is used. For a full implementation, the actual ; memory allocation when the region is created would be controlled ; by this value too. ; Maybe this should be "somewhat" independent of ALL64$? ; MOV JSX2,-(SP) ;top address specified? BNE 10$ ;yes MOV #X.TOP,@SP ;Not specified, use default 10$: ;JFW add CODE=NOSET next line and change ,R5, to ,, .POKE R1,R5,(SP)+ ;Set job's VBGEXE .SETTOP high limit ;JFW- 20$: ;+ ; Start the virtual job we've loaded! ;- START: .RCTRLO ;Guarantee JSW update BIT #,R4 ;Does job want I/O page mapped? BEQ 10$ ;Branch if not .ADDR #IOREG1,R4 ;R4 -> RDB for IOPAGE global region .CRRG R1,R4 ;Attach to I/O page BCS INTER3 ;Branch on error MOV @R4,R4 ;Get region ID ADD #,@SP ;-> map I/O page and dispatch routine 10$: .CALLK ;Go map I/O page and dispatch to job ;+ ;ERROR INTER3: .ERRHI INTMG1 ;Report internal error ;- ERRHI: .ADDR #VBGPFX,R0 ;Get address of "?VBGEXE-F-" prefix .PRINT ; and print it MOV R1,R0 ;Get address of ADD (R1)+,R0 ; error message .PRINT ;Print error message MOV @R1,R0 ;Get device or file spec to print BEQ ERRXIT ;Branch if not specified ADD R1,R0 ;Calculate address of spec .PRINT ; and print it ;+ ; Error exit code ;- ERRXIT: BISB #FATAL$,@#$USRRB ;Set the error level CLR R0 ;Flag the error exit .EXIT ;+ ; Data relocated along with the code ;- X.AREA: .BLKW 10. JSWFLG: .WORD 0 ;CHAIN$ and VRUNV$ from caller ; plus VBGEX$ always set IPHI: .WORD 0 ;Program's high limit STADDR: .WORD 0 ;Program's transfer address IROTSZ: .WORD 0 ;I-space root size ROOTSZ: .WORD 0 ;Root size if not I&D separated ;D-space root size if I&D separated WCNT: .WORD 0 ;Word size of D-space user mode read IWCNT: .WORD 0 ;Word size of I-space user mode read ALL64K: .WORD 0 ;Implicit 64KB allocation flag JSX: .WORD 0 ;Copy of job's $JSX JSX2: .WORD 0 ;Copy of job's $JSX+2 USRTOP: .WORD 0 ;Copy of job's $USRTO VIRTOP: .WORD 0 ;Copy of job's $VIRTO IOREG1: .RDBBK $4KW,,NAME=IOPAGE ;+ ;ERROR IOPOVR: .ASCII "Attempt to load over I/O page "<200> ;- .EVEN ;Data that is needed to be copied into kernel code KST: IBLK0: .WORD 0 ;Block number of I-space block 0 XWCNT: .WORD 0 ;Word size of D-space kernel read XIWCNT: .WORD 0 ;Word size of I-space kernel read $ODF1: .WORD 0 ;-> beginning of /O overlays $ODF2: .WORD 0 ;-> past end of /O overlays IDSPAC: .WORD 0 ;I&D separated job if not zero ;+ ;ERROR VBGPFX: .ASCII "?VBGEXE-F-"<200> RDERR: .ASCII "Input error "<200> FILSPC: .ASCIZ "dev:filnam.typ" INTMG1: .ASCIZ "Internal error" ;- .EVEN KEND: .ASSUME LE <$KEND-$KST> RI.END == . .ASSUME LE VOVEND == . .END VBGEXE