.MCALL .MODULE .MODULE VM,VERSION=37,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. .SBTTL Conditional assembly summary ;+ ;COND ; VM$BAS (1600) for SJ/FB default base address ; (7600) for XM default base address ; ; SD$$VM (0) Standard handler ; 1 Merged with SD to form VD ; ; VM$NAM (^rVM ) Handler (and region) name (SD$$VM=0) ; (^rVD ) Handler (and region) name (SD$$VM=1) ; ; MMG$T std conditional ; TIM$T std conditional (no code effects) ; ERL$G std conditional (no code effects) ;- .IIF NDF MMG$T,MMG$T = 0 ; Has memory management been defined? .IF NDF VM$BASE .IF EQ MMG$T VM$BASE =: 1600 ; SJ/FB default is 16/18 bit boundary. .IFF VM$BASE =: 7600 ; XM default is 18/22 bit boundary. .ENDC ;EQ MMG$T .ENDC ;NDF VM$BASE .IIF NDF SD$$VM SD$$VM =: 0 .IF NE SD$$VM .IIF NDF VM$NAM VM$NAM =: <^rVD > .IFF .IIF NDF VM$NAM VM$NAM =: <^rVM > .ENDC .SBTTL Psect ordering .PSECT VMDVR ; Memory resident part .PSECT DBG$I I ; For VD .PSECT DBG$PD D ; ... .PSECT DBG$PB D .PSECT DBG$D D .PSECT DBG$SY D .PSECT DBG$SZ D .PSECT DBG$BD D .PSECT ZZDVR I ; ... .PSECT VMBOOT ; Bootstrap .PSECT PAD001 ; Filler for block alignment .PSECT SETOVR ; Aligned LOAD code .ENABL LC .NLIST BEX .SBTTL General comments ; "Faster than a speeding bullet..." ; -Clark Kent ;+ ; VM.SYS is a handler to access extended memory on PDP 11's with the ; KT11 memory management unit as a disk device. ; ; Author: ; RB 01-May-75 ; With random assistance from AC and HJ ; ; Edits: ; CG 15-Aug-79 V04 format and bootstrap. ; CG 13-Jul-80 Fix bootstrap and memory sizing problems. ; LCP 03-Dec-81 V05 device code (47). ; GLA 13-Sep-82 Automatic 18/22 bit addressing selection. ; GLA 13-Sep-82 Rewrote memory sizing (totally). ; GLA 14-Sep-82 General V5 cleanup and edit level support. ; GLA 18-Sep-82 Added support for operation under XM. ; MBG 06-Feb-83 Check transfer request against device size. ; GLA 21-Feb-83 Fix problems with 2K I/O page om MSV11-D. ; GLA 22-Feb-83 Added support for systems with parity memory. ; MBG 22-Jun-83 Added zero fill for use under XM. ; JFW 20-Oct-83 added code for PRO (treat as Q22) ; MBG 13-Dec-83 Fixed XM IO code as per SPR #58520 ; LB 04-OCT-84 Added VMX booting, redid upper boundary test ; GLA 19-OCT-84 Switched to use RT-11 V5.2 global region ; DBB 10-MAR-86 Fix disk boundary checks & memory wrap ; JFW 27-Jun-86 Added COND comment and .Assumes ; JFW 14-Jul-87 Added VM$NAM conditional ; Changed lots of numbers to symbols ; Cleaned up comments ; Renumbered local symbols ; Moved one-time code to FETCH/LOAD routines ; Reduced memory size (174 -- 124 FB / ; 209 -- 82 XM) ; Added .DRTAB pointer to SET objects ; JFW 12-Oct-87 Changed reference to Q.PAR to Q.MEM for V5.5 ; Added code to revert to Q.PAR if <5.5 ; JFW 05-Jan-88 Fix problem introduced in previous change ; that broke SET VM BASE (and SIZE) ; JFW 10-Jun-88 Fix seek crash. ; JFW 06-Jul-88 Remove redundant BEQ instructions, since ; seeks are filtered out early, no need to ; test for them again. ; Add use of SYSTEM.MLB. ; JFW 29-Jul-88 Added SET VM [NO]INSTALL command ; Added test to disallow install if CA installed ; (SJ and FB) ; JFW 09-AUG-88 Reverted to always referencing Q.PAR and ; marked handler as DMA=NO. ; ; JFW 20-Aug-88 Changed to allow VM to be merged with SD for ; a combination debugger and system device to ; be used in monitor debugging. ; ; JFW 23-Jan-89 Allow I/O only to VM0, all other units error ; ; JFW 07-Jun-1990 use VD_$ region name for VD version ;- .SBTTL Macros and Definitions .MCALL .DRDEF,.PRINT,.ADDR,.DSTAT .MCALL .ASSUME,.BR,.CKXX .CKXX .CKXX .CKXX .LIBRARY "SRC:SYSTEM" .MCALL ..READ,..WRIT,.FIXDF,.GRBDF,.HANDF .MCALL .MEMDF,.SYCDF,.HS2DF ..READ ,<=:> ..WRIT ,<=:> .FIXDF ,<=:> FIX$ED = 0 ;allow definition of variable parts .GRBDF ,<=:> .HANDF ,<=:> .HS2DF ,<=:> .MEMDF ,<=:> .SYCDF ,<=:> .IF EQ MMG$T MMVEC =: 250 ; Use real vector when not XM .IFF ; EQ MMG$T .IF EQ SD$$VM MMVEC =: 0 ; No vector for VMX .IFF ; EQ SD$$VM MMVEC =: 014 ; BPT vector for VDX .ENDC ; EQ SD$$VM .ENDC ; EQ MMG$T .DRDEF VM,47,FILST$,0,177572,MMVEC,DMA=NO .DRPTR FETCH=LOAD,LOAD=LOAD .DREST CLASS=DVC.DK ;+ ; Vectors ;- V.TRP4 =: 004 ; Trap to 4 vector. V.TRP10 =: 010 ; Bus timeout / CPU err V.BPT =: 014 ; Break point trap vector V.IOT =: 020 ; IOT vector V.MPTY =: 114 ; Memory parity trap vector. V.MMU =: 250 ; Memory management vector ;+ ; I/O page ;- KISDR0 =: 172300 ; Kernel I desc reg 0. AP$ACG =: 37406 ; Active PAR, 4K with no SYS/TRAP abort action AP$ACF =: 77406 ; Active PAR, 8K with no SYS/TRAP abort action KISDR7 =: 172316 ; Kernel I desc reg 7. KISAR0 =: 172340 ; Kernel I addr reg 0. KISAR1 =: 172342 ; Kernel I addr reg 1. KISAR7 =: 172356 ; Kernel I addr reg 7. NUMPAR =: 8. ; Number of PAR registers MMSR3 =: 172516 ; Status reg 3. MODE22 =: 000020 ; 22-bit addressing mode. MMSR0 =: 177572 ; Status reg 0. MM0PLE =: 040000 ; Abort, page length error MMUON =: 000001 ; enable MMU TTCSR =: 177560 ; Console first CSR address MMSR1 =: 177574 ; Status reg 1. MMSR2 =: 177576 ; Status reg 2. UISDR0 =: 177600 ; User I desc reg 0. UISDR7 =: 177616 ; User I desc reg 7. UISAR0 =: 177640 ; User I addr reg 0. UISAR7 =: 177656 ; User I addr reg 7. PS =: 177776 ; Processor status word. UMODE =: 140000 ; Current mode = user (in PS). PUMODE =: 030000 ; Previous mode = user mode (in PS). PR0 =: 000000 ; PS priority 0 PR7 =: 000340 ; PS priority 7. CARRY =: 000001 ; PS carry PARADR =: 20000 ; Span of a PAR address CHUNK =: 100 ; Chunk size CHK4KW =: PARADR/CHUNK ; Chunks in 4KW CHK2KW =: PARADR/2/CHUNK ; Chunks in 2KW CHK18 =: 7600 ; Chunks in 18 bit addr space PARCHK =: PARADR/CHUNK ; Span of a PAR address in chunks IOPAGE =: 160000 ; 16bit addr of IOPage IOPCHK =: 177600 ; 22bit addr of IOPage in chunks ;+ ; Misc. references ;- BLKBYT =: 1000 ; Bytes in a block BLKWDS =: BLKBYT/2 ; Words in a block BLKOFS =: 777 ; Offset in block mask UNIMSK =: 7 ; Unit bits in queue element JUNK =: 153535 ; Junk data pattern S.SP =: 1000 ; "Std" Stack test value S.NTRY =: 2000 ; $ENTRY(VM) test value S.DRBG =: 4000 ; BASE test value S.PNAM =: 0200 ; $PNAME test value S.VMSZ =: 0100 ; $DVSIZ(VM) test value S.VALU =: 0040 ; SET code value test value S.CONS =: 0020 ; SET code constant test value OLD.PC =: 0 ; Stack offset after interrupt OLD.PS =: 2 ; Stack offset after interrupt .SBTTL Text area for set code .ASECT . = 120 ;+ ; Message used to warn user that VM needs re-installing ;- REINST: .ASCIZ "?VM-W-Remove and reinstall this handler" .EVEN .Assume . LE H.DCSR-2,<;Area BEFORE install overflow> .SBTTL Set code ;+ ; Define set options ;- .IF EQ SD$$VM .DRSET BASE,1600,S.BASE,OCT .ENDC ;EQ SD$$VM .DRSET INSTALL,,S.INST,NO .DRSET SIZE,17777,S.SIZE,NUM .IF EQ SD$$VM ;+ ; Code to set handler base. ;- Ck.R0=S.VALU Ck.R3=S.CONS Ck.R0 S.VALU Ck.R3 S.CONS S.BASE: CMP R0,R3 ; Is the base in low memory? BLO ERRRET ; Yes, then take error exit. Ck.R0 S.VALU CMP R0,V.BASE ; Is the base actually changing? BEQ NORRET ; No, then forget the warning. ;+ ; First we update the boot block to reflect new BASE ;- BTBASE = ++H.BEG .REM % ;reestablish if boot mod location ; moves out of block 1 .ADDR #BAREA+A.BUF,R1 ; R1->EMT area for reads/writes Ck.R1=BAREA+A.BUF .ADDR #VMSTRT,R2 ; R2->Buffer area for reads/writes ; (overwrites in-core copy of block 1) Ck.R2=VMSTRT Ck.R2 VMSTRT Ck.R1 BAREA+A.BUF MOV R2,@R1 ; Set the buffer address Ck.R1 BAREA+A.BLK,-2 MOV #BTBASE/BLKBYT,-(R1) ; and the block to read/write Ck.R1 ,-2 TST -(R1) ; R1-> EMT area Ck.R1 BAREA MOV R0,R3 ; Save base value elsewhere Ck.R3=Ck.R0 MOV R1,R0 ; R0->EMT area Ck.R0=Ck.R1 Ck.R0 BAREA EMT ...REA ; *** .READW *** ; (Read in the boot block) Ck.R0=JUNK BCS ERRRET ; In case of read error... Ck.R2 VMSTRT Ck.R3 S.VALU MOV R3,BTBASE&BLKOFS(R2) ; Set B.BASE in bootstrap MOV R1,R0 ; R1->EMT area Ck.R0=Ck.R1 .Assume .WRIT EQ .READ+1 INCB A.CODE(R0) ; Change from read to write Ck.R0 BAREA EMT ...WRI ; *** .WRITW *** ; Write out the updated boot block Ck.R0=JUNK BCS ERRRET ; In case of write error... MOV R1,R0 ; R0->EMT area Ck.R0=Ck.R1 Ck.R0 BAREA .Assume .READ EQ .WRIT-1 DECB A.CODE(R0) ; Change from write back to read Ck.R0 BAREA MOV #1,A.BLK(R0) ; of block 1 Ck.R0 BAREA EMT ...REA ; *** .READW *** ; (Read in block 1 of handler) Ck.R0=JUNK BCS ERRRET ; In case of read error ;if this code reinstated, delete next two instructions % MOV R0,R3 ; Save base value elsewhere Ck.R3=Ck.R0 Ck.R3 S.VALU MOV R3,B.BASE ; Set B.BASE in bootstrap ;end of area to delete on reinstatement Ck.R3 S.VALU MOV R3,V.BASE ; Set base in the I/O code Ck.R3 S.VALU MOV R3,I.BASE ; and in the installation code BR PRINT .ENDC ;EQ SD$$VM ;+ ; Code for SET VM [NO]INSTALL ;- .ENABL LSB S.INST: ; SET VM INSTALL BR 10$ ; and go clear bits NOP ; filler S.NOIN: .Assume S.NOIN EQ S.INST+4 BIS R3,H.STS2 ; Set no install bits BR NORRET ; normal return 10$: BIC R3,H.STS2 ; Clear no install bits BR NORRET ; normal return .DSABL LSB ;+ ; Code for SET VM SIZE=n ;- ; R0 = # of blocks that user is setting VM for ; R3 = maximum number of blocks that VM can be Ck.R0=S.VALU Ck.R3=S.CONS Ck.R0 S.VALU Ck.R3 S.CONS S.SIZE: CMP R0,R3 ; Asking for too much? BHI ERRRET ; Branch if yes ASL R0 ; Convert number ASL R0 ; of blocks ASL R0 ; to number of chunks CMP R0,I.SIZE ; Is user changing size specification? BEQ NORRET ; Branch if not MOV R0,I.SIZE ; Save new media size in I.SIZE PRINT: .ADDR #REINST,R0 ; R0 = address of the message (PIC) .PRINT ; Yes, then remind him to reinstall NORRET: TST (PC)+ ; Clear the carry \ skip next inst ERRRET: SEC ; Set the carry RETURN ; Return to monitor ;+ ; EMT area for reads/writes of the handler file for use in ; updating the boot block due to a 'SET VM BASE' ;- .REM % .Assume A.CHAN eq .-BAREA BAREA: .BYTE 17 ; Channel 17 .Assume A.CODE eq .-BAREA .BYTE .READ ; read .BLKW ; (block number filled by SET code) .BLKW ; (buffer address fille by SET code) .Assume A.WCNT eq .-BAREA .WORD BLKWDS ; Transfer size .Assume A.TYPE eq .-BAREA .WORD ..WTIO ; I/O type (no completion) % $$.SET = . ; Save current pointer .SBTTL SJ/FB Installation code ;+ ; Installation routine ; -------------------- ; This routine checks for the presence of a KT-11 and if so, determines the ; amount of memory available and if access should be in 18 or 22 bit mode. ;- .DRINS VM .IF EQ MMG$T .ENABL LSB VMINST: BR 10$ ; Non-system device enters here. BR 20$ ; System device enters here. ;+ ; If VM is a system device $RAMSZ is passed in R1. If VM is a non-system ; device, $RAMSZ is obtained via RMON fixed offsets. ;- 10$: INC DKFLAG ; Indicate non-system install MOV @#$SYPTR,R1 ; Point to start of RMON Ck.R1=$SYPTR Ck.R1 $SYPTR MOV $MEMPT(R1),R0 ; Get offset to low memory pointer Ck.R1 $SYPTR ADD R1,R0 ; Get absolute address of pointer MOV $RAMSZ(R0),R1 ; Get total usable system RAM size (/32 wds.) Ck.R1=JUNK 20$: SUB I.BASE,R1 ; Subtract out non-VM memory BLOS ERRRET ; Don't install if no memory available MOV (PC)+,R0 ; Get requested size from SET VM SIZE (chunks) I.SIZE: .WORD 0 ; Size of VM device (in chunks) Ck.R0=JUNK BNE 30$ ; Branch if specific size was SET MOV R1,R0 ; Use all available memory 30$: CMP R1,R0 ; Is there enough memory for VM? BLO ERRRET ; Branch if not; cannot install VM ; CLC ; BLO means C=1, so C=0 here ; Convert total usable ROR R0 ; system RAM size ASR R0 ; to number of 512. ASR R0 ; byte blocks. MOV R0,H.DSIZ ; Save media size in 512. byte blocks. CLR R4 ; R4 = memory blk # MOV #UISAR0,R2 ; R2 -> User I address regs Ck.R2=UISAR0 MOV #NUMPAR,R3 ; 8 regs to load .Rept NUMPAR Ck.R2 ,+2 .EndR 40$: MOV #AP$ACF,UISDR0-UISAR0(R2) ; Load user desc reg MOV #AP$ACF,KISDR0-UISAR0(R2) ; Load kernel desc reg MOV R4,KISAR0-UISAR0(R2) ; Load kernel I addr reg MOV R4,(R2)+ ; And user I addr reg ADD #PARCHK,R4 ; Bump addr by 4K SOB R3,40$ ; And loop to set up all 8 .DSABL LSB .ENABL LSB Ck.R2 UISAR7,-2 MOV #IOPCHK,-(R2) ; Map VM blk over user I/O page MOV #AP$ACG,@#UISDR7 ; With a length of 2K words MOV #IOPCHK,@#KISAR7 ; Map I/O page to kernel MOV #IOPAGE+,R5 ; R5 -> first fault address MOV R5,R4 ; Save fault address Ck.SP=S.SP Ck.SP ,-2 CLR -(SP) ; Work space on stack MOV SP,R3 ; Point to it MOV #V.MMU,R2 ; Point to vector Ck.R2=V.MMU .ADDR #INSMMU,R0 ; Point to ISR ;(U) means USER MODE ; absence means KERNEL MODE MOV #PR7,@#PS ;;; Go into user mode BR MORINS ;;; go to rest of install code .Assume . LE H.SET,<;INSTALL area overflow> . = $$.SET MORINS: Ck.R2 V.MMU Ck.SP ,-2,S.MMU MOV @R2,-(SP) ;;; Save old MMU vector Ck.R2 V.MMU,+2 MOV R0,(R2)+ Ck.R2 V.MMU+2 Ck.SP ,-2,S.MMU2 MOV @R2,-(SP) ;;; Save old MMU vector ... Ck.R2 V.MMU+2 MOV #PR7,@R2 ;;; Set MMU PS to PR7 MOV #UMODE!PR7,@#PS ;;; Go into user mode MOV #MMUON,@#MMSR0 ;;;(U) Enable memory management ;WARNING: The instructions at INSREA and INSWRI must match the instructions ;at VMREAD and following VMWRT. ; MOV R3,R0 ;;;(U) Save R3 value INSREA: MOV (R5)+,(R3)+ ;;;(U) Copy to user buffer CMP R5,R4 ;;;(U) Is R5 correct? BNE BADMMU ;;;(U) No CMP R3,R0 ;;;(U) Is R3 correct? BNE BADMMU ;;;(U) No INSWRI: MOV (R3)+,(R5)+ ;;;(U) Move a word from user buffer CMP R5,R4 ;;;(U) Is R5 correct? BNE BADMMU ;;;(U) No CMP R3,R0 ;;;(U) Is R3 correct? BEQ OKMMU ;;;(U) Yes BADMMU: MOV SP,MMUBAD ;;;(U) Indicate failure OKMMU: INSTRP: CLR @#MMSR0 ;;;(U) Disable memory management CLR @#PS ;;;(U) Go into KERNEL mode Ck.SP S.MMU2,+2 Ck.R2 V.MMU+2 MOV (SP)+,@R2 ; restore MMU+2 vector Ck.SP S.MMU,+2 Ck.R2 V.MMU,-2 MOV (SP)+,-(R2) ; and MMU vector Ck.SP ,+2 TST (SP)+ ; Align Stack Ck.SP S.SP TST #0 ; SY install? DKFLAG =: .-2 ; inline flag word BEQ 19$ ; yes, so no CA test .ADDR #DSTAT,R0 ; Point to DSTATUS area(s) MOV R0,R1 ; Copy pointer INC R1 ; force odd .DSTAT R1,R0 ; Is CA installed? BCC ERRRET ; Yes, then VM install fails 19$: TST MMUBAD ; any failure? BNE ERRRET ; yes BR NORRET ; AOK .DSABL LSB .ENABL LSB INSMMU: MOV #IOPAGE+,R5 ;;; R5 -> first fault address MOV @#MMSR2,R1 ;;; R1 = virtual PC of error Ck.R1=OLD.PC Ck.R1 OLD.PC CMP @R1,(PC)+ ;;; Check for R3 modification INSCHK: MOV (R3)+,(R5)+ ;;; On this instruction only! BNE 10$ ;;; Not this one, so skip correction TST -(R3) ;;; Else update 10$: BIC #MM0PLE,@#MMSR0 ;;; Clear segment length fault .ADDR #INSTRP,-(SP) ;;; point to "escape" instruction Ck.R1 OLD.PC CMP (SP)+,R1 ;;; Trying to exit (change MMU reg?) BNE 20$ ;;; Nope BIC #UMODE,OLD.PS(SP) ;;; Else return to kernel mode Ck.R1 OLD.PC .Assume OLD.PC eq 0 MOV R1,@SP ;;; Restart instruction 20$: RTI ;;; And exit MMUBAD: .WORD 0 ;0-MMU ok ;<>0-MMU action different I.BASE: .WORD VM$BASE ; Base value for installation code. DSTAT: .RAD50 "CA " ; Device name AND first word of answer .BLKW 3. ; DSTATUS answer area .Assume . LE H.BEG,<;SET area overflow> .DSABL LSB .IFF ;EQ MMG$T .SBTTL XM Installation code .ENABL LSB VMINST: TST (PC)+ ; Non system device enters here SEC ; System device enters here - just go out MOV (PC)+,R4 ;*C* R4 = requested size (SET VM SIZE=nnn) I.SIZE: .WORD 0 ; SET VM SIZE=n value times 8 BCC 10$ ; If non-system handler, try to allocate space JMP SETSIZ ; If system handler, just update 54 and leave 10$: MOV @#$SYPTR,R1 ; R1 -> base of RMON Ck.R1=$SYPTR Ck.R1 $SYPTR MOV $MEMPT(R1),R0 ; R0 = Offset to table of offsets ADD R1,R0 ; R0 -> table of offsets Ck.R0=$MEMPT Ck.R0 $MEMPT MOV $CORPX(R0),R0 ; R0 = offset to extended memory table ADD R1,R0 ; R0 -> extended memory allocation table MOV R0,R5 ; Save start of free memory list ;+ ; Find the region into which our base will go. ;- MOV (PC)+,R1 ; R1 = desired base address I.BASE: .WORD VM$BASE ; Base location for installation code Ck.R1=JUNK 20$: CMP @R0,#-1 ; Is this the end of the table? BEQ INSER1 ; Yes, then the base region is in use TST (R0)+ ; Does this slot have free memory? BEQ 30$ ; No, then don't try for it CMP @R0,R1 ; Is this address above us? BLOS 40$ ; No, so we can use it! 30$: TST (R0)+ ; Advance to next size entry BR 20$ ; and go look at it 40$: MOV @R0,R3 ; Calculate the top of the region by ADD -(R0),R3 ; adding the location to the size CMP R3,R1 ; Is this address below us? BHI 50$ ; No, then its ok to install CMP (R0)+,(R0)+ ; Yes, then set R0 to the next entry BR 20$ ; Keep looking ;+ ; Save what slot we will use and find the handler RCBs. ;- 50$: SUB R1,R3 ; R3 = max size available from I.BASE up TST R4 ; Does user want specified allocation size BNE 60$ ; Branch if non-zero (static allocation) MOV R3,R4 ; Dynamic allocation; so use maximum 60$: CMP R3,R4 ; Is requested size larger than is available? BLO INSER1 ; Branch if yes; cannot install MOV R0,R3 ; Save our slot pointer 70$: CMP (R0)+,#-1 ; Is this the top of the table? BEQ FNDRCB ; Yes, go store in the RCB TST (R0)+ ; Move to the next size field BR 70$ ; Keep searching .DSABL LSB .ENABL LSB ;+ ; Find a free region control block. ;- FNDRCB: 10$: TST @R0 ; Is this RCB free? BEQ 20$ ; Yes, go take it ADD #GR.ESZ,R0 ; Move to the next RCB entry CMP @R0,#-1 ; Is this the end of the table BNE 10$ ; No, keep trying INSER1: BR INSERR ; Take error exit; cannot install ;+ ; Fill in the region control block data. ;- 20$: MOV R4,(R0)+ ; Store size of VM allocation MOV R1,(R0)+ ; Now put the address in the RCB CLR (R0)+ ; Set the status to zero MOV #VM$NAM,(R0)+ ; Store the name of the RCB owner MOV #<^R$ >,@R0 ; Store the name of the RCB owner ;+ ; Deallocate the memory from the allocation table. ;- SUB R4,@R3 ; Subtract out allocated space MOV @R3,R0 ; Get total free space left MOV R1,(R3)+ ; Compute amount of free space below VM BR MORINS .DSABL LSB ;+ ; Leave room for the set code. ;- .Assume . LE H.SET,<;INSTALL area overflow> . = $$.SET ; Start just above the set code space. .ENABL LSB MORINS: SUB @R3,-(R3) ; and store in free memory slot SUB @R3,R0 ; R0 = amount of free space left above VM ADD R4,R1 ; R1 = addr of free space left above VM TST @R3 ; Is there any free space below VM? BEQ 40$ ; Branch if not to store the (size,addr) pair ; for the free space above VM in slot ;+ ; Search for an empty free memory descriptor pair in which to represent ; the free memory left above VM (if any). If we cannot find one, then ; we will change the original free memory descriptor to describe the ; free memory left above VM instead of below VM if the free memory above VM ; is larger. ;- 10$: TST @R5 ; Is this memory slot free? BEQ 30$ ; Branch if yes CMP (R5)+,#-1 ; Is this the end of the table? BEQ 20$ ; Branch if yes; no extra slots available TST (R5)+ ; R5 -> next free memory slot BR 10$ ; Now check next slot ;+ ; We have failed to find another free slot so we want to save the most ; free memory we can in the current slot ;- 20$: CMP R0,@R3 ; Is memory above VM bigger than below? BLOS 50$ ; Branch if not; already have biggest BR 40$ ; Store free memory above VM in current slot 30$: MOV R5,R3 ; R3 -> new free slot 40$: MOV R0,(R3)+ ; Store size of free memory above VM MOV R1,@R3 ; Store start of free memory above VM 50$: CLC ; Clear the carry so it won't get added in ROR R4 ; R4 = size in 64 word blocks ASR R4 ; R4 = size in 128 word blocks ASR R4 ; R4 = size in 256 word blocks SETSIZ: MOV R4,H.DSIZ ; Put into future $DVSIZ table entry ;+ ; Normal and error exits. ;- TST (PC)+ ; Clear carry / skip next instruction INSERR: SEC ; Set the carry RETURN .DSABL LSB .Assume . LE H.BEG,<;INSTALL code in SET area overflow> .IFT ;EQ MMG$T .Assume . LE H.BEG,<;SET area overflow> .ENDC ;EQ MMG$T .SBTTL Driver entry .DRBEG VM ; Define header information. ZERO == VMCQE ; For VD handler BASE =: VMSTRT+6 .ENABL LSB MOV VMCQE,R0 ; R0 -> current queue element. Ck.R0=Q$BLKN MOVB Q$UNIT(R0),R1 ; Get unit number BIT #UNIMSK,R1 ; VM0 reference? BNE VMERR ; No, reject I/O ;+ ; Determine if all of transfer will be in range of the device ;- Ck.R0 Q$BLKN MOV Q$WCNT(R0),R1 ; Get the word count BEQ VMDONE ; It's a seek, ignore it BPL 10$ ; If read... NEG R1 ; If write, make it positive 10$: DEC R1 ; Determine blocks in transfer CLRB R1 ; (less 1) SWAB R1 ; R1 = # of blocks of transfer - 1 Ck.R0 Q$BLKN ADD @R0,R1 ; R1=Last block involved in transfer Ck.R0A=Ck.R0 BCS VMERR ; Wrap is error CMP R1,(PC)+ ; Is it legal? VMSIZE: .WORD 0 Ck.R0B=Ck.R0 BHIS VMERR ; Nope... Ck.R0 Q$BLKN,+2 MOV (R0)+,R1 ; Get the disk block number. ASL R1 ; Convert to 128 word blocks. ASL R1 ; Convert to 64 word blocks. ASL R1 ; Convert to 32 word blocks. ADD (PC)+,R1 ; Add in the "disk" base. V.BASE: .WORD VM$BASE ; Base location for VMX I/O code. .Assume . LE VMSTRT+BLKBYT,<;SET object not in block 1> .IF EQ MMG$T ;+ ; Initialize the memory management registers. ;- CLR R4 ; R4 = memory blk # MOV #UISAR0,R2 ; R2 -> User I address regs Ck.R2=UISAR0 MOV #NUMPAR,R3 ; 8 regs to load .Rept NUMPAR Ck.R2 ,+2 .EndR 30$: MOV #AP$ACF,UISDR0-UISAR0(R2) ; Load user desc reg MOV #AP$ACF,KISDR0-UISAR0(R2) ; Load kernel desc reg MOV R4,KISAR0-UISAR0(R2) ; Load kernel I addr reg MOV R4,(R2)+ ; And user I addr reg ADD #PARCHK,R4 ; Bump addr by 4K SOB R3,30$ ; And loop to set up all 8 .DSABL LSB .ENABL LSB Ck.R2 UISAR7,-2 MOV R1,-(R2) ; Map VM blk over user I/O page MOV #AP$ACG,@#UISDR7 ; With a length of 2K words MOV #IOPCHK,@#KISAR7 ; Map I/O page to kernel MOV #IOPAGE,R5 ; R5 -> base of I/O page ;+ ; The following instruction is replaced by NOPs if MMSR3 does not exist ; at LOAD time. ;- .MODE1: MOV #MODE22,@#MMSR3 ; Enable 22 bit mode LMODE1=:.-.MODE1 ;+ ; Turn on memory management ;- ;(U) means USER MODE ; absence means KERNEL MODE MOV #UMODE,@#PS ;(MMU off) Go into user mode MOV #MMUON,@#MMSR0 ;(U) Enable memory management ; Determine which function is requested. ;- Ck.R0 ,+2 TST (R0)+ ;(U) Skip unit number in q element Ck.R0 Q$BUFF,+2 MOV (R0)+,R3 ;(U) R3 = buffer address Ck.R0 Q$WCNT MOV @R0,R4 ;(U) R4 = word count BMI VMWRT ;(U) If negative, write request ; ;(U) else a read (seeks culled out) .SBTTL Perform I/O functions ;+ ; Read from extended memory. (Write to user buffer). ;- INC R4 ;(U) Fold word count to speed transfer ASR R4 BCC 10$ VMREAD: MOV (R5)+,(R3)+ ;(U) Copy to user buffer 10$: MOV (R5)+,(R3)+ SOB R4,VMREAD ;(U) Loop until transfer complete BR VMTRAP ;(U) Then go to common exit ;+ ; Write to extended memory. (Read from user buffer). ;- VMWRT: NEG R4 ;(U) Make word count positive INC R4 ;(U) Fold word count to speed transfer ASR R4 BCC 30$ ; ;WARNING: The following two instructions must be the same instruction ;as found at label PAGERR. If these are modified, the instruction at ;PAGERR, and possibly surrounding code as well, will need to be changed! ; 20$: MOV (R3)+,(R5)+ ;(U) Move a word from user buffer 30$: MOV (R3)+,(R5)+ SOB R4,20$ ;(U) Loop until transfer complete ; CLR R4 ;(U) R4 = 0 from SOB termination BISB @R0,R4 ;(U) Check if zero-fill req'd BEQ VMTRAP ;(U) Nope - multiple of a block 40$: CLR (R5)+ ;(U) Else clear a word SOB R4,40$ ;(U) Until reach a block boundary ;+ ; Common exit point. ;- ; ;WARNING: This label (VMTRAP) needs to be on the first instruction that ;attempts to access the I/O Page from USER MODE. It is referenced in VMINT ;which "allows" the access. If this is changed the area of code around ;the reference to VMTRAP in VMINT needs to be altered as well! ; .Assume <+&77777> lt VMTRAP: CLR @#MMSR0 ;(U) Turn off memory management CLR @#PS ; Restore kernel mode ;+ ; The following instruction is replaced by NOPs if MMSR3 does not exist ; at LOAD time. ;- .MODE2: CLR @#MMSR3 ; Disable 22 bit mode LMODE2=:.-.MODE2 BR VMDONE .IFF ;EQ MMG$T .SBTTL XM I/O code. MOV #PARADR,R2 ; Set address to start of PAR 1 space. Ck.R0 ,+2 TST (R0)+ ; R0 -> Q.BUFF Ck.R0 Q$BUFF,+2 MOV (R0)+,R4 ; Get the biased buffer address. Ck.R0 Q$WCNT MOV Q.PAR-Q.WCNT(R0),R3 ; Get the PAR value Ck.R0 Q$WCNT MOV @R0,R5 ; R5 = word count BPL DOIO ; On plus, go do the read ; ; else a write (seeks culled out) WRITE: NEG R5 ; Make the word count positive. MOV R1,R0 ; exchange pointers ... MOV R3,R1 MOV R0,R3 MOV R2,R0 MOV R4,R2 MOV R0,R4 DOIO: CALL @(PC)+ ; Transfer the data. $BLKMV: .WORD 0 ; Filled in by FETCH/LOAD code MOV VMCQE,R0 ; R0->Current queue element Ck.R0=Q$BLKN Ck.R0 Q$BLKN MOV Q$WCNT(R0),R2 ; Were we doing a write? BPL VMDONE ; Nope... CLR R1 ; Make sure high byte is clear BISB R2,R1 ; Do we have to zero fill? BEQ VMDONE ; Nope... Ck.R0 Q$BLKN MOV R4,Q$BUFF(R0) ; Yes, make the queue element Ck.R0 Q$BLKN MOV R3,Q$PAR(R0) ; point to the virtual disk Ck.R0 Q$BLKN MOV R0,R4 ; $PTWRD needs R4->queue element Ck.R4=Ck.R0 Ck.SP=S.SP Ck.SP ,-2 30$: CLR -(SP) ; Zero fill a word of the Ck.R4 Q$BLKN Ck.SP ,+2 CALL @$PTWRD ; virtual disk Ck.SP S.SP SOB R1,30$ ; Branch if more to do BR VMDONE ; Exit when done. ;+ ; Pseudo interrupt and abort code. ;- RETURN ; Just return on abort. VMINT: BR VMDONE .IFTF ;EQ MMG$T Ck.R0A Q$BLKN Ck.R0B Q$BLKN VMERR: BIS #HDERR$,@-(R0) VMDONE: .DRFIN VM .IFT ;EQ MMG$T .IF NE SD$$VM .DRVTB VM,V.BPT,VDLOAD .DRVTB ,V.MMU,VMINT .ENDC ; NE SD$$VM .SBTTL Abort and interrupt entry points ;+ ; Abort entry. ;- BR VMTRAP ; Abort by disabling management ;+ ; Interrupt service. ;- VMINT: MOV #IOPAGE,R5 ;;; Reset to point to base of I/O page ADD #CHK2KW,@#UISAR7 ;;; And remap to next 2K chunk MOV @#MMSR2,R2 ;;; R2 = virtual PC of error Ck.R2=OLD.PC Ck.R2 OLD.PC CMP @R2,(PC)+ ;;; Check for R3 modification PAGERR:: MOV (R3)+,(R5)+ ;;; On this instruction only! BNE 50$ ;;; Not this one, so skip correction TST -(R3) ;;; Else update 50$: BIC R5,@#MMSR0 ;;; Clear segment length fault Ck.R2 OLD.PC CMP #VMTRAP-BASE,R2 ;;; Trying to exit (change MMU reg?) .VMTRP =:.-2 ;;; Addr to relocate in LOAD code BNE 60$ ;;; Nope BIC R5,OLD.PS(SP) ;;; Else return to kernel mode Ck.R2 OLD.PC .Assume OLD.PC eq 0 60$: MOV R2,@SP ;;; Restart instruction VMRTI: RTI ;;; And exit .DSABL LSB .ENABL LSB .ENDC ;EQ MMG$T .SBTTL Bootstrap read routine .ENABL LSB ;+ ; Both FB and XM use this boot code, with some changes. ; ; FB will always turn memory management on and off in the READ routine. ; ; When XM is booted, the secondary bootstrap will eventually turn memory ; management on, and it will stay on from then. However, there will be ; several times before this occurs that XM will call this read routine. ; If memory management is on when READ is entered, READ will save User ; PAR and PDR 7, read using PAR 7, and then restore it when the read is ; completed. If memory management is not on, XM will turn it on and off ; here just as FB does. ; ; Enters with: ; R0 = Block # ; R1 = Word count ; R2 = Buffer address ; ; CALL READ ; ; All registers modified ;- .IF EQ SD$$VM .DRBOT VM,BOOT1,READ .IFF ;EQ SD$$VM .DRBOT VM,BOOT1,READ,PSECT=ZZDVR .ENDC ;EQ SD$$VM . = VMBOOT + V.TRP4 .WORD BIOERR-VMBOOT ; Trap 4 (NXM) .WORD PR0 ; Priority 0 . = VMBOOT + V.IOT .WORD VMINT2-VMBOOT ; IOT vector .WORD PR0 ; Priority 0 . = VMBOOT + 240 BOOT1: JMP @#BOOT-VMBOOT . = VMBOOT + V.MMU .WORD VMINT1-VMBOOT ; VM interrupt entry .WORD PR7 ; and priority .DSABL LSB .ENABL LSB ;+ ; Initialize for the actual read. ;- READ: MOV #V.IOT,R4 ; -> vector area Ck.R4=V.IOT Ck.SP=S.SP Ck.R4 V.IOT,+2 Ck.SP ,-2,S.Ol20 MOV (R4)+,-(SP) ; Save it Ck.R4 V.IOT+2,+2 Ck.SP ,-2,S.Ol22 MOV (R4)+,-(SP) ; ... Ck.R4 V.IOT+2,-2 .Assume PR0 eq 0 CLR -(R4) ; Set PR0 Ck.R4 V.IOT,-2 MOV #VMINT2-VMBOOT,-(R4) ; Plug in ISR addr ASL R0 ; Convert disk block number to ASL R0 ; a memory block number. ASL R0 ; R0 = VM MEMORY BLOCK # ADD (PC)+,R0 ; plus base address. B.BASE: .WORD VM$BASE ; Base location for bootstrap code. .IF EQ SD$$VM BTBASE = ++H.BEG .Assume BTBASE LT H.BEG+1000 .ENDC ;EQ SD$$VM ;+ ; Determine how many blocks must be read and see if this needs 22 bit mode. ;- BIT #MMUON,@#MMSR0 ; Memory management on? BEQ 10$ ; If not, branch INC (PC)+ ; Say we're booted from XM XMBOOT: .WORD 0 Ck.SP ,-2,S.PAR MOV @#UISAR7,-(SP) ; Save User PAR 7 Ck.SP ,-2,S.PDR MOV @#UISDR7,-(SP) ; and User PDR 7 MOV R0,@#UISAR7 ; Map VM blk over user I/O Page BR 50$ ; Do the read Ck.SP ,-2,S.OlR1 10$: MOV R1,-(SP) ; Save R1 for later. BEQ 20$ ; In case it's a seek... DEC R1 ; Determine blocks in transfer CLRB R1 ; (less 1) SWAB R1 ; R1 = # of blocks of transfer - 1 ASL R1 ; Convert to ASL R1 ; a memory ASL R1 ; block number 20$: ADD R0,R1 ; Calculate the highest block to be read. CMP R1,#CHK18 ; Is it above the maximum block for 18 bits? BLO 30$ ; No, then don't turn it on. MOV #MODE22,@#MMSR3 ; Yes, then pre-enable 22 bit mode. Ck.SP S.OlR1,+2 30$: MOV (SP)+,R1 ; Restore the word count. ;+ ; Initialize memory management and related registers. ;- CLR R4 ; R4 = memory blk # Ck.R3=UISAR0 MOV #UISAR0,R3 ; R3 -> User I address regs MOV #NUMPAR,R5 ; 8 regs to load .Rept NUMPAR Ck.R3 ,+2 .EndR 40$: MOV #AP$ACF,UISDR0-UISAR0(R3) ; Load user desc reg with 8K MOV #AP$ACF,KISDR0-UISAR0(R3) ; Load kernel desc reg with 8K MOV R4,KISAR0-UISAR0(R3) ; Load kernel I addr reg MOV R4,(R3)+ ; And user I addr reg ADD #CHK4KW,R4 ; Bump addr by 4K SOB R5,40$ ; And loop to set up all 8 Ck.R3 UISAR7,-2 MOV R0,-(R3) ; Map VM blk over user I/O page MOV #IOPCHK,@#KISAR7 ; Map I/O page to kernel 50$: MOV #AP$ACG,@#UISDR7 ; Give user 7 PDR a length of 2K words MOV #IOPAGE,R5 ; R5 -> Base of I/O page BIS #MMUON,@#MMSR0 ; Enable management BIS #UMODE,@#PS ;(U) Go into user mode .DSABL LSB .ENABL LSB ;+ ; Do the actual copy. ;- INC R1 ;(U) Fold word count to speed transfer ASR R1 BCC 20$ 10$: MOV (R5)+,(R2)+ ;(U) Copy to user buffer 20$: MOV (R5)+,(R2)+ SOB R1,10$ ;(U) Loop until transfer complete ;+ ; Transfer done so return to the caller. ;- IOT ;(U) Put us back into kernal mode & clear PS TST XMBOOT ; Booted from XM? BEQ 30$ ; If not, branch Ck.SP S.PDR,+2 MOV (SP)+,@#UISDR7 ; Restore User PDR 7 Ck.SP S.PAR,+2 MOV (SP)+,@#UISAR7 ; Restore User PAR 7 BR 40$ ; Merge below 30$: CLR @#MMSR0 ; Turn off memory management. 40$: CLC ; No error to report MOV #V.IOT+2,R4 ; -> just past vector Ck.R4=V.IOT+2 Ck.SP S.Ol22,+2 MOV (SP)+,@R4 ; Restore priority word Ck.SP S.Ol20,+2 Ck.R4 V.IOT+2 MOV (SP)+,-(R4) ; and ISR addr Ck.SP S.SP Ck.R4 V.IOT,-2 RETURN ; Back to the caller. ;+ ; Pseudo interrupt, enter here on MMU fault. This will occur when we try ; to access the first location beyond the 2K size of User PAR7 ;- VMINT1: MOV #IOPAGE,R5 ;;; Reset to point to base of I/O page Ck.R5=IOPAGE ADD #CHK2KW,@#UISAR7 ;;; And remap to next 2K chunk MOV @#MMSR2,R3 ;;; R3 = virtual PC of error .Assume MM0PLE&IOPAGE eq MM0PLE BIC R5,@#MMSR0 ;;; Clear segment length fault .Assume OLD.PC eq 0 MOV R3,@SP ;;; Restart instruction RTI ;;; And exit ;+ ; The IOT instruction will send us here. This routine will force us ; back into kernel mode so that we can map without errors. ;- Ck.SP=S.SP Ck.SP ,-2,S.OlPS Ck.SP ,-2,S.OlPC ; above caused by IOT interrupt Ck.SP S.OlPC,+2 Ck.SP S.OlPS VMINT2: MOV (SP)+,@SP ; Get rid of the PS Ck.SP ,+2 RETURN ; Go back to the PC we came from Ck.SP S.SP .DSABL LSB .ENABL LSB ;+ ; VM boot strap. ;- BOOT: MOV #10000,SP ; Set up the stack pointer MOV #2,R0 ; Read the rest of the boot MOV #<4*BLKWDS>,R1 ; Every block but the one we are in MOV #1000,R2 ; into location 1000 CALL READ ; Go read it in MOV #READ-VMBOOT,@#B$READ ; Store -> bootstrap read routine MOV #B$DNAM,@#B$DEVN ; Store the RAD50 device name CLR @#B$DEVU ; Set up the unit number (always 0) JMP @#B$BOOT ; Start the secondary boot .DSABL LSB .IF EQ SD$$VM .DREND VM .IFF ;EQ SD$$VM .DREND VM,PSECT=ZZDVR .ENDC ;EQ SD$$VM .DSABL LSB .SBTTL FETCH / LOAD service routine .PSECT SETOVR .ENABL LSB Ck.R5=S.NTRY Ck.SP=S.SP LOAD:: MOV R5,R3 ; Save $Entry location Ck.R3=Ck.R5 Ck.R5 S.NTRY MOV @R5,R5 ; Get the addr Ck.R5=S.DRBG MOV @#$SYPTR,R0 ; R0->$RMON Ck.R0=$SYPTR MOV R0,R1 ; Save it for later. Ck.R1=Ck.R0 .IF EQ MMG$T Ck.R5 S.DRBG ADD R5,.VMTRP-BASE(R5) ; Relocate VMTRAP ;+ ; Systems that have MSV11-A,B,C,D memories strapped for a 2KW I/O ; page will malfunction when the MMU comes on because the I/O page ; becomes 4KW. VM cannot be used if memory strapped for 2K I/O. ;- Ck.R0 $SYPTR CMP $MEMSZ(R0),#1600 ; Is this a 30KW root? BHI 40$ ; Yes, then take hard error. M22SET: MOV #PR7,@#PS ;;; Don't let interrupts happen. ;;; Can't do later (4 & 10 are impure). Ck.SP ,-2,S.Old4 MOV @#V.TRP4,-(SP) ;;; Save the old trap to 4 vector. ;;; Don't care about priority, trap RTIs. .ADDR #SECRTI,R1 ;;; Calculate the addr of SEC/RTI PICley. MOV R1,@#V.TRP4 ;;; Set the vector to VMRTI. CLC ;;; Clear carry in case next traps TST @#MMSR3 ;;; Try to touch MMSR3 Ck.SP ,+2 MOV (SP)+,@#V.TRP4 ;;;*C* Restore 4. Ck.SP S.SP BIC #PR7,@#PS ;;;*C* Set back to priority 0. BCC 10$ ; MMSR3 exists Ck.R4=Ck.R5 MOV R5,R4 ; Copy Base pointer ADD #.MODE1-BASE,R4 ; -> to first MODE22 reference .REPT LMODE1/2 ; number of words to zap MOV (PC)+,(R4)+ ; Change to NOPs NOP .ENDR MOV R5,R4 ; Copy Base pointer ADD #.MODE2-BASE,R4 ; -> to second MODE22 reference .REPT LMODE2/2 ; number of words to zap MOV (PC)+,(R4)+ ; Change to NOPs NOP .ENDR 10$: .IFF ;EQ MMG$T Ck.R0 $SYPTR MOV P1$EXT(R0),$BLKMV-BASE(R5) ; Fill in addr of block move Ck.R5 S.DRBG SUB #2,$BLKMV-BASE(R5) ; $BLKMV = $P1EXT - 2. .IFTF ;EQ MMG$T Ck.R0 $SYPTR Ck.R1 $SYPTR ADD $PNPTR(R0),R1 ; R1->$PNAME TABLE Ck.R1=S.PNAM ASL R2 ; $SLOT*4 ASL R2 ; $SLOT*8. TST (R2)+ ; Adjust for -1 at end of $Entry Ck.R3 S.NTRY ADD R3,R2 ; R2->VM entry in $DSIZE. Ck.R2=S.VMSZ .IFF ;EQ MMG$T Ck.R1 S.PNAM CMP 2(R1),#VM$NAM ; System device? BNE 30$ ; If not, branch Ck.R5 S.DRBG Ck.SP ,-2,S.OlBS MOV R5,-(SP) ; Save addr of handler Ck.R0 $SYPTR Ck.R2 S.VMSZ Ck.R5 S.DRBG CALL SIZMEM ; Size memory for XM Ck.SP S.OlBS,+2 MOV (SP)+,R5 ;*C* Restore Ck.R5=S.DRBG BCS 40$ ; If we can't do it, go out 30$: .IFTF ;EQ MMG$T Ck.R5 S.DRBG MOV @R2,VMSIZE-BASE(R5) ; Set the size in blocks TST (PC)+ 40$: SEC Ck.SP S.SP RETURN .DSABL LSB .IFF ;EQ MMG$T .SBTTL SIZMEM - XM Memory sizing ;+ ; When VM is booted from XM, it is not possible to size memory at install ; time because the monitor doesn't exist then. At "SY: LOAD time" entry into ; the handler when the monitor is in place, all the required information ; is available. This routine will size memory, and save it in $DSIZE, fixed ; offset $SYSCH+4, and SYDVSZ in RMON. ; ; Input: R0 -> $RMON ; R2 -> $DVSIZ entry for VM ; R5 -> VM (BASE) in memory ; Output: R2 -> $DVSIZ entry for VM ;- .ENABL LSB Ck.R0=$SYPTR Ck.R2=S.VMSZ Ck.R5=S.DRBG Ck.SP=S.SP Ck.R0 $SYPTR Ck.SP ,-2,S.RMON SIZMEM: MOV R0,-(SP) ; Save RMON base Ck.R0 $SYPTR MOV $MEMPT(R0),R0 ; R0 = Offset to table of offsets Ck.R0=JUNK ADD @SP,R0 ; R0 -> table of offsets MOV 4(R0),R0 ; R0 = offset to extended memory table ADD @SP,R0 ; R0 -> extended memory allocation table MOV R0,R3 ; Save start of free memory list ;+ ; Find the region into which our base will go. ;- Ck.R5 S.DRBG MOV V.BASE-BASE(R5),R1 ; R1 = desired base address 10$: CMP @R0,#-1 ; Is this the end of the table? Ck.SPA=Ck.SP BEQ SIZER1 ; Yes, then the base region is in use TST (R0)+ ; Does this slot have free memory? BEQ 20$ ; No, then don't try for it CMP @R0,R1 ; Is this address above us? BLOS 30$ ; No, so we can use it! 20$: TST (R0)+ ; Advance to next size entry BR 10$ ; and go look at it 30$: MOV @R0,R5 ; Calculate the top of the region by Ck.R5=JUNK ADD -(R0),R5 ; adding the location to the size CMP R5,R1 ; Is this address below us? BHI 40$ ; No, then its ok to install CMP (R0)+,(R0)+ ; Yes, then set R0 to the next entry BR 10$ ; Keep looking ;+ ; Save what slot we will use and find the handler RCBs. ;- 40$: SUB R1,R5 ; R5 = max size available from I.BASE up MOV @R2,R4 ; R4 = requested size of VM (SET VM SIZE=nnn) BNE 50$ ; Branch if non-zero (static allocation) MOV R5,R4 ; Dynamic allocation; so use maximum 50$: CMP R5,R4 ; Is requested size larger than is available? Ck.SPB=Ck.SP BLO SIZER1 ; Branch if yes; cannot install MOV R0,R5 ; Save our slot pointer 60$: CMP (R0)+,#-1 ; Is this the top of the table? Ck.SPC=Ck.SP BEQ FFRRCB ; Yes, go store in the RCB TST (R0)+ ; Move to the next size field BR 60$ ; Keep searching .DSABL LSB .ENABL LSB ;+ ; Find a free region control bloCk. ;- FFRRCB: 10$: TST @R0 ; Is this RCB free? BEQ 20$ ; Yes, go take it ADD #GR.ESZ,R0 ; Move to the next RCB entry CMP @R0,#-1 ; Is this the end of the table BNE 10$ ; No, keep trying Ck.SPA ,+2 Ck.SPB ,+2 Ck.SPC ,+2 SIZER1: TST (SP)+ ; Yes, then tidy the stack BR 80$ ; Take error exit; cannot install ;+ ; Fill in the region control block data. ;- 20$: MOV R4,(R0)+ ; Store size of VM allocation MOV R1,(R0)+ ; Now put the address in the RCB CLR (R0)+ ; Set the status to zero MOV #VM$NAM,(R0)+ ; Store the name of the RCB owner MOV #<^R$ >,@R0 ; Store the name of the RCB owner ;+ ; Deallocate the memory from the allocation table. ;- SUB R4,@R5 ; Subtract out allocated space MOV @R5,R0 ; Get total free space left MOV R1,(R5)+ ; Compute amount of free space below VM SUB @R5,-(R5) ; and store in free memory slot SUB @R5,R0 ; R0 = amount of free space left above VM ADD R4,R1 ; R1 = addr of free space left above VM TST @R5 ; Is there any free space below VM? BEQ 60$ ; Branch if not to store the (size,addr) pair ; for the free space above VM in slot ;+ ; Search for an empty free memory descriptor pair in which to represent ; the free memory left above VM (if any). If we cannot find one, then ; we will change the original free memory descriptor to describe the ; free memory left above VM instead of below VM if the free memory above VM ; is larger. ;- 30$: TST @R3 ; Is this memory slot free? BEQ 50$ ; Branch if yes CMP (R3)+,#-1 ; Is this the end of the table? BEQ 40$ ; Branch if yes; no extra slots available TST (R3)+ ; R3 -> next free memory slot BR 30$ ; Now check next slot ;+ ; We have failed to find another free slot so we want to save the most ; free memory we can in the current slot ;- 40$: CMP R0,@R5 ; Is memory above VM bigger than below? BLOS 70$ ; Branch if not; already have biggest BR 60$ ; Store free memory above VM in current slot 50$: MOV R3,R5 ; R5 -> new free slot 60$: MOV R0,(R5)+ ; Store size of free memory above VM MOV R1,@R5 ; Store start of free memory above VM 70$: CLC ; Clear the carry so it won't get added in ROR R4 ; R4 = size in 64 word blocks ASR R4 ; R4 = size in 128 word blocks ASR R4 ; R4 = size in 256 word blocks Ck.R4=S.VMSZ Ck.SP S.RMON,+2 MOV (SP)+,R0 ; Restore RMON start Ck.R0=$SYPTR Ck.R0 $SYPTR Ck.R4 S.VMSZ MOV R4,$SYSCH+4(R0) ; Save device size in XM fixed offset Ck.R4 S.VMSZ MOV R4,@R2 ; Put VM size into $DVSIZ table ;+ ; Normal and error exits. ;- TST (PC)+ ; Clear carry / skip next instruction 80$: SEC ; Set the carry Ck.SP S.SP Ck.SPA S.SP Ck.SPB S.SP Ck.SPC S.SP RETURN .ENDC ;EQ MMG$T SECRTI: BIS #CARRY,OLD.PS(SP) ; Set carry RTI ; and return .DSABL LSB .SBTTL Identify locations changed by set commands .DRTAB SET,SETVAR,SETEND-SETVAR ;Locate set variables .DRTAB SETVAR:: .RAD50 "BASE " ; SET VM BASE command .WORD 0 ; reserved .WORD I.BASE .WORD V.BASE .WORD B.BASE .WORD 000000 ; locations terminator .RAD50 "SIZE " ; SET VM SIZE command .WORD 0 ; reserved .WORD I.SIZE .WORD 000000 ; locations terminator .WORD 000000 ; commands terminator SETEND: .END