.MCALL .MODULE .MODULE XMSUBS, VERSION=63, COMMENT= ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only with the ; inclusion of the above copyright notice. This software, or ; any other copies thereof, may not be provided or otherwise ; made available to any other person except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. .SBTTL Post Release Edit History ;+ ; ; (62/01) 15-Sep-93 Don Bridgewater ; Made global some relocation routines ; 63 13-jan-1998 TDS Bump version for RT-11 5.7 release ; ;- .NLIST CND .SBTTL ************************************** .SBTTL * Memory Management Routines For The * .IF NE SB .SBTTL * Extended Background (XB) Monitor * .IFF ;NE SB .SBTTL * Extended Memory (XM) Monitor * .ENDC ;NE SB .SBTTL ************************************** .LIST CND .SBTTL Conditional Summary ;+ ;COND ; ; XM$FET 0 no fetch for XB/XM ; 1 fetch in XB/XM (additive only) ; ; MQH$P2 0 MQ handler uses 1 PAR ; 1 MQ handler uses 2 PAR's ; ; MPT$Y 0 no memory parity support ; 1 memory parity support (additive only) ; ; SUP$Y 0 no supervisor mode and no data space support ; SUP$Y 1 supervisor mode and data space support ; ; Also a minor code optimization is conditionalized ;- .SBTTL Macro Calls .LIBRARY "SRC:EDTL.MLB" .LIBRARY "SRC:SYSTEM.MLB" ; .LIBRARY "SRC:HARDWA.MLB" ;+ ; Programmed Request and Miscellaneous Utility Macros ;- .MCALL .ADDR .ASSUME .BR ;SYSMAC .MCALL ENSYS GET PUT SPL ;EDTL ;+ ; Structure Definition Macros ;- .MCALL ..CRAW ..GMCX ..READ ;SYSTEM .MCALL .CF1DF .CHNDF .CMPDF .ERRDF .GRBDF ;SYSTEM .MCALL .HBGDF .IMPDF .ISTDF .JSWDF .MCADF ;SYSTEM .MCALL .QELDF .RCBDF .RDBDF .SYCDF .WCBDF ;SYSTEM .MCALL .WDBDF ;SYSTEM .SBTTL Invoke Structure Definition Macros ..CRAW ;.CRAW EMT Format and Definitions ..GMCX ;.GMCX EMT Format and Definitions ..READ ;.READ EMT Format and Definitions .CF1DF ;CONFIG First System Configuration Word Format .CHNDF ;I/O Channel Block Format .IF NE SUP$Y .CMPDF ;.CMAP Request and I.CMAP Bit Definitions .ENDC ;NE SUP$Y .ERRDF ;EMT Error Code Definitions .GRBDF ;Global Region Control Block Format .HBGDF ;Handler Block 1 Offset Definitions FIX$ED=0 ;allow definition of floating symbols .IMPDF ;Impure Area Layout FIX$ED=1 .ISTDF ;I.STAT Job State Word Bit Definitions .JSWDF ;$JSW Bit Definitions .MCADF ;Job's Mapping Context Area Definitions .QELDF ;Queue Element Format .RCBDF ;Region Control Block Format .RDBDF ;Region Descriptor Block Format .SYCDF ;$SYCOM Definitions .WCBDF ;Window Control Block Format .WDBDF ;Window Definition Block Format .SBTTL Delete Structure Definition Macros (Free Up Workfile Space) .MDELET ..CRAW ..GMCX .MDELET .CF1DF .CHNDF .CMPDF .ERRDF .GRBDF .HBGDF .MDELET .IMPDF .ISTDF .JSWDF .MCADF .QELDF .RCBDF .MDELET .RDBDF .SYCDF .WCBDF .WDBDF .SBTTL XM Data Area .PSECT XMSUBS ;All XM data and code goes here ;+ ; Table of pointers to extended memory regions available for allocation. ; Each entry is two words: Region Size, and Region Start Address ;- ;+ ; *** Start of Critical Ordering *** ;- $XMSIZ::.WORD 0 ;Size of xtended mem (32wd blks) $XMPTR::.WORD P28KCK+<*MCA.CK> ;Pointer to xtended memory .REPT 9. .WORD 0, 0 ;Region Size, Region Start Addr .ENDR .WORD -1 ;Stopper ;+ ; Note that the global region control block table may change in size but ; $GLRCB must immediately follow the free memory table terminator word -1. ;- $GLRCB: ;Space for handler RCBs. .REPT X$RCBS ;Allow for as many as the user wants. .WORD 0, 0, 0, 0, 0 .ENDR ;00000000-00160000 KERNEL Region .WORD P28KCK, 000000, .RAD50 /KERNEL/ ;00160000-???????? MCA Region .WORD *MCA.CK, P28KCK, .RAD50 /MCA / ;17600000-20000000 IOPAGE Region .WORD P04KCK, PARCIO, .RAD50 /IOPAGE/ .WORD -1 ;Stopper. ;+ ; *** End Critical Ordering *** ;- .SBTTL INTPRO - Intercept Device Interrupts And Force Kernel Mapping .IF NE XM$FET ;+ ; On occasion, the monitor and/or the device handlers, may ; change the KERNEL PAR 1 mapping. Additionally, device handlers ; may also change the PAR 2 mapping if MQH$P2 is assembled true. ; ; In order to prevent interrupts occuring into an area of ; memory which is no longer there (mapped away), XM vectors all ; interrupts through its own interrupt table, which is clear of ; PAR 1 and PAR 2 space. ; ; The INTPRO subroutine is then used to ensure that the ; default KERNEL mapping is in effect before the real ISR is ; entered. In the case where the mapping has been altered, a co- ; operative interrupt service routine (analogous to a subprogram ; coroutine) is set up so that control will be returned to INTPRO ; to allow the mapping context to be restored when the real ISR ; issues its terminating RTI. ;- .ENABL LSB INTPRO::MOV @#PS,-(SP) ;Save the interrupt time PSW. MOV @2(SP),2(SP) ;Get the user's ISR address. ;+ ; Check if the KERNEL mapping has been changed. ;- CMP @#KISAR1,# ;Is PAR 1 space mapped away? BNE 10$ ;Yes, then force a co-interrupt. .IF NE MQH$P2 CMP @#KISAR2,# ;Is PAR 2 space mapped away? BNE 10$ ;Yes, then go do the co-interrupt. .ENDC ;NE MQH$P2 ;+ ; The mapping hasn't changed so simply go to the device ISR. ;- MOV (SP)+,@#PS ;PSW = exact interrupt time PSW. CALLR @(SP)+ ;Go to the ISR / tidy the stack. ............ ;+ ; The mapping has changed so set it back. ;- 10$: MOV @#KISAR1,-(SP) ;Put old PAR 1 on the stack. MOV #,@#KISAR1 ;Map the default PAR 1. .IF NE MQH$P2 MOV @#KISAR2,-(SP) ;Put old PAR 2 on the stack. MOV #,@#KISAR2 ;Map the default PAR 2. .ENDC ;NE MQH$P2 ;+ ; Set up the cooperative interrupt service routine by making it look ; like this routine was the interrupted one. ;- MOV @#PS,-(SP) ;Use the current PSW for his RTI. .IF NE MQH$P2 MOV 6(SP),@#PS ;PSW = exact interrupt time PSW. CALL @10(SP) ;Now go to the user's ISR. .IFF ;NE MQH$P2 MOV 4(SP),@#PS ;PSW = exact interrupt time PSW. CALL @6(SP) ;Now go to the user's ISR. .ENDC ;NE MQH$P2 .BR RTIRTI ;His RTI will return at RTIRTI. ............ ;+ ; Return will be made here when the user RTIs. ;- RTIRTI: .IF NE MQH$P2 MOV (SP)+,@#KISAR2 ;Restore Kernel PAR 2. .ENDC ;NE MQH$P2 MOV (SP)+,@#KISAR1 ;Restore Kernel PAR 1. ADD #<4>,SP ;Clear out junk from setup. ;+ ; Now return to the code that was really interrupted. ;- RTI ;This RTI will take us back ............ .DSABL LSB .SBTTL INTSET - Set Up An Entry In The $DVINT Table ;+ ; The INTSET subroutine is used to place the address of an ; interrupt service routine in the interrupt forwarding table. ; ; This routine is called by the .FETCH code to set up inter- ; rupt forwarding for handlers which will reside in the areas map- ; ped by KERNEL PAR 1 (or PAR 2 if MQH$P2 is true). ; ; Note that an entry will be made in the table only if the ; handler or ISR overlies the areas mapped by KERNEL PAR 1 or 2. ; ; On entry: 2(SP) -> start address of job or handler. ; R2 = job or handler size. ; R5 -> vector address +2 (priority field). ; The vector must already contain the address ; of the real interrupt service routine. ; ; Called with: CALL INTSET ; ; On return: All registers unchanged. ; Carry = 1 if there is no room in $DVINT. ;- .ENABL LSB INTSET::MOV R1,-(SP) ;Save R1. ;+ ; Determine if there is a need to do interrupt forwarding, i.e., does ; the code overly PAR 1 or PAR 2 space (PAR 2 only if MQH$P2 is true). ;- MOV 4(SP),R1 ;R1 = Start address of handler. .IF EQ MQH$P2 CMP R1,# ;Is handler above PAR 1? .IFF ;EQ MQH$P2 CMP R1,# ;Is handler above PAR 2? .ENDC ;EQ MQH$P2 BHIS 30$ ;Yes, then no need to forward. ADD R2,R1 ;R1 = 1st word above handler. CMP R1,# ;Is handler below PAR 1? BLOS 30$ ;Yes, then again, don't forward. .BR INTFIL ;It is in outmapped area so go forward. ............ ;+ ; Find a slot in the interrupt forwarding table (IFT). ;- INTFIL: .ADDR #<$DVINT+4>,R1 ;R1 -> to start of IFT. ;>>>$Rel .-2 $DVINT+4 RMON ;>>>save 1 10$: TST @R1 ;Is this slot free. BEQ 20$ ;Yes, go use it. CMP @R1,#<-1> ;Is this the end of the table. BEQ 40$ ;Yes, then no room, take error exit. ADD #<6>,R1 ;No, then move to the error entry. BR 10$ ;Try again. ............ ;+ ; Slot found, so now transfer the interrupt setup. ;- 20$: MOV -(R5),@R1 ;Move his ISR address to the table. SUB #<4>,R1 ;R1 -> start of IFT. MOV R1,(R5)+ ;Move our table address to the vector. ;+ ; Action complete so return to caller ;- 30$: TST (PC)+ ;Clear the carry and return. 40$: SEC ;Set the carry and return. MOV (SP)+,R1 ;Restore R1 (preserve the carry). RETURN ............ .DSABL LSB .SBTTL INTRLS - Release Entry From Interrupt Forwarding Table ;+ ; This routine is called by the .RELEASE code in the USR, or ; by the .EXIT code in RMON. It is used to clear an entry from the ; interrupt forwarding table. ; ; On entry: R5 -> handlers $ENTRY table entry. ; ; Called with: CALL INTRLS ; ; On return: All registers unchanged. ;- .ENABL LSB INTRLS::JSR R3,SAVE30 ;Save registers 0 to 3. CALL KPSAVE ;Save current PAR 1/3 mapping. MOV @R5,R0 ;R0 -> handler entry point. BEQ 40$ ;Awk, there's nothing there man! SUB #,R0 ;R0 -> handler load point. CLR @R5 ;Remove the entry from $ENTRY. ;+ ; Find the vectors this handler uses. ;- CLR R1 ;Assume handler has fixed vector(s) MOV (R0)+,R3 ;R3 = vector address BEQ 40$ ;No vectors, so just return BPL 30$ ;It has exactly one fixed vector ;+ ; The handler has a multi-vector table. ;- ASL R3 ;R3 = offset to vector table. ADD R3,R0 ;R0 -> handler vector table. MOV (R0)+,R3 ;R3 = the vector offset in question. BPL 20$ ;Branch if fixed vector list MOV (R0)+,-(SP) ;Else get hardware device ID CALL @GETVEC ;Get base vector for device MOV (SP)+,R1 ; in R1 BCS 40$ ;Just return, if GETVEC per chance fails 10$: MOV (R0)+,R3 ;R3 = the vector offset in question. 20$: ADD R1,R3 ;R3 = the vector BLE 40$ ;Branch if there aren't any more CALL INTCTE ;Clear the IFT entry. CMP (R0)+,(R0)+ ;R0 -> next vector table entry. BR 10$ ............ ;+ ; The handler has only a single vector. ;- 30$: CALL INTCTE ;Clear the IFT entry. ;+ ; Now return to the calling routine. ; ; ****************IMPORTANT*************** ; Do not replace CALL/RETURN with CALLR because KPREST needs one return ; address on the stack after KISAR1 (and possibly KISAR2) saved values. ; These saved values are used to restore the mapping register(s) and are ; popped off the stack before returning. KPSAVE from the top of this ; routine has left KISAR1 (and possibly KISAR2) values on the top of the ; stack. ;- 40$: CALL KPREST ;Restore the PAR 1 mapping ... RETURN ; ... and return. ............ .DSABL LSB ;+ ; INTCTE - Subroutine to actually remove an IFT entry. ;- .ENABL LSB INTCTE: .ADDR #<$DVINT>,R2 ;R2 -> Start of IFT. CMP @R3,R2 ;Does vector -> below the IFT? BLO 10$ ;Yes, then it isn't forwarded. ADD #<$DVITT-$DVINT>,R2 ;R2 -> IFT termination entry. CMP @R3,R2 ;Does vector -> above the IFT? BHIS 10$ ;Yes, then it isn't forwarded. ;+ ;INTCTE:CMP @R3,#<$DVINT> ; Does vector -> below the IFT? ;>>>$Rel .-2 $DVINT RMON ; BLO 10$ ; Yes, then it isn't forwarded. ; CMP @R3,#<$DVITT> ; Does vector -> above the IFT? ;>>>$Rel .-2 $DVITT RMON ; BHIS 10$ ; Yes, then it isn't forwarded. ;>>>save 3 ;- MOV @R3,R3 ;R3 -> IFT entry. CLR 4(R3) ;Say that the entry is empty. 10$: RETURN ............ .DSABL LSB .ENDC ;NE XM$FET .SBTTL PLxxxx - Pool Memory Allocation Routine ;+ ;*** DBGEXE *** Following section modified for DBGEXE. ; ; If pool handler is resident, call its memory allocation routine ; There are three entry points: ; ; PL10WD is used to allocate queue elements outside PAR 1 ; PL5WD is used to allocate channel blocks outside PAR 1 ; PLBYTE is used to allocate bytes with no memory address restrictions ; ; R0 = # of (whatever sized) chunks to allocate ; ; CALL PL10WD or ; CALL PL5WD or ; CALL PLBYTE ; ; C-bit = 0 means memory was allocated ; C-bit = 1 means memory was not allocated ;- .ENABL LSB PL10WD::ASL R0 ;Convert to # of 5-word blocks BCS 30$ ;Error on overflow .ASSUME C.SIZ EQ 10. ;Chan siz changed PL5WD:: MUL #,R0 ;Convert to byte count TST R0 ;If R0 <> 0, the byte-count BNE 30$ ; overflowed (BVS doesn't work here!) MOV R1,R0 ;If R0 was non-zero before MUL ; then R1 is set to non-zero ; which is used as a flag to ; indicate PAR 1 restriction BR 10$ ;Join byte allocation code ............ PLBYTE::CLR R1 ;Indicate no PAR 1 restriction 10$: INC R0 ;Round byte count up ... BEQ 30$ BIC #,R0 ; ... to a word boundary .ASSUME I.STAT EQ 0 BIT #,@CNTXT ;Is this job purely virtual? BEQ 30$ ;If not, return with carry set MOV #,-(SP) ;Assume background job .IF EQ SB TST JOBNUM ;Is this the background job? BEQ 20$ ;Branch if so MOV CNTXT,@SP ;@SP -> job's impure area ADD #,@SP ;Compute address of virtual ... BIC #,@SP ; ... address 0 of current job .ENDC ;EQ SB 20$: CALLR @(SP)+ ;Go try to allocate memory ............ 30$: SEC ;Indicate error allocating memory RETURN ............ .DSABL LSB .SBTTL KPSV/RS - Set Default PAR 1 Mapping Routines (KPSAVE,P1SD,KPREST) ;+ ; The following two routines are used simply to save memory ; in the XM environment. ; ; KPSAVE, PAR 1 Save And Set Default is used to replace the ; the instruction sequence: ; ; MOV @#KISAR1,-(SP) ; MOV #,@#KISAR1 ; .IF NE MQH$P2 ;If high speed MQ ; MOV @#KISAR2,-(SP) ; MOV #,@#KISAR2 ; .ENDC ;NE MQH$P2 ; ; P1SD (PAR 1 Set Default) is used to replace: ; ; MOV #,@#KISAR1 ;- KPSAVE::MOV @SP,-(SP) ;Make room on the stack keeping ... .IF NE MQH$P2 MOV @SP,-(SP) ; ... the return address at top. .ENDC ;NE MQH$P2 MOV @#KISAR1,2(SP) ;Put old PAR 1 on the stack. .IF NE MQH$P2 MOV @#KISAR2,4(SP) ;Put old PAR 2 on the stack. MOV #,@#KISAR2 ;Map the default PAR 2. .ENDC ;NE MQH$P2 P1SD:: MOV #,@#KISAR1 ;Map the default PAR 1. RETURN ;Return to caller. ............ ;+ ; KPREST is used to restore PAR 1/2 from the stack as per: ; ; MOV (SP)+,@#KISAR2 ; MOV (SP)+,@#KISAR1 ;- KPREST::MOV 2(SP),@#KISAR1 ;Restore Kernel PAR 1. .IF NE MQH$P2 MOV 4(SP),@#KISAR2 ;Restore Kernel PAR 2. MOV (SP)+,@SP ;Shuffle the return address down, tidy stack .ENDC ;NE MQH$P2 MOV (SP)+,@SP ;Shuffle the return address down, tidy stack RETURN ;Return to the caller. ............ .SBTTL BLKMV - Memory To Memory Block Move Routine ;+ ; This routine is called from a device handler, or any monitor ; component executing in Kernel mode, to move data from one place in ; memory to another. ; ; On entry: R1 = Input buffer PAR 1 value. ; R2 = Input buffer address ***** ; R3 = Output buffer PAR 1 value. ; R4 = Output buffer address ***** ; R5 = WORD count. ; ; ***** Note: The buffer addresses must be biased for PAR 1 ; (ie in the range 20000 - 37777) and normalized ; such that overflow will not occur within a 32. ; word transfer. ; ; Called with: CALL @BLKMV ;(BLKMV -> $BLKMV = $P1EXT-2) ; ; On return: R1 through R5 are random. ; ; R0 is destroyed. ; ; Kernel PAR 1 will be restored to its pre-call ; mapping bias. ; ; Effect: Data is moved from the source buffer to the ; destination buffer. ; ; Restrictions: This routine must be called from Kernel mode ; or User mode with Kernel compatible mapping. ; ; A word count of zero will be treated as 32767. ; ; Warning: If anyone ever makes changes, this routine ; MUST be reentrant! ;- ;+ ; Save mapping context. ;- .ENABL LSB $BLKMV::MOV @#KISAR1,-(SP) ;Save current Kernel mapping. MOV @#UISAR1,-(SP) ;Save current User mapping. MOV @#UISDR1,-(SP) ;Save User PDR 1 too. MOV @#PS,-(SP) ;Save the current PSW. ;+ ; Map to the buffers. ;- MOV #,@#PS ;Previous = User, current = Kernel. MOV #,@#UISDR1 ;Set user access to 4K read/write. .BR 10$ ............ 10$: MOV R1,@#KISAR1 ;Input from Kernel space. MOV R3,@#UISAR1 ;Output to User space. ;+ ; Initialize and transfer 32 words (or less). ;- MOV #,R0 ;Do transfer in 32 word blocks. CMP R5,R0 ;Is there 32 words worth? BHIS 20$ ;Yes, then only do 32 words. MOV R5,R0 ;No, only do as much as there is. 20$: SUB R0,R5 ;Precount this transfer segment. 30$: PUT (R2)+,(R4)+,I ;Transfer a word. SOB R0,30$ ;Loop until 32 words transfered. TST R5 ;Is the transfer complete? BEQ 40$ ;Yes, then go return. INC R1 ;Increment the Kernel PAR 1. INC R3 ;And the User PAR 1. SUB #,R2 ;Reset the input pointer. SUB #,R4 ;Reset the output pointer. BR 10$ ;Continue the transfer. ............ ;+ ; Restore and return. ;- 40$: MOV (SP)+,@#PS ;Restore the PSW. MOV (SP)+,@#UISDR1 ;Restore User PDR 1. MOV (SP)+,@#UISAR1 ;Restore User PAR 1. MOV (SP)+,@#KISAR1 ;Restore Kernel PAR 1. RETURN ;Return to the caller. ............ .DSABL LSB .SBTTL P1EXT - Execute Code Clear Of PAR 1 ;+ ; This routine is called from a device handler to execute instructions ; while Kernel PAR 1 is mapped to a different area of memory. ; ; On entry: Parameters trail, call via R0 ; ; Called with: JSR R0,@P1EXT ;(P1EXT -> $P1EXT) ; .WORD +2 ;Number of instructions plus 2. ; ;Instructions to execute. ; ; . ; . ; ; .WORD ;Kernal PAR 1 bias value. ; ; On return: All registers unchanged except as modified ; by the callers instruction list. ; ; Kernel PAR 1 will be restored to its pre-call ; mapping bias. ; ; Effect: Kernel PAR 1 is remapped to point to the bias ; specified in the word following the ; instruction list and the instructions are ; executed in context off of the stack. ; ; Restrictions: The instruction list may not "back-reference" ; the handler code, (because the handler itself ; may reside in the area mapped by PAR 1). ; ; The instruction list may not remove or place ; anything on the stack that would change the ; stack depth between entry and exit. ; ; Instruction list lengths of more than 32 ; words are not recommended. ; ; R0 may not be used in the instruction list. ;- .ENABL LSB ;+ ; Entry pointer to JOBREL, map virt addr / job num to phy addr ;- $JBREL: CALLR JOBREL ;Jump to translate address ............ .ASSUME $JBREL EQ $P1EXT-26. ;+ ; Entry pointer to MPMEM, map physical memory with Q.MEM and Q.BUFF ;- $MPMEM: CALLR MPMEM ;Jump to map memory routine ............ .ASSUME $MPMEM EQ $P1EXT-22. ;+ ; Entry pointer to XDEALC, deallocate extended memory region ;- $XDEPT: CALLR XDEALC ;Jump to deallocation routine ............ .ASSUME $XDEPT EQ $P1EXT-18. ;+ ; Entry pointer to $USRPH, convert user virtual to physical address. ;- $CVPPT: CALLR $USRPH ;Jump to the conversion routine ............ .ASSUME $CVPPT EQ $P1EXT-14. ;+ ; Entry pointer to FINDGR, find global region routine. ;- $FGRPT: CALLR FINDGR ;Jump to the find region routine. ............ .ASSUME $FGRPT EQ $P1EXT-10. ;+ ; Entry pointer to XALLOC, memory allocation routine. ;- $XALPT: CALLR XALLOC ;Jump to the allocation routine. ............ .ASSUME $XALPT EQ $P1EXT-6 ;+ ; Entry pointer to the block move routine. ;- $BLMPT: BR $BLKMV ;Branch to the block move. ............ .ASSUME $BLMPT EQ $P1EXT-2 ;+ ; Save current mapping and work registers. ;- $P1EXT::MOV @#KISAR1,-(SP) ;Save PAR 1. MOV R1,-(SP) ;Save R1. MOV R2,-(SP) ;SAve R2. ;+ ; Mark the stack usage limits. ;- MOV SP,R1 ;R1 = Current top of stack. SUB (R0)+,SP ;Mark of how much stack we need. MOV SP,R2 ;R2 = New bottom of stack. ;+ ; Move the instruction list onto the stack. ;- 10$: MOV (R0)+,(R2)+ ;Get an instruction. CMP R2,R1 ;Back up at top of stack? BNE 10$ ;No, continue transferring. ;+ ; Map to where he wants PAR 1. ;- MOV -(R2),@#KISAR1 ;New PAR 1 value is on the stack. ;+ ; Put a return last in the instruction list. ;- MOV (PC)+,@R2 ;Store the RETURN. RETURN ;** Data, not executed. ;+ ; Restore registers and dispatch to the stack. ;- MOV (R1)+,R2 ;Restore the user's R2. MOV R1,-(SP) ;Save the stack mark off size. MOV @R1,R1 ;Restore the user's R1. CALL 2(SP) ;Start at stack bottom + 2. ;+ ; Tidy up and return ;- MOV @SP,SP ;Set stack back to where it was. TST (SP)+ ;Move past the old R1 save location. MOV (SP)+,@#KISAR1 ;Restore old kernal PAR 1 mapping. RTS R0 ;Return to the caller. ............ .DSABL LSB .SBTTL TRPXMP - Intercept BPT, IOT, TRAP, MMU TRAPS In KERNEL Mode .ENABL LSB .IF NE MPT$Y TRPXMP::MFPD @#V.MEM+2 ;;; Get possible User PS MFPD @#V.MEM ;;; Get possible User Trap Addr MOV #,-(SP) ;;; Put error code on stack CALL 40$ ;;; Error if came from kernel or priv job PUT #0,@#V.MEM ;;; Prevent recursion by clearing user trap BR 30$ ;;; Merge with common code ........... .ENDC ;NE MPT$Y TRAPBP::MFPD @#V.BPT+2 ;;; BPT trap: get possible User PS MFPD @#V.BPT ;;; Get possible User Trap Addr BR 10$ ;;; Merge with common code ........... TRAPIO::MFPD @#V.IOT+2 ;;; IOT trap: get User PS MFPD @#V.IOT ;;; Get possible User Trap Addr BR 10$ ;;; Merge with common code ........... TRAPTR::MFPD @#V.TRAP+2 ;;; TRAP trap: get User PS MFPD @#V.TRAP ;;; Get possible User Trap Addr 10$: MOV #,-(SP) ;;; Error message to stk in case CALL 40$ ;;; Error if came from kernel or priv job BR 30$ ;;; Merge with common SST code ........... TRAPMM::TST INTLVL ;;; MMU fault: trap from system? BPL 70$ ;;; Yes, fatal error INC (PC)+ ;;; Detect recursion: 20$: .WORD -1 ;;; > 0 => recursive fault BGT 70$ ;;; Recursive fault is fatal MFPD @#V.MMU+2 ;;; Get User PS MFPD @#V.MMU ;;; Get possible User SST DEC 20$ ;;; Reset recursion flag MOV #,-(SP) ;;; Error code to stack CALL 40$ ;;; Error if came from kernel or priv job PUT #0,@#V.MMU ;;; Zero user trap addr. to prevent recursion 30$: TST 2(SP) ;;; Did user specify a vector to handle this? BEQ 60$ ;;; No, give monitor error BIT #,2(SP) ;;; Is it an odd address? BNE 60$ ;;; Yes, abort the job .BR XMRERT ;;; No, reroute to the user .............. ;+ ; Reroute trap to user program ;- XMRERT::MOV R0,@SP ;;; Save R0, purge error code GET SP,R0 ;;; Fetch user stack pointer into R0 SUB #<4>,R0 ;;; Compute new user SP PUT R0,SP ;;; Restore updated user SP PUT 6(SP),(R0)+ ;;; Put interrupt PC onto user stack PUT 10(SP),(R0)+ ;;; Put interrupt PS onto user stack SPL 0 ;;; Drop priority MOV (SP)+,R0 ;Restore R0 MOV (SP)+,2(SP) ;Remove interrupting PC BIC #,@SP ;Clear out current and previous mode bits MOV @#PS,-(SP) ;Get PS BIC #^c,@SP ;Isolate previous mode bits MOV @SP,-(SP) ; and get another copy ASL @SP ;Shift to move previous mode ASL @SP ; bits into current mode position BIS (SP)+,@SP ;Make current and previous mode bits the same BIS (SP)+,@SP ; as SST caller's current mode MOV (SP)+,2(SP) ;Move PS, compress stack RTI ;Dispatch to user/supy SST handler ............ 40$: BIT #<10000>,@#PS ;;; Did SST come from kernel mode? BEQ 50$ ;;; Branch if it did -- it's fatal BIT #,@CNTXT ;;; Is it a privileged task? BNE RETLNK ;;; If not, SST forwarding is allowed 50$: TST (SP)+ ;;; Get rid of return address 60$: SPL 0 ;;; Restore priority MOV (SP)+,R3 ;R3 = Error message code CMP (SP)+,(SP)+ ;Purge null user SST vector MOV (SP)+,R4 ;R4 = offending PC TST (SP)+ ;Purge PS CALLR ERRCOM ;Go to common code .............. 70$: CALLR FATAL ;;; Go to fatal error processor ............. .DSABL LSB .SBTTL FIXTRP - Fix RMON Kernel Mode Vectors For BPT, TRAP, MMU ;+ ; FIXTRP - Restore RMON trap addresses to trap vectors ; ; CALL FIXTRP ; ; R2 = random ;- .ENABL LSB FIXTRP::JSR R5,10$ ;R5 -> list of RMON trap routines TRPLST:: .WORD TRAPBP, PR7 ;**BOOT** BPT trap routine .WORD TRAPIO, PR7 ;**BOOT** IOT trap routine .WORD TRAPTR, PR7 ;**BOOT** TRAP trap routine .WORD TRAPMM, PR7 ;**BOOT** MMU FAULT trap routine ............ 10$: MOV #,R2 ;R2 -> BPT vector MOV (R5)+,(R2)+ ;Restore BPT new PC ... MOV (R5)+,(R2)+ ; ... and BPT new PS .ASSUME V.IOT EQ V.BPT+4 MOV (R5)+,(R2)+ ;Restore IOT new PC ... MOV (R5)+,(R2)+ ; ... and IOT new PS MOV #,R2 ;Point to TRAP vector MOV (R5)+,(R2)+ ;Restore TRAP new PC ... MOV (R5)+,(R2)+ ; ... and TRAP new PS MOV #,R2 ;Point to Memory Mgmt Fault vector MOV (R5)+,(R2)+ ;Restore MMU FAULT new PC ... MOV @R5,@R2 ; ... and MMU FAULT new PS MOV (SP)+,R5 ;Restore R5 RETLNK: RETURN ............ .DSABL LSB ;+ ;*** DBGEXE *** Following section modified for DBGEXE. ; ; $KADR - Convert User Virtual Address to a Compatible Kernel Address ; ; R0 = User virtual address ; ; Current job must be Background job ; ; CALL $KADR ; ; R2 = Kernel address ; ; C=1 if Kernel address is invalid ;- .ENABL LSB $KADR:: MOV R0,R2 ;Assume Kernel address = User address BIT #,@CNTXT ;Is this a privileged job? BEQ 10$ ;Privileged jobs always get what they want! BIT #,@CNTXT ;Is this job completely virtual? BNE 20$ ;Completely virtual jobs always fail! ADD #,R2 ;Add in background job virtual bias CMP R2,$USRLC ;Is Kernel address below the USR? BHIS 20$ ;If not, take error exit 10$: TST (PC)+ ;Clear carry and skip "SEC" instruction 20$: SEC ;Indicate Kernel address is invalid RETURN ............ .DSABL LSB ;+ ;*** DBGEXE *** Following section modified for DBGEXE. ; ; $V2P1 - Convert Virtual Address to 22-bit Physical Address and check ; if it is in Physical PAR 1 ; ; R0 = virtual address (current mapping) If ZM/ZB, curr mode D-space ; ; CALL $V2P1 ; ; R1 = Hi order bits ; R2 = Lo order 16 bits ; ; C=1 if address is in extended memory (>= 28K) ; or in PAR 1 (>= 20000 and < 40000) ;- .ENABL LSB $V2P1:: .IF EQ SUP$Y CALL $USRPH ;Convert User virtual to physical .IFF ;EQ SUP$Y MOV #<<..CURR!..DSPA>/4>,R1 ;Current mode D-space virtual address CALL $VIRPH ;Convert virtual to physical .ENDC ;EQ SUP$Y BCS 10$ ;Branch if address is above 28KW boundary CMP #,R2 ;Is it below PAR 1 physical? BHIS 10$ ;Branch if yes (with C=0) CMP R2,# ;C=0 => above PAR 1; C=1 => in PAR 1 10$: RETURN ............ .DSABL LSB .IF NE SUP$Y ;+ ; $VIRPH - Convert Virtual Address to 22-bit Physical Address ; ; R0 = virtual address (current mapping) ; R1 = mode/space ; ; CALL $USRPH ; ; R1 = Hi order bits ; R2 = Lo order 16 bits ; ; C=1 if address is in extended memory (> 28K) ;- $VIRPH::CALL $RELXX ;Convert to PAR 1 bias/displacement BR $CNPHY ;Go to $CNPHY to get physical address .............. .ENDC ;NE SUP$Y ;+ ; $USRPH - Convert User Virtual Address to 22-bit Physical Address ; ; R0 = User virtual address (current mapping!!) ; ; CALL $USRPH ; ; R1 = Hi order bits ; R2 = Lo order 16 bits ; ; C=1 if address is in extended memory (> 28K) ;- $USRPH::CALL $RELOC ;Convert to PAR 1 bias/displacement .BR $CNPHY ;Fall into $CNPHY to get physical address ............ ;+ ; $CNPHY - Convert Kernel PAR 1 bias/displacement to 22-bit Physical Address ; ; R1 = PAR 1 bias ; R2 = Displacement ; ; CALL $CNPHY ; ; R1 = Hi order bits (in bits 4 through 9) ; R2 = Lo order 16 bits ; ; C=1 if address is in extended memory (> 28K) ;- .ENABL LSB $CNPHY: ASL R2 ;Remove PAR 1 bias from displacement ASL R2 ; SWAB R2 ;Position R2 to move in lo 8 bits CLRB R2 ;Clear low byte ; CLC ;*C* C=0 from CLRB ROR R1 ;Move first 2 ... ROR R2 ; ... of 10 bits ... ASR R1 ; ... from R1 ... ROR R2 ; ... into R2 BISB R1,R2 ;Move other 8 bits into R2 from R1 SWAB R2 ;R1 now has low 16 bits of address CLRB R1 ;Clear lo bits ASR R1 ;Position hi ... ASR R1 ; ... 6 bits into ... ASR R1 ; ... bit positions ... ASR R1 ; ... 4 through 9. SEC ;Guess at address being >28K BNE 10$ ;If R1 NE, it is > 28K CMP #,R2 ;Else if 157777 < R2, it is >28K and C=1 10$: RETURN ;Return ............ .DSABL LSB ;+ ; MPMEM - Convert mapping bias and displacement to 22-bit physical (memory) ; address. Called by device handlers that need to change the PAR 1 ; bias and displacement values passed to the driver into a form which ; it can use. MPMEM computes memory addresses only and should not be ; used to compute UNIBUS addresses for DMA. ; ; R5 -> buffer address (Q.BUFF) in queue element ; ; Called as a negative offset from $P1EXT ; ; R5 -> word count in Q element ; SP -> low order 16 bits of physical address, ; hi order 6 bits in bits 4 through 9 (2 wds pushed on stack) ;- MPMEM: MOV @SP,-(SP) ;Make room on stack and keep return address MOV @SP,-(SP) ;Make room on stack and keep return address MOV R1,-(SP) ;Save R1 MOV Q.MEM-Q.BUFF(R5),R1 ;R1 = PAR 1 bias BR MPPHY ;Join up with $MPPHY ............. ;+ ; $MPPHY - Convert mapping bias and displacement to 22-bit physical address ; called by NPR device drivers to change the PAR 1 bias and ; displacement values passed to the driver in the queue element ; into a form which it can use. $MPPHY builds UNIBUS addresses ; for DMA, and should not be used to build memory addresses. ; ; R5 -> buffer address (Q.BUFF) in queue element ; ; CALL $MPPHY ; ; R5 -> word count in Q element ; SP -> low order 16 bits of physical address, ; hi order 6 bits in bits 4 through 9 (2 wds pushed on stack) ;- $MPPHY::MOV @SP,-(SP) ;Make room on stack and keep return address MOV @SP,-(SP) ;Make room on stack and keep return address MOV R1,-(SP) ;Save R1 MOV Q.PAR-Q.BUFF(R5),R1 ;R1 = PAR 1 bias MPPHY: MOV R2,-(SP) ;Save R2 MOV (R5)+,R2 ;R2 = buffer displacement CALL $CNPHY ;Convert PAR 1/displ to physical MOV R1,10(SP) ;Put hi order bits on stack MOV R2,6(SP) ;Then lo order 16 bits MOV (SP)+,R2 ;Restore regs MOV (SP)+,R1 ; RETURN ;Return ............ ;+ ; $GETBYT - Get next byte from user buffer ; ; R4 -> Q.BLKN in current queue element ; ; CALL $GETBYT (CALL @$GTBYT from within driver) ; ; @SP = next byte of data ; Q.BUFF(R4) address advanced by 1 ; PAR overflow is corrected ; UMR overflow is corrected ; ; Uses PAR 1 ;- .ENABL LSB $GETBYT::MOV @SP,-(SP) ;Make room to return data byte MOV @SP,-(SP) ; ... and padding space for co-routine needs MOV Q$MEM(R4),-(SP) ;Stack PAR 1 for user buffer 10$: CALL XIOSUB ;Save/Set PAR 1 mapping (co-routine) MOVB @Q$BUFF(R4),12(SP) ;Move next byte to stack RETURN ;Fix up stack and bump buffer pointer ............ ;+ ; $OSGTB - Old-style $GETBYT - Get next byte from user buffer ; ; R4 -> Q.BLKN in current queue element ; ; CALL $OSGTB (CALL @$GTBYT from within driver) ; ; @SP = next byte of data ; Q.BUFF(R4) address advanced by 1 ; PAR overflow is corrected ; UMR overflow is corrected (Irrelevant for old-style handlers) ; ; Uses PAR 1 ;- $OSGTB::MOV @SP,-(SP) ;Make room to return data byte MOV @SP,-(SP) ; ... and padding space for co-routine needs MOV Q$PAR(R4),-(SP) ;Stack PAR 1 for user buffer BR 10$ ; and finish up ............ ;+ ; $PUTBYT - Put next byte into user buffer ; ; R4 -> Q.BLKN in current queue element ; @SP = next byte of data to put ; ; CALL $PUTBYT (CALL @$PTBYT from within driver) ; ; Q.BUFF(R4) address advanced by 1 ; PAR overflow is corrected ; UMR overflow is corrected ; Passed byte is removed from the stack ; ; Uses PAR 1 ;- $PUTBYT::MOV Q$MEM(R4),-(SP) ;Stack PAR 1 for user buffer 20$: CALL XIOSUB ;Save/Set PAR 1 mapping (co-routine) MOVB 10(SP),@Q$BUFF(R4) ;Store byte in user buffer RETURN ;Fix up stack and bump buffer pointer ............ ;+ ; $OSPTB - Old-style $PUTBYT - Put next byte into user buffer ; ; R4 -> Q.BLKN in current queue element ; @SP = next byte of data to put ; ; CALL $OSPTB (CALL @$PTBYT from within driver) ; ; Q.BUFF(R4) address advanced by 1 ; PAR overflow is corrected ; UMR overflow is corrected (Irrelevant for old-style handlers) ; Passed byte is removed from the stack ; ; Uses PAR 1 ;- $OSPTB::MOV Q$PAR(R4),-(SP) ;Stack PAR 1 for user buffer BR 20$ ; and finish up ............ ;+ ; $PUTWRD - Put next word into user buffer ; ; R4 -> Q.BLKN in current queue element ; @SP = next word of data to put ; ; CALL $PUTWRD (CALL @$PTWRD from within driver) ; ; Q.BUFF(R4) address advanced by 2 ; PAR overflow is corrected ; UMR overflow is corrected ; Passed word is removed from the stack ; ; Uses PAR 1 ;- $PUTWRD::MOV Q$MEM(R4),-(SP) ;Stack PAR 1 for user buffer 30$: CALL XIOSUB ;Save/Set PAR 1 mapping (co-routine) MOV 10(SP),@Q$BUFF(R4) ;Store word in user buffer INC Q$BUFF(R4) ;Bump pointer one byte RETURN ;Fix up stack and bump buffer pointer ............ ;+ ; $OSPTW - Old-style $PUTWRD - Put next word into user buffer ; ; R4 -> Q.BLKN in current queue element ; @SP = next word of data to put ; ; CALL $OSPTW (CALL @$PTWRD from within driver) ; ; Q.BUFF(R4) address advanced by 2 ; PAR overflow is corrected ; UMR overflow is corrected (Irrelevant for old-style handlers) ; Passed word is removed from the stack ; ; Uses PAR 1 ;- $OSPTW::MOV Q$PAR(R4),-(SP) ;Stack PAR 1 value for user buffer BR 30$ ; and finish up ............ ;+ ; XIOSUB - Common code (co-routine) code for I/O utility routines ;- XIOSUB: MOV @SP,-(SP) ;Make room to save PAR 1 value MOV @#KISAR1,2(SP) ;Save current PAR 1 value MOV 4(SP),@#KISAR1 ;Map to user buffer CALL @(SP)+ ;CALL caller. He will "RETURN" back. MOV (SP)+,@#KISAR1 ;Restore PAR 1 value TST (SP)+ ;Pop PAR 1 value for user buffer MOV (SP)+,@SP ;Pop data or dummy word keeping return addr INC Q$BUFF(R4) ;Increment buffer pointer to next byte CMP #,Q$BUFF(R4) ;Exceeds PAR 1 + 1 chunk boundary? ;>>> Is this a sufficient test BHI 40$ ;BR if we didn't (i.e., address is OK) SUB #,Q$BUFF(R4) ;Make buffer ptr PAR 1 biased again INC Q$MEM(R4) ;Adjust mapping value INC Q$PAR(R4) ;Adjust UMR pointer (or mapping value) 40$: RETURN ............ .DSABL LSB ;+ ; REGABT - Eliminate all extended memory regions belonging to job currently ; in abort context. Called from System State, eliminates all ; regions and unmaps any windows mapped to those regions. ; ; Extended memory is returned to the free list. ; ; R5 -> impure area of job ; ; CALL REGABT ; ; R4 = random ; R5 -> job impure area ;- .ENABL LSB REGABT::JSR R3,SAVE30 ;Save registers ;I&D+ MOV @#KISAR1,-(SP) ;Save kernel PAR1 MOV I.MPTR(R5),@#KISAR1 ;Map job's MCA with kernel PAR1 MOV #,R3 ;R3 -> RCBs MOV #,-(SP) ;Stack the number of regions to check ;I&D- 10$: TST R.BSIZ(R3) ;This region in use? BEQ 30$ ;No, skip it CMP #,@R3 ;Is this region 0 (starts in low memory)? BLOS 20$ ;No, eliminate it BITB #,R.BSTA(R3) ;If shared then it is "KERNEL" global BEQ 30$ ;Branch if not -- it is region 0 20$: CALL ELRG ;Eliminate it 30$: ADD #,R3 ;Point to next region DEC @SP ;More to go? BNE 10$ ;Yes TST (SP)+ ;Dump region count MOV (SP)+,@#KISAR1 ;Restore kernel PAR1 RETURN ;Return ............ .DSABL LSB .SBTTL JOBREL - Convert Virtual Address/Job # To PAR 1 Bias & Displacement ;+ ; JOBREL - Convert a 16-bit virtual address with mode, space, and job # ; into a PAR 1 bias and displacement. ; ; R0 = Virtual address to translate ; R1 = Space/Mode/Job number (0, 2, 4, ...) ; NOTE: job number is NOT validated as to range or evenness ; R3 = size of area to check in chunks ; ; CALL JOBREL ; ; If CARRY clear ; R0 = Virtual address ; R1 = PAR 1 relocation bias ; R2 = PAR 1 displacement (0200xx) ; R3 = chunk size of contiguous mapping starting at offset 0 in ; PAR mapping virtual address in R0 ; ; If OVERFLOW clear, all of area is mapped ; If OVERFLOW set, not all of area is mapped ; ; If CARRY set ; ; R1,R2 random ; JOB does not exist or invalid or inactive mode specified ;- .ENABL LSB 10$: MOV (SP)+,R5 ;Restore working MOV (SP)+,R4 ; registers R5 and R4 MOV (SP)+,@#KISAR1 ;Restore Kernel PAR1 MOV (SP)+,R3 ;Restore R3 20$: SEC ;Indicate an error RETURN ; and return JOBREL:: ;Entry for by job number virt to phy convert MOVB R1,R2 ;Get job number (as index into $IMPUR table) .ADDR #$IMPUR,R2,ADD ;>>>$REL MOV @R2,R2 ;Get impure area address BEQ 20$ ;No impure area, means no job ;NOTE: BG impure always exists .IF NE SUP$Y SWAB R1 ;Get mode/space to bits 0-2 MOV R1,R5 ;Isolate mode BIC #^C<3>,R5 ; of request DEC R5 ;User mode or Supervisor mode request? BGT 20$ ;Branch if not .ENDC ;NE SUP$Y JOBRL1: MOV R3,-(SP) ;Save requested chunk size for mapping MOV @#KISAR1,-(SP) ;Save kernel PAR1 mapping MOV I.MPTR(R2),@#KISAR1 ;Map kernel PAR1 to job's saved APRs MOV R4,-(SP) ;Save working MOV R5,-(SP) ; registers .IF EQ SUP$Y BIT #<3>,R1 ;User mode request? BNE 10$ ;Branch if not MOV #,-(SP) ;Get base PAR register address in R2 .IFF ;EQ SUP$Y MOV R1,R5 ;Isolate mode BIC #^C<3>,R5 ; of request CMP #<3>,R5 ;User/Supervisor/Current mode request? BEQ 10$ ;Branch if not .IFTF ;EQ SUP$Y CMP R2,CNTXT ;Is requested job the current job? .IFT ;EQ SUP$Y BEQ 30$ ;Branch if yes MOV #,@SP ;Get base PAR register address on stack 30$: .IFF ;EQ SUP$Y BNE 40$ ;Branch if not CALL $RELXY ;Get base PAR register address in R2 BCS 10$ ;Branch if mode not active -- error BR 60$ ;Found base PAR register -- join common code ........... 40$: MOV R2,R4 ;Copy requested job's impure area pointer COM R1 ;Convert I-space bit to a D-space bit ASR R1 ; and isolate ASR R1 ; it in bit 0 BIC #^C<1>,R1 ;R1 = MMR3.U if D-space requested, else 0 .ASSUME MMR3.U EQ 1 MOV #,R2 ;Get base PAR register address in R2 TST R5 ;Is request for user mode? BEQ 50$ ;Branch if so BIT #,I.CMAP(R4) ;Is supervisor mode active in job? BEQ 10$ ;Branch if not MOV #,R2 ;Get base PAR register address in R2 .ASSUME MMR3.S EQ MMR3.U*2 ASL R1 ;Set R1 = MMR3.S if D-space requested, else 0 50$: BIT R1,@#PAR1+M.MMR3 ;Does D-space exist and was requested? BEQ 60$ ;Branch if not .ASSUME EQ ADD #,R2 ;Get base PAR register address in R2 60$: MOV R2,-(SP) ;Get base PAR address on the stack .ENDC ;EQ SUP$Y MOV R0,R5 ;Copy virtual address CLR R4 ;Initialize PDR number accumulator ASHC #<3>,R4 ;Get PDR number in R4 MOV #<8.>,R5 SUB R4,R5 ;Save number of PDRs left ASL R4 ;Convert PDR number to word index ADD @SP,R4 ;Point to a PAR MOV (R4)+,R2 ;Get base PAR CLR -(SP) ;Accumulate total size on stack BR 80$ ;Branch into loop ........... 70$: CMP #<128.>,R3 ;If last PDR wasn't full then end of BNE 90$ ; contiguous mapping so branch out of loop CMP (R4)+,R2 ;Is next PAR value contiguous? BNE 90$ ;Branch if not 80$: .Assume UISDR0-UISAR0 EQ M.PDUI-M.PAUI BIT #<2>,(R4) ;Is this APR mapped? BEQ 90$ ;Branch out of loop if not .Assume UISDR0-UISAR0 EQ M.PDUI-M.PAUI MOV (R4),R3 ;Get PDR contents BIC #^C<77400>,R3 ;Isolate page length field (PLF) SWAB R3 ; and get it in low byte INC R3 ;Adjust to actual page length ADD R3,@SP ;This APR is contiguous so accumulate size ADD R3,R2 ;Calculate what next PAR must contain SOB R5,70$ ;Count down another PDR and branch 90$: MOV (SP)+,R3 ;Get actual contiguous size in R3 MOV (SP)+,R2 ;R2 = address of PAR 0 MOV (SP)+,R5 ;Restore working MOV (SP)+,R4 ; registers R5 and R4 CALL $RELO4 ;Relocate virtual address in R0 MOV (SP)+,@#KISAR1 ;Restore kernel PAR1 mapping CMP (SP)+,R3 ;Is contiguous mapped size big enough? BLOS 110$ ;Branch if so ;CLC ;C=0 from falling through BLOS 100$: SEV ;Indicate contiguous mapped size is too small RETURN ...... 110$: .WORD ;Size is big enough (clear C and V) RETURN ;Return here with C=0 and V=0 ...... .DSABL LSB .SBTTL $RELOK - Convert Kernel Virtual Address To PAR 1 Value & Address ;+ ; $RELOK - Convert a 16-bit Kernel virtual address into a PAR 1 relocation ; and displacement. ; ; R0 = Kernel virtual address ; ; CALL $RELOK ; ; R0 = Kernel virtual address ; R1 = PAR 1 relocation bias ; R2 = Displacement ;- .ENABL LSB $RELOK::MOV #,-(SP) ;Calculate using Kernel mapping BR $RELO6 ;Do common processing ............ .SBTTL $RELOC - Convert User Virtual Address To PAR 1 Value & Address ;+ ; $RELOC - Convert a 16-bit user virtual address into a PAR 1 relocation ; bias and displacement. ; ; R0 = User virtual address ; ; CALL $RELOC ; ; Carry clear ; R0 = User virtual address ; R1 = PAR 1 relocation bias ; R2 = Displacement ;- $RELOC::MOV #,R2 ;Calculate using User mapping $RELO4: MOV R2,-(SP) ;Save base PAR address $RELO6: MOV R0,R1 ;Copy virtual address MOV R0,R2 ;Save copy of virtual address CLR R0 ;Initialize PAR number accumulator ASHC #<3>,R0 ;Get PAR number in R0 ASL R0 ;Convert PAR number to word index ADD (SP)+,R0 ;Point to a PAR CLRB R1 ;Clear bits of offset within 32w block SWAB R1 ;Put MMU block offset within PAR in low byte ;CLC ;C=0 from SWAB ROR R1 ; and make it a true offset ADD @R0,R1 ;Add in PAR value to get physical block number MOV R2,R0 ;Put virtual address back in R0 BIC #^c,R2 ;Clear all but displacement within block BIS #,R2 ;Set PAR 1 bias CLC ;Make sure carry is clear RETURN ;Return ...... .DSABL LSB ;+ ; ACHBK2 - Check 2-word user virtual address range for validity, map to it ; ACHBKM - Check user virtual address range for validity, map to it ; ; R0 = user virtual address of start of block ; R1 = size of block in bytes (ACHBKM only) ; ; CALL ACHBK2 or ACHBKM ; ; R0 = displacement in block (usable mapped address) ; R1 = random ; R2 = random ; C=0 if address entire address range is mapped contiguously ; If so, R0 is valid and mapped ; C=1 otherwise ;- .ENABL LSB ACHBK2::MOV #<2*2>,R1 ;Check 2 wd block ACHBKM::CALL ACHBK ;Check block BCS 10$ ;Return C=1 if error .BR $RELOM ;Convert to PAR 1 value and bias .............. ;+ ; $RELOM - Convert 16-bit prev. mode virtual address to PAR 1 value and ; address and remap KISAR1 for use by the caller. ; ; R0 = previous mode virtual address ; ; CALL $RELOM ; ; R0 = displacement in block (i.e. usable mapped address) ; R1 = random ; R2 = random ; KISAR1 loaded with bias ;- $RELOM:: .IF NE SUP$Y MOV #<<..CURR!..DSPA>/4>,R1 ;Relocate prev mode/data space address CALL $RELXX ;Relocate it .BR $RELMP ; and map it .............. .IFF ;NE SUP$Y CALL $RELOC ;Compute bias and displacement .IFT ;NE SUP$Y $RELMP: .ENDC ;NE SUP$Y MOV R1,@#KISAR1 ;Set KISAR1 with bias MOV R2,R0 ;Set R0=displacement 10$: RETURN ;Return ...... .IF NE SUP$Y $RELSD::MOV #,R2 ;Set offset for D-space registers BR $RELSX ;Compute Supervisor bias and displacement .............. $RELSI: CLR R2 ;Set offset for I-space registers $RELSX: CALL $RELSY ;Get base PAR for Supervisor mode 20$: BCC $RELO4 ;Compute bias and displacement if C=0 RETURN ;Return with carry set if Supy not active ...... $RELUD::MOV #,R2 ;Set offset for D-space registers BR $RELUX ;Compute User bias and displacement .............. $RELUI: CLR R2 ;Set offset for I-space registers $RELUX: CALL $RELUY ;Get base PAR for User mode BR 20$ ; and go compute bias and displacement ........... 30$: MOV #,R2 ;Calculate using Kernel mapping .BR 40$ ;Fall into success return ........... ;+ ; Come here for processing a "current" mode request or reserved request ; Currently reserved request is processed as a "current" mode request. ;- 40$: TST (PC)+ ;CLC and skip "SEC" 50$: SEC ;SEC RETURN ...... 60$: SOB R1,50$ ;Branch if reserved mode MOV @#PS,R1 ;Get PS to process "current" mode request ASH #<3.>,R1 ;Get previous mode bits to carry and sign bits BPL 30$ ;Branch if neither user nor supervisor mode BCC $RELSY ;Use supervisor mode registers .BR $RELUY ;Use user mode registers .............. $RELUY: MOV #,-(SP) ;Use user mode registers MOV #,R1 ;Store user mode space separation mask 70$: BIT R1,@#MMR3 ;Check if space is separated BEQ 80$ ;Branch if not -- must use I-space ADD R2,@SP ;Use either I or D-space as requested 80$: MOV (SP)+,R2 ;Get appropriate base PAR in R2 BR 40$ ;Go to successful return ........... $RELXX::CALL $RELXY ;Get base PAR for requested mode BR 20$ ; and go compute bias and displacement ........... $RELXY: CLR R2 ;Assume I-space BIT #<..ISPA/4>,R1 ;Is it I-space? BNE 90$ ;Branch if so MOV #,R2 ;Set offset for D-space registers 90$: BIC #^C<3>,R1 ;Isolate mode argument BEQ $RELUY ;Branch if user mode SOB R1,60$ ;Branch if not supervisor mode .BR $RELSY ;Branch to process supervisor mode request .............. $RELSY: MOV #,-(SP) ;Use supy mode registers MOV #,R1 ;Store supy mode space separation mask BIT #,@#MMR3 ;Is supervisor mode active? BNE 70$ ;Join common code if so COM (SP)+ ;Else dump stack and set carry RETURN ; and take error return ...... .ENDC ;NE SUP$Y .SBTTL ACHJBM - Address Check 3 Word User Virtual Range, Map To It ;+ ; ACHJBM - Address check 3 word user virtual range, map to it ; ; R0 = user virtual address of start of block ; ; CALL ACHJBM ; ; R0 = usable mapped address ; R1,R2 random ; C set if invalid address or block not contiguously mapped ;- ACHJBM::MOV #<3*2>,R1 ;Check 3 word block CALL ACHBKM ;Address check block, map to it BCC 10$ ;If CC, aok CALLR ADERR ; MONERR ............ .DSABL LSB .SBTTL ACHBK - Check Prev Mode/D-Space Virtual Address Range For Validity ;+ ; ACHBK - Check prev mode/D-space virtual address range for validity ; ; R0 = prev mode/D-space virtual address of start of block ; R1 = size of block in bytes ; ; CALL ACHBK ; ; R1 -> end of block (last byte in block, not past it) ; R2 = random ; C=0 if address entire address range is mapped contiguously ;- .ENABL LSB ACHBK:: .IF NE SUP$Y MOV #<<..CURR!..DSPA>/4>,R2 ;Prev mode/D-space else I-space .IFF ;NE SUP$Y CLR R2 ;User mode/I-space only for XM/XB .ENDC ;NE SUP$Y .BR ACHBK1 .SBTTL ACHBK1 - Check User Virtual Address Range For Validity ;+ ; ACHBK1 - Check user virtual address range for validity ; ; R0 = user virtual address of start of block ; R1 = size of block in bytes ; R2 = mode/space to check ; ; CALL ACHBK1 ; ; R1 -> end of block (last byte in block, not past it) ; R2 = random ; C=0 if address entire address range is mapped contiguously ;- .ENABL LSB ACHBK1::TST R1 ;Test for 0 byte BEQ 10$ ;= -> 0, don't adjust, check for 1 word DEC R1 ;Make R1 the next lower BIC #<1>,R1 ;Truncate to word boundary 10$: ADD R0,R1 ;Add in the addr of start of the block MOV R1,-(SP) ;*C* Save -> to last byte of block MOV R3,-(SP) ;Save work register MOV R2,-(SP) ;Save mode/space argument BCS 20$ ;Branch if carry set (virtual addr overflow) ;CLC ;C=0 because BCS didn't branch MOV CNTXT,R2 ;*C* R2 -> job impure area BIT #,@R2 ;*C* Is job privileged? BEQ 20$ ;*C* Branch if yes and ignore the error BIT #,@R2 ;*C* Is batch running? BNE 20$ ;*C* Branch if yes and ignore the error MOV R0,-(SP) ;Get base virtual address BIC #<17777>,@SP ; of PAR MOV R1,R3 ;Get address of last byte in block SUB (SP)+,R3 ;Calculate number of bytes into PAR to end -1 ASH #<-6>,R3 ;Convert to number of chunks (-1) BIC #^C<1777>,R3 ; and make sure no sign extend INC R3 ;Get actual number of chunks MOV @SP,R1 ;Get mode/space argument in R1 for JOBRL1 CALL JOBRL1 ;Check that block is mapped BCS 20$ ;Branch if inactive or invalid space requested BVC 20$ ;Branch if block is mapped (C=0 here) SEC ;Indicate block isn't mapped 20$: MOV (SP)+,R2 ;*C* Restore mode/space argument MOV (SP)+,R3 ;*C* Restore work register MOV (SP)+,R1 ;*C* Get -> last byte in block RETURN .DSABL LSB .SBTTL MAPWN - Map A Virtual Address Window To Physical Memory ;+ ; MAPWN - Map a virtual address window to physical memory ; ; R4 -> Window Control Block (which points to RCB) ; ; CALL MAPWN ; ; R0 = random ; R1 = random ; R3 = random ; R4 -> next WCB ;- .ENABL LSB .ASSUME W.BLPD EQ W.BLGH-2 MAPWN:: ADD #,R4 ;R4 -> last word of current WCB MOV W.BRCB-W.BLPD(R4),R3 ;R3 -> region control block BEQ 30$ ;Branch if window not mapped .ASSUME W.BOFF EQ W.BLPD-4 CMP -(R4),-(R4) ;R4 -> window offset MOV @R3,R0 ;R0 = start address of region ADD (R4)+,R0 ;Add in window offset .ASSUME W.BFPD EQ W.BOFF+2 MOVB (R4)+,R1 ;R1 = first PDR (sign extension) .ASSUME W.BNPD EQ W.BFPD+1 MOVB (R4)+,R3 ;R3 = # of PDRs to load BR 20$ ............ 10$: BIS #,(R1)+ ;Set block length 20$: MOV R0,UISAR0-UISDR0(R1) ;Load user PAR ADD #,R0 ;Advance to next 4K bound .ASSUME W.BLPD EQ W.BNPD+1 MOV @R4,@R1 ;Load PDR (access code + cache bit) ; (block length valid for last PDR only) SOB R3,10$ ;Loop if another PDR to load .ASSUME W.BLGH EQ W.BLPD+2 30$: TST (R4)+ ;R4 -> next WCB RETURN ............ .DSABL LSB .SBTTL MAPLO - Set User Mapping Registers Identical To Kernel Map ;+ ; MAPLO - Set user mapping registers identical to Kernel map ; ; CALL MAPLO ; ; R0 = random ; R1 = random ; R2 = random ;- .ENABL LSB .IF NE SUP$Y MAPLOS: MOV #,R1 ;R1 -> User PAR 0 BR 10$ ;Join common code ........... .ENDC ;NE SUP$Y MAPLO:: MOV #,R1 ;R1 -> User PAR 0 10$: CLR R0 ;Begin mapping at physical location 0 MOV #7.,R2 ;7 I-space APRS to initialize .IIF NE SUP$Y .ASSUME SISDR0-SISAR0 EQ UISDR0-UISAR0 20$: MOV #,(R1) ;Initialize a PDR MOV R0,(R1)+ ;Initialize a PAR ADD #,R0 ;Bump to next 4KW address SOB R2,20$ ;Loop until all 8 APRs are initialized MOV #,(R1) ;Set cache bypass for I/O page MOV #,(R1)+ ;Initialize PAR7 to map I/O page RETURN ...... .DSABL LSB .SBTTL CLRPDR - Clear User PDRs (Erase Previous User Mapping) ;+ ; CLRPDR - Clear User PDRs (erase previous User mapping) ; ; CALL CLRPDR ; ; R0 -> 2 bytes past User PDR7 ;- .ENABL LSB .IF NE SUP$Y CPDRSI: MOV #,R0 ;R0 -> S-I PDRs BR 10$ ;Join common code ........... .ENDC ;NE SUP$Y CLRPDR::MOV #,R0 ;R0 -> User PDRs 10$: CALL @PC ;Do code until RETURN, twice CLR (R0)+ ;Clear a PDR CLR (R0)+ ;Clear a PDR CLR (R0)+ ;Clear a PDR CLR (R0)+ ;Clear a PDR RETURN ;Return ...... .DSABL LSB .IF NE SUP$Y ;+ ; R0 -> WDB at W.NID ; R4 -> U-I WCB 0 for current job ; ; CALL ADJWIN ; ; R3 = random ; R4 -> requested mode-requested space WCB 0 for current job ;- .ENABL LSB 10$: BIT @SP,@#MMR3 ;Is D-space active? BEQ 90$ ;If not, use I-space 20$: ADD #,R4 ;R4 -> data space WCBs BR 90$ ........... 30$: BIT @SP,@#MMR3 ;Is D-space active? BEQ 90$ ;If not, just use I-space -- exit CLR @SP ;Arrange for Z-bit to be set on exit BR 20$ ;Point to D-space when both requested ........... ; and active 40$: .ASSUME WS.D EQ 10 .ASSUME EQ 14 SOB R3,30$ ;Branch if WS.D and WS.I ; else WS.D only BIT @SP,@#MMR3 ;Is D-space active? BNE 20$ ;If yes use D-space, else error 50$: SEC ;Invalid mode or space error BR 100$ ;*C* Go clean up stack and return 60$: .ASSUME WS.C EQ 2 SOB R3,50$ ;Branch if reserved mode -- error MOV @#PS,R3 ;Get PS ASH #<3.>,R3 ;Move "current" (previous) mode bits ; to carry and sign bits BPL 50$ ;Kernel mode or reserved is error BCS 80$ ;Branch if user mode BR 70$ ;Branch (supervisor mode) ........... ADJWIN: MOV I.PLSP(R5),R3 ;Get request status ADJWN1: MOV R3,-(SP) ;Save mode/space argument for later MOV #,-(SP) ;Assume user mode BIC #^C,R3 ;Isolate mode bits .ASSUME WS.U EQ 0 BEQ 80$ ;Branch if user mode .ASSUME WS.S EQ 1 SOB R3,60$ ;Branch if not supervisor mode 70$: .ASSUME MMR3.S EQ INC @SP ;@SP = MMR3.S ADD #,R4 ;R4 -> supervisor mode WCBs 80$: MOV 2(SP),R3 ;Get mode/space argument again BIC #^C,R3 ;Isolate space bits .ASSUME WS.DEF EQ 0 BEQ 10$ ;Default space (D if active, else I) .ASSUME WS.SPA EQ <^B1100> ASR R3 ;Position WS.SPA bits ASR R3 ; in bits 0 and 1 .ASSUME WS.I EQ 4 SOB R3,40$ ;Branch if not WS.I only 90$: CLC ;Clear carry 100$: MOV (SP)+,(SP)+ ;*C* Clean-up stack and set/clear Z bit RETURN ;*CZ* Return .DSABL LSB .SBTTL C$MAP - .CMAP, .GCMAP, .MSDS Directive Dispatch ;+ ; C$MAP - Dispatcher for .CMAP, .GCMAP, and .MSDS directives ; These directives are variations of EMT 375, code 53 ;- PRCFLD: MOV @R0,R2 ;Get modify bit ASR R2 ;Produce characteristic bit BIS @R0,R2 ;Produce mask MOV @SP,R3 ;Get request parameter COM R2 ;Produce BIC mask BIC R2,R3 ;Isolate modify bit and characteristic bit BIT (R0)+,R3 ;Does request want to modify characteristic? BEQ 10$ ;Branch if not COM R2 ;Produce mask BIC R2,@R5 ;Clear bits in job's I.CMAP BIS R3,@R5 ;Set bits in job's I.CMAP per request 10$: RTS R0 ;Return .......... COPIDA: MOV (R0)+,R1 ;Get PDR0 of requested mode and space MOV #<8.>,R2 ;8 APRs to copy .ASSUME SISAR0-SDSDR0 EQ UISAR0-UDSDR0 .ASSUME SISDR0-SDSDR0 EQ UISDR0-UDSDR0 .ASSUME SDSAR0-SDSDR0 EQ UDSAR0-UDSDR0 10$: MOV (R1),(R1) ;Copy PAR MOV (R1),(R1)+ ;Copy PDR SOB R2,10$ ;Loop to copy all 8 APRs RTS R0 .......... .ENABL LSB COPIDW: MOV @R0,R1 ;Get PAR1 biased pointer to D-space WCBs MOV #,R2 ;R2 = # of words in single space's WCBs .ASSUME M.WCSI-M.WCSD EQ M.WCUI-M.WCUD 10$: MOV (R1),(R1)+ ;Copy I-space WCBs to D-space SOB R2,10$ ;Loop until all words are copied MOV (R0)+,R1 ;Get PAR1 biased pointer to D-space WCBs MOV #W.NNUM,-(SP) ;Get number of WCBs in a single space .ASSUME W.BRCB EQ 0 20$: MOV @R1,R2 ;Get -> RCB if window is mapped BEQ 30$ ;Branch if window isn't mapped INCB R.BNWD(R2) ;Increment count of windows mapped to region 30$: ADD #W.BLGH,R1 ;R1 -> next WCB DEC @SP ;Any more WCBs to check BNE 20$ ;Branch if so BR 60$ ;Clean up stack and return ........... DELWIN: MOV (R0)+,R1 ;Get PAR1 biased pointer to D-space WCBs MOV #W.NNUM,-(SP) ;Get number of WCBs in a single space .ASSUME W.BRCB EQ 0 40$: MOV @R1,R2 ;Get -> RCB if window is mapped BEQ 50$ ;Branch if window isn't mapped DECB R.BNWD(R2) ;Decrement count of windows mapped to region .ASSUME W.BRCB EQ 0 CLR @R1 ;Unmap window (actually we just abandon it) 50$: ADD #W.BLGH,R1 ;R1 -> next WCB DEC @SP ;Any more WCBs to check BNE 40$ ;Branch if so 60$: TST (SP)+ ;Dump temporary loop counter RTS R0 ;Return .......... .DSABL LSB CLRSIW: MOV (R0)+,R1 ;Get PAR1 biased pointer to I-space WCBs MOV #,R2 ;R2 = # of words in single space's WCBs 10$: CLR (R1)+ ;Clear I-space WCBs SOB R2,10$ ;Loop until all words are copied RTS R0 ;Return .......... .ENABL LSB C$MAP:: ADD #,R5 ;R5 -> job's I.CMAP ENSYS EMTRTI ;Modify database without interruption MOV @R5,<5*2>(SP) ;Return old I.CMAP in R0 BIS #,<5*2>(SP) ; command to restore JSR R0,PRCFLD ;Update CM.U field in I.CMAP .WORD JSR R0,PRCFLD ;Update CM.SUP field in I.CMAP .WORD JSR R0,PRCFLD ;Update CM.S field in I.CMAP .WORD BIT #,R0 ;Request to change separated APRs? BEQ 10$ ;Branch if not MOVB R0,@R5 ;Update PAR locking map in I.CMAP 10$: MOV (R5),@#KISAR1 ;Map job's MCA MOV #,R3 ;R3 -> MMR3 (memory management register 3) MOV @R3,R5 ;Save previous MMR3 contents COM R5 ; with sense of all bits reversed MOV #,R4 ;R4 is user mode I&D separation bit MOV R0,-(SP) ;Save request parameter for reference BIC #^C,R0 ;Isolate user mode I&D separation field .ASSUME CM.UXX EQ 100000 BPL 30$ ;Branch if not requesting modification BIC R4,@R3 ;Assume user mode not I&D space separated BIT R4,R5 ;Was user mode already separated? BNE 20$ ;Branch if not JSR R0,DELWIN ;Delete previous U-D windows .WORD 20$: .ASSUME CM.UID EQ 140000 ASL R0 ;Requesting user I&D separation? BPL 30$ ;Branch if not JSR R0,COPIDW ;Copy U-I windows to U-D windows .WORD JSR R0,COPIDA ;Copy U-I APRs to U-D APRs .WORD BIS R4,@R3 ;Set user mode I&D space separated 30$: .Assume MMR3.S EQ MMR3.U*2 ASL R4 ;R4 = MMR3.S MOV #,R1 ;R1 is supervisor mode support (CSM) bit CLR R2 ;Clear copy S-I to S-D flag MOV @SP,R0 ;Get request parameter again BIC #^C,R0 ;Isolate supervisor mode I&D separation field BIT #,R0 ;Requesting modification? BEQ 40$ ;Branch if not BIC R4,@R3 ;Assume supy mode not I&D space separated CMP #,R0 ;Requesting supervisor I&D separation? BNE 40$ ;Branch if not MOV R1,R2 ;Set copy S-I to S-D flag BIS R4,@R3 ;Set supervisor mode I&D space separated 40$: BIS R1,R4 ;R4 = MOV (SP)+,R0 ;Restore request parameter BIC #^C,R0 ;Isolate supervisor mode support field BIT #,R0 ;Requesting modification? BEQ 60$ ;Branch if not BIC R1,@R3 ;Assume no supervisor context (no CSM) BIT R1,R5 ;Was supervisor mode already enabled? BNE 50$ ;Branch if not JSR R0,DELWIN ;Delete previous S-I windows .WORD 50$: CMP #,R0 ;Requesting supervisor mode support? BNE 60$ ;Branch if not MOV @#PS,-(SP) ;Save PS BIS #,@#PS ;Force previous mode to User mode MFPD SP ;Get User SP BIC #<20000>,@#PS ;Force previous mode to Supervisor mode MTPD SP ;Set Supervisor SP to User SP MOV (SP)+,@#PS ;Restore original PS CALL MAPLOS ;Map S-I space like kernel CALL CPDRSI ;Set S-I PDRs to abort all accesses JSR R0,CLRSIW ;Clear all S-I windows .WORD MOV #,R2 ;Set copy S-I to S-D flag BIS R2,@R3 ;Set for supervisor context (CSM) 60$: MOV R2,-(SP) ;Save copy S-I to S-D flag BEQ 70$ ;Branch if no supy mods requested BIT R4,R5 ;Was supervisor mode already separated? BNE 70$ ;Branch if not JSR R0,DELWIN ;Delete previous S-D windows .WORD 70$: BIT (SP)+,@R3 ;Should we copy S-I windows and APRs to S-D? BEQ 80$ ;Branch if not JSR R0,COPIDW ;Copy S-I windows to S-D windows .WORD JSR R0,COPIDA ;Copy S-I APRs to S-D APRs .WORD 80$: .BR LOKAPR .............. LOKAPR: ROR -(SP) ;Save carry in case caller cares MOV CNTXT,R5 ;R5 -> job's impure area MOV I.CMAP(R5),R0 ;Get PAR lock map and status BIT #,R0 ;Is supervisor mode active? BEQ 130$ ;Branch if not MOV #,R4 ;Assume user mode is not I&D separated MOV #,R2 ;Assume supy mode is not I&D separated BIT #,@#MMR3 ;Is user mode I&D separated? BEQ 90$ ;Branch if not MOV #,R4 ;R4 -> user data PDR0 90$: BIT #,@#MMR3 ;Is supervisor mode I&D separated? BEQ 100$ ;Branch if not MOV #,R2 ;R2 -> supy data PDR0 100$: ; Selectively copy user (data) APRs to supervisor (data) APRs MOV #<8.>,R3 ;8 APRs to check/copy 110$: RORB R0 ;Is APR separated? BCS 120$ ;Branch if yes MOV (R4),(R2) ;Copy PAR MOV @R4,@R2 ;Copy PDR 120$: BIT (R4)+,(R2)+ ;Bump to next APR pair SOB R3,110$ ;Loop until all APRs are checked/copied 130$: ROL (SP)+ ;Restore carry for caller RETURN ...... .DSABL LSB .ENDC ;NE SUP$Y .SBTTL .ASTX - AST Exit Routine ;+ ; EMT 16(16) - Exit AST Routine ; ; A$STX - Required in a mapped system to exit a user AST service routine. ; Returns to Kernel mode and recalls AST queue manager ($CRTNE). ; ; Requires R0=0 for completion routine exit. ; ; If issued when not in completion by a user program, ; it is treated like an .EXIT request. ; ; Special case for KMON only, when R0 is non-zero. ; Used to start a user program after being loaded by KMON. ; There are two cases: ; ; 1. Program overlays KMON. R0 = block # to read ; ; 2. Program does not overlay KMON. R0 = -1 ; ; Any other use of .ASTX may cause system malfunction. ;- .ENABL LSB A$STX:: MOV SP,R2 ;Copy stack pointer ADD #,R2 ;Point to User PC on stack CALL JOBKMN ;From KMON? BPL 10$ ;No, do completion TST @SP ;If KMON, doing completion? BNE 20$ ;No, start a job 10$: TST @R5 ;Was completion already active? BPL 50$ ;No, treat it like exit MOV PC,@R2 ;Change PC to go to $CRTR2 ADD #<$CRTR2-.>,(R2)+ ;>>> MOV #<$CRTR2>,(SP)+ ;Change PC to go to $CRTR2 ;>>>$Rel .-2 $CRTR2 RMON ;>>>save 1 BR 40$ ;Exit the EMT ............ 20$: .ADDR #,R3 ;Point to RDOVLY in RMON ;>>>20$: MOV #,R3 ;Point to RDOVLY in RMON ;>>>$Rel .-2 RDOVLY RMON ;>>>save 1 CMP #<-1>,@SP ;Will the KMON be overlaid? BNE 30$ ;Yes ADD #,R3 ;No, simply go to ENTRPG 30$: MOV R3,(R2)+ ;Change User PC on stack BIT #,@#$JSW ;Is this a virtual job? BEQ 40$ ;No BIS #,@R5 ;Yes, set virtual in Job State Word 40$: MOV #,@R2 ;Go in Kernel mode GOERTI: CALLR EMTRTI ;Return from RTI to someplace ............ 50$: CALLR GOEXIT ;Treat as .EXIT ............ .DSABL LSB P$LAS1: MOV @#KISAR1,-(SP) ;; Save kernel PAR1 MOV R5,-(SP) ;; Copy routine name MOV CNTXT,R5 ;; R5 -> pointer to BG impure area MOV I.MPTR(R5),@#KISAR1 ;; Map kernal PAR1 to job's MCA CALL @(SP)+ ;; Call routine MOV (SP)+,@#KISAR1 ;; *C* Restore kernel PAR1 .IF NE SUP$Y LOKAP1: BR LOKAPR ;; *C* Make sure locked APRs are kept locked .IFF ;NE SUP$Y RETURN ;; *C* Return .ENDC ;NE SUP$Y ...... .SBTTL P$LAS - PLAS Directive Dispatch ;+ ; P$LAS - Dispatcher for Extended Memory (PLAS) directives ; These directives are subcoded within EMT 375, code 36. ; ; Enter here with R4 = Subcode * 2 ;- .ENABL LSB P$LAS:: CMP #,R4 ;Subcode within limits? BLOS 130$ ;No, too large MOV #,R1 ;Assume region definition block CMP #<..CRAW*2>,R4 ;Is it a region directive? BHI 10$ ;Yes, assumed size is OK MOV #,R1 ;R1 = size of window definition block 10$: ;I&D+ MOV R1,R3 ;Save parameter block size ASR R3 ;Convert byte count to word count ;I&D- CALL ACHBKM ;Address check and map block BCS 140$ ;Error in WCB/RCB address ;I&D+ MOV R5,R1 ;Construct pointer to job's I.MPB ADD #,R1 ; to hold working copy of parameters ; CLC ;Add clears carry (never wraps) ENSYS 100$ ;Modify database without interruption MOV R3,-(SP) ;; Save parameter block word count MOV @#KISAR1,-(SP) ;; Save mapping to user parameter block MOV R0,-(SP) ;; Save pointer to user parameter block MOV R1,-(SP) ;; Save pointer to working parameters 20$: MOV (R0)+,(R1)+ ;; Move a word from parameter block SOB R3,20$ ;; Loop till done copying parameter block MOV I.MPTR(R5),@#KISAR1 ;; Map kernel PAR1 to job's MCA .IF NE SUP$Y CLR I.PLSP(R5) ;; Clear pass indicator for I and D space ;; so region requests will be called once .IFTF ;NE SUP$Y CMP #<..CRAW*2>,R4 ;; Is this a region directive? BHI 60$ ;; Branch if yes .IFT ;NE SUP$Y MOV -(R1),I.PLSP(R5) ;; Get mode/space parameters (W.NSTS) BIC #,@R1 .IFF ;NE SUP$Y BIC #,-(R1) .IFT ;NE SUP$Y MOV @SP,R0 ;; R0 -> working parameters MOV R4,R2 ;; Save directive index (ADJWIN destroys it) CALL ADJWIN ;; Check for mode/space errors/restrictions BCS 120$ ;; Inactive mode/space hard error BEQ 30$ ;; Branch if both spaces selected and D active BIS #,@R1 ;; Indicate D-space inactive (W.NSTS) ;; but do I-space anyway BIC #,I.PLSP(R5) ;; Indicate no D-window pass 30$: CMP #<..CRAW*2>,R2 ;; Is this a .CRAW directive? BEQ 50$ ;; Branch if yes -- don't compare I and D ;; windows CALL CHKWIN ;; Check that I and D window are identical BCC 40$ ;; Branch if they match BIS #,@R1 ;; Indicate that D-window doesn't match ;; I-window but process both I and D ;; windows anyway (W.NSTS) 40$: CMP #<..GMCX*2>,R2 ;; Is this a .GMCX directive? BNE 50$ ;; Branch if not BIC #,I.PLSP(R5) ;; Indicate no D-window pass 50$: MOV R2,R4 ;; Get request subcode in R4 again .ENDC ;NE SUP$Y 60$: MOV @SP,R0 ;; R0 -> working parameters .IF NE SUP$Y MOV R4,-(SP) ;; Save request subcode .ENDC ;NE SUP$Y .ADDR #<150$>,R4,ADD ;; R4 -> slot in table MOV @#$SYPTR,R2 ;; ADD @R4,R2 ;; R2 -> PLAS routine ;>>> MOV 150$(R4),R2 ;; R2 -> PLAS routine ;>>>$REL ;>>>save 4 CALL @R2 ;; Dispatch to PLAS routine .IF NE SUP$Y MOV (SP)+,R4 ;; *C* Restore request subcode BCC 110$ ;; *C* If CC, no error .IFF ;NE SUP$Y BCC 80$ ;; *C* If CC, no error .ENDC ;NE SUP$Y 70$: INC 20(SP) ;; *C* Set C bit in PS that ENSYS saved 80$: MOV (SP)+,R2 ;; *C* R2 -> working parameter block MOV (SP)+,R0 ;; *C* R0 -> user parameter block MOV (SP)+,@#KISAR1 ;; *C* Map kernel PAR1 to user parameter block MOV (SP)+,R3 ;; *C* Restore parameter block word count 90$: MOV (R2)+,(R0)+ ;; *C* Move a word into user parameter block SOB R3,90$ ;; *C* Loop till done copying parameter block .IF NE SUP$Y BR LOKAP1 ;; *C* Make sure locked APRs are kept locked .IFF ;NE SUP$Y RETURN ;; *C* Get out of System State .ENDC ;NE SUP$Y ...... 100$: BCC GOERTI ;No error from System State MOVB R1,@#$ERRBY ;Put error code in error byte BIS #,OLDPS(SP) ;Set carry in EMT's saved PS BR GOERTI ;EXIT from EMT .............. .IF NE SUP$Y 110$: MOV CNTXT,R5 ;; R5 -> job's impure area MOV I.PLSP(R5),R2 ;; Get last pass mode/space status BIC #^C,R2 ;; Isolate space bits CMP #,R2 ;; Is request to do both I and D space? BNE 80$ ;; *C* Branch if not (C=0 here from CMP) BIC #,I.PLSP(R5) ;; Do one more time as I space BR 60$ ;; Do request again for I space ........... 120$: MOV #ER.IMS,R1 ;; Invalid mode/space BR 70$ ;; Go set carry for caller's EMT return ........... .ENDC ;NE SUP$Y ;I&D- 130$: CALLR TOOBIG ;Code too big .............. 140$: CALLR ERRARG ;Give an argument error .............. 150$: .WORD < C$RRG - $RMON > ;0 Create Region .WORD < E$LRG - $RMON > ;1 Eliminate Region .WORD < C$RAW - $RMON > ;2 Create Window .WORD < E$LAW - $RMON > ;3 Eliminate Window .WORD < M$AP - $RMON > ;4 Map Window .WORD < U$NMAP - $RMON > ;5 Unmap Window .WORD < G$MCX - $RMON > ;6 Get Map Context ;>>150$: .WORD C$RRG ;0 Create Region ;>>>$Rel .-2 C$RRG RMON ;>>> .WORD E$LRG ;1 Eliminate Region ;>>>$Rel .-2 E$LRG RMON ;>>> .WORD C$RAW ;2 Create Window ;>>>$Rel .-2 C$RAW RMON ;>>> .WORD E$LAW ;3 Eliminate Window ;>>>$Rel .-2 E$LAW RMON ;>>> .WORD M$AP ;4 Map Window ;>>>$Rel .-2 M$AP RMON ;>>> .WORD U$NMAP ;5 Unmap Window ;>>>$Rel .-2 U$NMAP RMON ;>>> .WORD G$MCX ;6 Get Map Context ;>>>$Rel .-2 G$MCX RMON PLASMX =: < . - 150$ > .DSABL LSB .SBTTL .CRAW - Create Virtual Address Window EMT ;+ ; C$RAW - Create user virtual address window, optionally map to region ; ; R0 -> user Window Definition Block with the following fields set: ; W.NAPR - Base PAR ; W.NSIZ - Window size ; W.NRID - (Region to map) ; W.NOFF - (Offset into region) ; W.NLEN - (Length of window to map) ; W.NSTS - Window status info ; (WS.MAP = 1 If window is to be mapped) ; R5 -> job impure area ; ; CALL C$RAW ; ; C=0 if request successful ; C=1 if error in request ; R1 = error code: ; 0 => Alignment error in window definition ; 1 => No window blocks available ; 2 => (Illegal region specified) ; Output fields in window definition block: ; W.NID - Assigned window ID ; W.NBAS - Window virtual base address ; W.NLEN - (Length actually mapped) ; W.NSTS - Window status ; WS.CRW = 1 if window established ; WS.ELW = 1 if window eliminated ; (WS.UNM = 1 if window unmapped) ; ; User Virtual Address Space is divided into pieces called Windows. ; Each window starts on a 4K virtual address boundary and must fall ; completely within the 32K words of virtual address space. ; If a window overlaps the virtual address space of an existing window, ; the existing window is deleted. Window 0 may not be deleted. ;- .ENABL LSB C$RAW: ;I&D+ MOV #,R4 ;R4 -> first WCB .IF NE SUP$Y CALL ADJWIN ;R4 -> to correct mode/space WCBs MOV #,R1 ;*C* Assume "inactive mode/space" error BCS 100$ ;Branch if space/mode not active to error .ENDC ;NE SUP$Y ;I&D- MOV (R0)+,R2 ;R2 = base PAR (hi byte) CLRB R2 ;Clear low byte CMP R2,(PC)+ ;Legal PAR number? .BYTE <0>,<7> BHI 80$ ;No, give error ASR R2 ;Convert to 32 wd blocks MOV R2,@R0 ;Save in descriptor block ASR @R0 ;Convert to bytes ASR @R0 SWAB (R0)+ ;Put PAR number in high 3 bits giving base TST @R0 ;Is the specified window size 0 BEQ 80$ ;Yes, error MOV R2,-(SP) ;Stack the base address in MMU blocks ADD @R0,@SP ;Compute high limit = base+size (MMU blocks) BCS 70$ ;Overflow is definitely an error CMP @SP,# ;Exceeds KT virtual limit? BHI 70$ ;Error, window extends beyond 32KW virtual .BR 10$ ............ 10$: CMP -(R0),-(R0) ;Back up to start of user's WDB MOV #,R1 ;R1 = number of WCB's, R4 -> first WCB MOV R1,-(SP) ;Save number of WCB's available .IF NE SUP$Y .ASSUME M.WCSI GT M.WCUI .ASSUME M.WCSI GT M.WCUD .ASSUME M.WCSI LT M.WCSD CMP R4,# ;Is this a supy window? BHIS 20$ ;If so, window 0 is fair game .ENDC ;NE SUP$Y BIT #,@R5 ;Is this a privileged task? BNE 20$ ;No, virtual tasks cannot overlap window 0 ADD #,R4 ;Yes, don't chk window 0 (we can shorten ... DEC R1 ;... it) and count one fewer WCB to check ;+ ; Find a WCB. Check to see if new window overlaps existing windows. ;- 20$: TST W.BSIZ(R4) ;Is this window block in use? BEQ 40$ ;Got a free one, go use it MOV W.BLVR(R4),R3 ;Get low virt. limit of this window (4*n K) SWAB R3 ;Convert to 32 wd blocks ASL R3 ; (divide by 64) ASL R3 CMP 2(SP),R3 ;New high limit below old low limit? BLOS 50$ ;If so, no overlap possible here ADD W.BSIZ(R4),R3 ;Compute high limit CMP R2,R3 ;New low limit above previous high? BHIS 50$ ;Yes, no overlap ;I&D+ .IF NE SUP$Y .ASSUME M.WCSI GT M.WCUI .ASSUME M.WCSI GT M.WCUD .ASSUME M.WCSI LT M.WCSD CMP R4,# ;Is this a supy window? BHIS 30$ ;If so, then don't protect window 0 .ENDC ;NE SUP$Y BIT #,@R5 ;Is this VBGEXE? BNE 30$ ;If so, then don't protect window 0 ;I&D- CMP R1,@SP ;Overlap. Are we overlapping window 0? BEQ 60$ ;Yes, that is illegal 30$: .IF NE SUP$Y MOV 4(SP),R3 ;Get WS.D and WS.I flag to R3 for ELAW .ENDC ;NE SUP$Y CALL ELAW ;Eliminate overlapped window ;+ ; Establish the new window and check for further overlaps ;- 40$: TST @SP ;Has a window been established? BEQ 50$ ;Yes ;I&D+ MOV #W.NNUM,-(SP) ;Get number of windows in this mode/space SUB R1,@SP ;Calculate the current window number (of R4) SWAB @SP ;Calculate base address of ASR @SP ; corresponding PAR CMP (SP)+,R2 ;Is this the window we want to use? BNE 50$ ;Branch if not ;I&D- CMP (R0)+,(R0)+ ;Point to window size MOV @R0,W.BSIZ(R4) ;Store size to establish window MOV -(R0),W.BLVR(R4) ;Save low virtual address MOVB -(R0),R3 ;Get base PAR number ASL R3 ;Convert to word offset ADD #,R3 ;R3 -> first PDR of window MOVB R3,W.BFPD(R4) ;Set first PDR address MOVB @SP,-(R0) ;Pick up total # WCB's SUB R1,@R0 ;Set window ID = WCB number CLR @SP ;Indicate window established 50$: ADD #,R4 ;Point to next block ;CLC ;C=0 from 'ADD' since it can't overflow SOB R1,20$ ;Check for more overlap if more WCBs to search ;CLR R1 ;Clear error return word (since SOB fell thru) MOV (SP)+,(SP)+ ;Dump flag & high limit. Window established? BNE 90$ ;No, give error of no WCB's BIS #,W.NSTS(R0) ;Flag window created BIT #,W.NSTS(R0) ;Map to region? BNE M$AP ;Yes, go map it. RETURN ;Else return ...... ;+ ; Errors in CRAW ;- 60$: TST (SP)+ ;Purge stack 70$: TST (SP)+ ;Purge stack 80$: CLR R1 ;Bad window definition .ASSUME ER.WAL EQ 0 BR 100$ ............ 90$: INC R1 ;No windows available (R1=0 from above) .ASSUME ER.PAR EQ 1 100$: SEC RETURN ...... .DSABL LSB .SBTTL .ELAW - Eliminate Address Window ;+ ; E$LAW - Eliminate user virtual address window and unmap if necessary ; ; R0 -> user window definition block with the following fields set: ; W.NID = ID of window to eliminate ; R5 -> user impure area ; ; CALL E$LAW ; ; C = 0 if successful ; W.NSTS - window status word ; WS.ELW = 1 if window eliminated ; WS.UNM = 1 if window unmapped ; C = 1 if illegal address window ID ; R1= Error code: ; 3 => Illegal window identifier ;- E$LAW: CALL GETWND ;Search for specified window ELAW: CALL UNMAPP ;Unmap if necessary, setting WS.UNM if done CLR W.BSIZ(R4) ;Indicate window is eliminated BIS #,W.NSTS(R0) ;Set in status byte RETURN ;Return ...... .SBTTL .MAP - Map Address Window to Region ;+ ; M$AP - Map an existing window to a region, unmapping first if necessary ; ; R0 -> window definition block with the following fields set: ; W.NID - ID of window to map ; W.NRID - ID of region to use ; W.NOFF - offset within region to start ; W.NLEN - length of window to map ; 0 => all of window or all that will fit in region ; non-0 => exact amount only or return error ; R5 -> user impure area ; ; CALL M$AP ; ; C = 0 if successful ; C = 1 if error ; R1= error code: ; 2 => illegal region ID ; 3 => illegal window ID ; 4 => invalid region offset/size combination ; ; Output fields in window definition block: ; W.NLEN - actual length mapped ; W.NSTS - window status byte ; WS.UNM = 1 if window unmapped first ;- .ENABL LSB M$AP: CALL GETWND ;Find window control block ADD #,R0 ;R0->specified region ID in user WDB CALL GETREG ;Find the region control block CMP @R3,# ;Going to map region 0? BHIS 10$ ;No ... CLR KMLOC ;Yes, throw out the KMON !!! 10$: MOV R3,-(SP) ;Save ptr to region block MOV W.BLVR(R4),-(SP) ;Copy low virtual address of window TST (R0)+ ;Point to offset MOV (R0)+,R2 ;Get offset into region (W.NOFF) CMP R2,R.BSIZ(R3) ;Is it within the region? BHIS 110$ ;If not, error MOV @R0,R1 ;Get length to map (W.NLEN) BNE 20$ ;Length specified, use it MOV R.BSIZ(R3),R1 ;Get size of region SUB R2,R1 ;Subtract starting offset to get size to map CMP R1,W.BSIZ(R4) ;Size to end > window size? BLOS 20$ ;No, can map the whole rest of the region MOV W.BSIZ(R4),R1 ;Yes, map only what fits in the window 20$: .IF NE SUP$Y CALL PS1OF2 ;Is request to do both I and D space? BEQ 30$ ;Branch if yes so that next pass will work .ENDC ;NE SUP$Y MOV R1,@R0 ;Return length actually mapped 30$: MOV R1,-(SP) ;Calculate high virtual address: SWAB @SP ;Multiply size mapped by 64 ;CLC ;C=0 from 'SWAB' above RORB @SP ; ROR @SP ; ROR @SP ; DEC @SP ;Point to last addressable byte ADD 2(SP),@SP ;Then add to low virtual address .BR 40$ ........... 40$: MOV W.BSIZ(R4),-(SP) ;Copy window size CMP R1,@SP ;Length to map within window? BHI 100$ ;If not, error MOV R2,-(SP) ;Copy offset into region ADD R1,R2 ;Add length to map to get end of area to map CMP R2,R.BSIZ(R3) ;Beyond end of region? BHI 90$ ;Yes, error MOV W.BFPD(R4),-(SP) ;Save first PDR address MOV #,-(SP) ;Set for 4K/Read/Write (W.LPD) BITB #,R.BSTA(R3) ;Inhibit caching? BEQ 50$ ;Branch if not MOV #,@SP ;Set for 4K/read/write/cache inhibit 50$: ;I&D+ BIT #,(R0) ;Is this read-only mapping? BEQ 60$ ;Branch if not, allow full read/write BIC #<4>,@SP ;Make PDR's ACF cause all writes to abort 60$: ;I&D- INCB R.BNWD(R3) ;Increment count of windows mapped to region SUB #,R0 ;Point to start of user WDB again CALL UNMAPS ;Unmap window if necessary, set WS.UNM if so MOVB W.BFPD(R4),R0 ;R0->first PDR (depends on sign extend!) .IF NE SUP$Y CALL ADJPDR ;Adjust R0 PDR pointer for correct space/mode .ENDC ;NE SUP$Y MOV R.BADD(R3),R3 ;R3=start of region ADD 4(SP),R3 ;Add offset to get base of window CLRB 3(SP) ;Initialize number of PDR's mapped 70$: INCB 3(SP) ;Inc number of PDR's MOV R3,UISAR0-UISDR0(R0) ;Set main PAR MOV @SP,(R0)+ ;and main PDR ADD #,R3 ;Bump PAR value to next PAR SUB #,R1 ;Count down length left to map BGT 70$ ;Not done yet SWAB R1 ;Shift unused size to hi byte CLRB R1 ;Clear low byte ADD R1,@SP ;Calculate size in last PDR ADD R1,-(R0) ;Set last PDR MOV R4,R3 ;Copy pointer to window control block ADD #,R3 ;Point past end of WCB 80$: MOV (SP)+,-(R3) ;Copy stack image into real block CMP R3,R4 ;Done? BHI 80$ ;No ;CLC ;C=0 since loop ended with R3=R4, BEQ=>BCC RETURN ...... 90$: TST (SP)+ ;Pop 1 wd from stack 100$: CMP (SP)+,(SP)+ ;Pop 2 wds 110$: CMP (SP)+,(SP)+ ;Pop 2 wds MOV #,R1 ;Illegal size/offset SEC ;Flag an error RETURN ;Return from EMT ............ .DSABL LSB .SBTTL .UNMAP - Unmap An Address Window ;+ ; U$NMAP - Unmap a virtual address window ; ; R0 -> window definition block with the following fields set: ; W.NID - window ID to be unmapped ; R5 -> job impure area ; ; CALL U$NMAP ; ; C = 0 if successful ; C = 1 if error ; R1= error code: ; 3 => illegal window ID ; 5 => window not mapped ;- .ENABL LSB U$NMAP: CALL GETWND ;Find specified window MOV #,R1 ;Preset error code in case not mapped UNMAPS: UNMAPP: CALL UNMAP ;Unmap it BCS 10$ ;Error if not mapped BIS #,W.NSTS(R0) ;Indicate window unmapped 10$: RETURN ...... .DSABL LSB .SBTTL .CRRG - Create An Extended Memory Region ;+ ; C$RRG - Create an extended memory region of requested size. ; Allocate a region in XM and fill in the RCB for it. ; ; R0 -> user region definition block with the following fields set: ; R.GSIZ - size of region requested ; R.GNAM - name of global region requested (if RS.GBL set) ; R5 -> user impure area ; ; CALL C$RRG ; ; R0 must be on stack at 14(SP), as a value is returned here by C$RRG ; ; C = 0 if request successful ; C = 1 if error ; R1= error code: ; 6 => No region control blocks available ; 7 => Region of requested size not available ; user's R0 = size of largest region possible ; 10 => Illegal region size specification ; 12 => Requested global region was not found ; 13 => No global region control blocks available ; 15 => Global region is privately in use ; 16 => Global region base misaligned for request ; ; Output fields in region definition block: ; R.GID - Region identifier ; R.GSTS - Region status word ; RS.CRR=1 Region created successfully ; RS.NEW=1 If Global region was created ;- .ENABL LSB C$RRG: TST (R0)+ ;R0 -> R.GSIZ word in RDB .ASSUME R.GSIZ EQ R.GID+2 MOV (R0)+,R2 ;Get size requested. .ASSUME R.GSTS EQ R.GSIZ+2 BIC #,@R0 ;Region not created yet ;I&D+ MOV #,R5 ;R5 -> region control blocks. ;I&D- MOV #,R1 ;Assume error is "too many regions". .IF EQ < R.GNUM - ER.NRC > MOV R1,R3 ;R3 = # of region blocks - 1 (plus 1). .IFF ;EQ < R.GNUM - ER.NRC > MOV #,R3 ;R3 = # of region blocks - 1 (plus 1). .ENDC ;EQ < R.GNUM - ER.NRC > 10$: .ASSUME R.BLGH EQ ER.NRC ADD R1,R5 ;No, advance to next block at R.BSTA offset DEC R3 ;Is there another? BEQ 150$ ;No, return error 6. .ASSUME R.BSIZ EQ R.BSTA-2 BIT -(R5),(R5)+ ;Is this region block free? BNE 10$ ;No, look again. CLR @R5 ;Yes, then preclear status and map count. ;+ ; Now determine if any global action is required ;- CLR R4 ;Clear the global region request flag BIT #,@R0 ;Use global instead of free list? BEQ 60$ ;No, then go use free list. MOV R5,-(SP) ;Save R5 for a moment. MOV R0,R5 ;R5 -> start of region definition block. .ASSUME R.GNAM EQ R.BSTA+2 TST (R5)+ ;R5 -> name of global region requested. CALL FINDGR ;Try to find the global region. MOV (SP)+,R5 ;*C* Restore R5 (without changing the carry) BCS 50$ ;Region wasn't found if carry set. TSTB GR.SHC(R1) ;Is global region private? BMI 200$ ;Branch if so ;+ ; Region found so try to make it look like we just used XALLOC. ;- MOV R2,R3 ;R3 = requested size BNE 20$ ;Branch if requested size is not 0 .ASSUME GR.SIZ EQ 0 MOV @R1,R3 ;Use entire size of global region .ASSUME GR.SIZ EQ 0 20$: MOV (R1)+,R2 ;Get the size. BIT #,@R0 ;Was a base address specified? BEQ 30$ ;Branch if not CMP R.GBAS-R.GSTS(R0),@R1 ;Requested base matches regions base? BNE 160$ ;Take error exit, if not 30$: BIT (R1)+,(R1)+ ;R1 -> GR.NAM CMP R3,R2 ;Is the global region big enough? BHI 130$ ;No, so give "too big error" INCB -(R1) ;Increment global region's reference count BITB #,-(R1) ;Were we to inhibit caching global region? BEQ 40$ ;Branch if not BISB #,@R5 ;Set inhibit caching in local RCB 40$: BISB #,@R5 ;Set status as shared region in local RCB .ASSUME GR.ADD EQ GR.SIZ+2 MOV -(R1),R1 ;Get its address. BR 80$ ;Merge below (as if we XALLOCed). ............ ;+ ; Global RCB not found, so create one as requested. ;- 50$: BIT #,@R0 ;Does he want a global region created? BEQ 170$ ;No, take error exit. MOV R1,R4 ;Save pointer to the global region. BEQ 180$ ;No region, take error exit. BIT (R4)+,(R4)+ ;R4 -> GR.STA .ASSUME GR.STA EQ GR.SIZ+4 .ASSUME GR.SHC EQ GR.STA+1 MOV (PC)+,@R4 ;Set GR.SHC to -1. Indicate private .BYTE <0>,<-1> MOV R.GBAS-R.GSTS(R0),R1 ;R1 = requested region base address BIT #,@R0 ;Is the region base address specified? BNE 70$ ;Branch if not 60$: CLR R1 ;There is no region base addr specified ;+ ; Try to allocate memory for the region. R2 = size to allocate. ;- 70$: TST R2 ;Is requested size zero? BEQ 190$ ;If so, then request is invalid CALL XALLOF ;Allocate extended memory BCS 130$ ;Not available, return error 7 from XALLOC BNE 80$ ;Branch if memory is from free list BIT #,@R0 ;Does the user want to use non-system mem. ? BEQ 130$ ;If not, we have a size error BISB #,@R4 ;Indicate in global RCB that memory is NRF ;+ ; Return pertinent data to the job's region definition block (RDB) ;- .ASSUME R.GID EQ R.GSTS-4 80$: BIT -(R0),-(R0) .ASSUME R.BADD EQ R.BSTA-4 BIT -(R5),-(R5) MOV R5,(R0)+ ;Return region ID .ASSUME R.BSIZ EQ R.BADD+2 MOV R2,(R0)+ ;Return region size .ASSUME R.BSTA EQ R.BSIZ+2 BIS #,@R0 ;Flag successful creation ;+ ; Initialize the local jobs region control block (in impure area) ;- MOV R1,(R5)+ ;Store physical addr (R.BADD) .ASSUME R.BSIZ EQ R.BADD+2 MOV R2,(R5)+ ; and size (R.BSIZ). .ASSUME R.BSTA EQ R.BSIZ+2 ;+ ; Initialize the global region control blocks as appropriate ;- TST R4 ;Were we to create a global region? BEQ 120$ ;No, then just carry on. BIS #,@R0 ;Flag new global region created. BIS #,@R5 ;Flag local RCB as being shared. BIT #,@R0 ;Global region eliminated on exit/abort? BEQ 90$ ;Branch if not BIS #,@R5 ;Set local RCB to eliminate global region ; on exit/abort 90$: BIT #,@R0 ;Were we to age this region. BEQ 100$ ;No, then go exit. BISB #,@R4 ;Yes, set flag in global region status 100$: BIT #,@R0 ;Were we to inhibit caching global region? BEQ 110$ ;Branch if not BISB #,@R4 ;Set inhibit caching in global RCB BISB #,@R5 ;Set inhibit caching in local RCB 110$: .ASSUME GR.ADD EQ GR.STA-2 MOV R1,-(R4) ;Store the address. .ASSUME GR.SIZ EQ GR.ADD-2 MOV R2,-(R4) ;Yes, then store the size. ;+ ; Successful return (with carry clear) ;- 120$: TST (R5)+ ;Clear carry and skip past status word RETURN ............ ;+ ; Error returns, set max size if appropriate and return with carry set ;- 130$: MOV #,R1 ;Give "too big" error. 140$: .IF NE SUP$Y MOV R2,26(SP) ;Return size of largest available region .IFF ;NE SUP$Y MOV R2,24(SP) ;Return size of largest available region .ENDC ;NE SUP$Y 150$: SEC ;Flag error RETURN ............ 160$: MOV #,R1 ;Say that gbl. region base addr. is misaligned BR 150$ ;Take error exit ............ 170$: MOV #,R1 ;Report the global region not found BR 150$ ;Take error exit ............ 180$: MOV #,R1 ;Say that Global RCBs are all in use BR 150$ ;Take error exit ............ 190$: MOV #,R1 ;Give "illegal region size" error. BR 140$ ;Return sending the size back. ............ 200$: MOV #,R1 ;Give "global region is private" error BR 150$ ;Take error exit ............ .DSABL LSB .SBTTL .GMCX - Get Window Mapping Context ;+ ; G$MCX - Get mapping context of window ; Returns in a form suitable for use as a window definition block ; ; R0 -> window definition block containing window ID ; R5 -> user impure area ; ; CALL G$MCX ; ; C = 0 if successful ; C = 1 if error ; R1= Error code: ; 3 => illegal window ID ;- .ENABL LSB G$MCX: CALL GETWN0 ;Locate window control blk INC R0 ;R0 -> base APR (W.NAPR) MOV (R4)+,R3 ;Save region control block address MOV (R4)+,R1 ;R1 = low virtual address (W.BLVR) MOVB -1(R4),@R0 ;Get high byte of base addr (4K multiple) ASLB @R0 ;Make it Base APR (W.NAPR) ROLB @R0 ; by shifting top 3 bits ROLB @R0 ; down into ROLB (R0)+ ; bottom 3 bits of W.NAPR MOV R1,(R0)+ ;Move virtual base address MOV (R4)+,R2 ;Get high virtual address MOV (R4)+,(R0)+ ;Set window size (W.NSIZ) MOV R3,(R0)+ ;Move RCB address into place (W.NRID) BEQ 30$ ;Not mapped to a region ;I&D+ CMP R3,# ;Is this region 0? ;I&D- BNE 10$ ;No BIC -(R0),(R0)+ ;Yes, set to region 0 default ID of 0 10$: MOV (R4)+,(R0)+ ;Set offset into region (W.NOFF) SUB R1,R2 ;Calculate window length ADD #,R2 ;Round up to nearest block ASH #<-6.>,R2 ;Convert to 32 wd blocks BIC #,R2 ; by unsigned division by 64 MOV R2,(R0)+ ;Move length into W.NLEN BIS #,@R0 ;Indicate window is mapped read/only TST (R4)+ ;R4 -> last PDR value and C=0 MOV (R4)+,R2 ;*C* Get PDR contents BIC #^C<4>,R2 ;*C* Clear all but write-allowed bit BEQ 20$ ;*C* Branch if read-only BIC #,@R0 ;*C* Say window is mapped read/write 20$: RETURN ;Return ............ 30$: CLR (R0)+ ;Not mapped. Clear W.NOFF CLR (R0)+ ; and W.NLEN and C=0 ; CLR @R0 ; and W.NSTS BIC #^C,@R0 ;*C* Clear out garbage in W.NSTS RETURN ;Return ............ .DSABL LSB .SBTTL GETREG - Get RCB Corresponding To Region ID ;+ ; GETREG - Find region control block for specified region ID ; ; R0 -> Region ID ; R5 -> Job impure area ; SP -> EMT dispatcher return address ; ; CALL GETREG ; ; R2 = Random ; R3 -> Region control block ; ; C=1 If no region or RCB not in use, returns to caller's caller, and ; R1 = Error code: ; 2 => Region ID is invalid ;- .ENABL LSB GETREG: ;I&D+ MOV #,R3 ;Point to first region control block ;I&D- TST @R0 ;Default to region 0? BEQ 50$ ;Yes, use first RCB CMP @R0,R3 ;Is it the address of region 0? BEQ 50$ ;EQ -> Yes, wants region 0 CMP #<-1>,@R0 ;/V Overlay region created by KMON? BNE 10$ ;NE -> No ADD #,R3 ;Yes, then it always uses RCB #2 BR 50$ ;and return ............ 10$: MOV #,R2 ;Get count of region control blocks (+1) BR 30$ ;Enter search loop ............ 20$: ADD #,R3 ;R3 -> Next RCB 30$: DEC R2 ;Any left? BEQ 40$ ;No, return invalid region ID error CMP @R0,R3 ;Is this the one? BNE 20$ ;No, look more TST R.BSIZ(R3) ;Is region allocated? BNE 50$ ;Yes, we found it 40$: TST (SP)+ ;Purge address to return to EMT dispatch PLERR2: MOV #,R1 ;Report region ID error SEC ;Set C bit 50$: RETURN ............ .DSABL LSB .SBTTL .ELRG - Eliminate An Extended Memory Region ;+ ; E$LRG - Eliminate an extended memory region. ; Free a region control block and return the memory to the free list. ; Any windows which may be mapped are unmapped first. ; ; R0 -> region definition block with the following fields set: ; R.GID - region identifier ; R5 -> job impure area ; ; CALL E$LRG ; ; C = 0 if request successful ; R.GSTS - region status word ; RS.UNM = 1 if window unmapped because of this request ; RS.NAL = 1 if region was not previously allocated ; C = 1 if error ; R1= Error code: ; 2 => illegal region ID ; 11 => deallocation failure due to excess memory fragmentation. ; ; ELRG - Eliminate an extended memory region. ; Called in abort context where the RCB pointer is passed in R3. ; ; Inputs: R3 -> region control block ; R5 -> impure area ;- .ENABL LSB ELRG: BIT #,R.BSTA(R3) ;Are we to eliminate global region too? BNE 10$ ;Branch if so JSR R0,ELRG1 ;R0 -> fake RDB status word .WORD 0 ;Fake RDB status (no global region eliminate) ............ 10$: JSR R0,ELRG1 ;R0 -> fake RDB status word .WORD RS.EGR ;Fake RDB status (eliminate global region) ............ E$LRG: ;I&D+ BIT #,@R5 ;Is this VBGEXE? BNE 20$ ;Branch if yes -- VBGEXE can do what it wants ;I&D- TST @R0 ;Region 0? BEQ PLERR2 ;Yes, can't eliminate 0 20$: CALL GETREG ;No, find region control block BIT (R0)+,(R0)+ ;R0 -> Status word in RDB .ASSUME R.GSTS EQ R.GID+4 BIC #,@R0 ;Preclear status bits in RDB ;I&D+ MOV #<3.*SUP$Y+1*W.NNUM>,-(SP) ;Save number of window blocks MOV #,R4 ;R4 -> WCBs ;I&D- 30$: TST W.BSIZ(R4) ;This window in use? BEQ 40$ ;No CMP @R4,R3 ;Mapped to this region? BNE 40$ ;No CALL UNMAP ;Yes, unmap it from region BIS #,@R0 ;Indicate windows unmapped 40$: ADD #,R4 ;Point to next window DEC @SP ;More windows to search? BNE 30$ ;Yes .BR ELRG1 ............ ELRG1: MOV (R3)+,R1 ;R1 = region physical address MOV (R3)+,R2 ;R2 = size of region MOV @R3,@SP ;Save the status for a moment CLR @R3 ;Clear the status CLR -(R3) ;Clear the size word (returning R3 back) CLR -(R3) ;Clear the address (to start of entry) BIT #,(SP)+ ;Is this a shared region? BEQ XDEALC ;No, then go return memory to free list CALL FGRADR ;Find global region control block TSTB GR.SHC(R1) ;Is global region private? BPL 50$ ;Branch if not CLRB GR.SHC(R1) ;Set access count to 0 BR 70$ ;Do not auto eliminate a private region ............ 50$: DECB GR.SHC(R1) ;Decrement access count BEQ 60$ ;Branch if global region is not attached BIT #,@R0 ;Does he want to eliminate global region? BEQ 90$ ;Branch if not MOV #,R1 ;Report global region still in use error SEC ;Set C bit RETURN ............ 60$: .IF EQ SB BIT #,GR.STA(R1) ;Does he want auto elimination? BNE 80$ ;Branch if yes .ENDC ;EQ SB 70$: BIT #,@R0 ;Does he want the global region gone too? BEQ 90$ ;No, then just return 80$: JSR R5,VMDAL1 ;Deallocate global region if possible 90$: CLC ;Clear Carry and return RETURN ............ .DSABL LSB .SBTTL XDEAL - Deallocate A Region In Extended Memory ;+ ; XDEALC - Deallocate a region in extended memory. ; ; Deallocated region is concatenated with other regions if possible, ; else is inserted in X region table. If memory is sufficiently ; fragmented that an empty table slot is not available, the request ; is aborted and X memory may be lost. ; ; R1 = address of region/32 words ; R2 = size of region/32 words ; ; CALL XDEALC ; ; C = 0 if success ; R1= random ; R2= random ; ; C = 1 if failure ; R1= Error code: ; 11 => Memory too fragmented ;- .ENABL LSB XDEALC: MOV R4,-(SP) ;Save R4 MOV R3,-(SP) ;Save R3 MOV R2,-(SP) ;Save region size 10$: MOV @SP,-(SP) ;Copy region size ADD R1,@SP ;Compute top of freed region CLR R4 ;Empty slot flag .ADDR #<$XMSIZ-2>,R2 ;R2 -> biased region table ;>>> MOV #<$XMSIZ-2>,R2 ;R2 -> biased region table ;>>>$Rel .-2 $XMSIZ-2 RMON ;>>>save 1 20$: TST (R2)+ ;R2 -> next slot in table MOV (R2)+,R3 ;R3 = size of this entry BEQ 40$ ;Branch if empty CMP R3,#<-1> ;Is this the end of the table? (C=0 if so) BEQ 50$ ;Branch if so. CMP @R2,@SP ;Start of existing = top of freed? BEQ 30$ ;Yes, go merge them ADD @R2,R3 ;Add start to size giving top of existing CMP R3,R1 ;Top of existing = start of freed? BNE 20$ ;No, continue search MOV @R2,R1 ;Start of merged regions = start of existing 30$: TST (SP)+ ;Purge top address ADD -(R2),@SP ;Add size of existing region to freed size CLR @R2 ;Deallocate existing region BR 10$ ;Try to merge new bigger region again ............ 40$: TST R4 ;Already have an empty? BNE 20$ ;Yes, go on MOV R2,R4 ;No, save slot address BR 20$ ; ... then continue search ............ ;+ ; Region not adjacent to any other region ;- 50$: MOV R4,(SP)+ ;Purge top address, is there an empty? BEQ 70$ ;None was found! MOV R1,@R4 ;Move in start address (note C=0 here) MOV (SP)+,-(R4) ;Move in size 60$: MOV (SP)+,R3 ;Restore R3 MOV (SP)+,R4 ;Restore R4 RETURN ............ 70$: COM (SP)+ ;Purge size from stack ;SEC ;C=1 from COM (SP)+ MOV #,R1 ;Error 11, Deallocate failure BR 60$ ;Restore regs and retuurn error ............ .DSABL LSB .SBTTL PLAS Subroutines .SBTTL GETWND - Get WCB Corresponding to Window ID ;+ ; GETWND - Find window control block corresponding to specified identifier ; ; R0 -> window ID to find ; R5 -> impure area ; SP -> EMT dispatcher return address ; ; CALL GETWND ; ; R3 = random ; R4 -> specified window block ; ; C = 1 if no such WCB or WCB 0 specified. Returns to caller's caller w/ ; R1= Error code: ; 3 => window ID invalid ; ; GETWN0 is alternate entry point which does not return an error if ; window 0 is specified, but returns with window 0 control block ; address. ;- .ENABL LSB GETWND: ;I&D+ BIT #,@R5 ;Is this VBGEXE? BNE GETWN0 ;Branch if yes -- VBGEXE can do what it wants .IF NE SUP$Y MOV #,R4 ;R4 -> WCBs CALL ADJWIN ;R4 -> correct mode/space WCBs .ASSUME M.WCSI GT M.WCUI .ASSUME M.WCSI GT M.WCUD .ASSUME M.WCSI LT M.WCSD CMP R4,# ;Is this a supy window? BHIS GETWN0 ;If so, then don't protect window 0 .ENDC ;NE SUP$Y ;I&D- TSTB @R0 ;Is window ID 0? BEQ 10$ ;Yes, 0 is illegal GETWN0: ;I&D+ MOV #,R4 ;R4 -> WCBs .IF NE SUP$Y CALL ADJWIN ;R4 -> correct mode/space WCBs BCS 40$ ;Branch if invalid mode and space .ENDC ;NE SUP$Y ;I&D- MOVB @R0,R3 ;Get window ID CMP R3,# ;Is ID too large? BHIS 10$ ;Yes, error MUL #,R3 ;Convert ID to 7 word offset ADD R3,R4 ;R4->address window TST W.BSIZ(R4) ;Is it established? ;CLC ;C=0 from 'TST' BNE 30$ ;Yes, return C=0 10$: MOV #,R1 ;Illegal window ID 20$: COM (SP)+ ;Return to EMT dispatcher, C Set ;SEC ;C=1 from 'COM' 30$: RETURN ;Return to caller ...... .IF NE SUP$Y 40$: MOV #,R1 ;Issue "inactive mode/space" error BR 20$ ;Clean up stack and take error exit ........... .ENDC ;NE SUP$Y .DSABL LSB .SBTTL UNMAP - Unmap A Window ;+ ; UNMAP - Unmap a window ; ; R4 -> window control block ; R5 -> job impure area ; ; CALL UNMAP ; ; C=0 if unmapping done ; C=1 if not mapped ;- .ENABL LSB UNMAP: MOV R0,-(SP) ;Preserve R0 SEC ;Assume window not mapped MOV @R4,R0 ;Get region ID if mapped BEQ 30$ ;Not mapped, return C=1 CLR @R4 ;Unmap the window DECB R.BNWD(R0) ;Decrement count of windows mapped to region MOVB W.BFPD(R4),R0 ;Point to first User PDR (sign extends!) .IF NE SUP$Y MOV R3,-(SP) ;Save R3 MOV R0,R3 ;Save U-I PDR pointer CALL ADJPDR ;Adjust R0 PDR pointer for correct space/mode .ENDC ;NE SUP$Y MOV #,-(SP) ;Assume we will set PDR to 4K Read/Write BIT #,@R5 ;Privileged task? BEQ 10$ ;Yes, unmapped windows become Kernel map CLR @SP ;No, unmapped windows get set to abort 10$: .IF NE SUP$Y MOV KISAR0-UISDR0(R3),UISAR0-UISDR0(R0) ;Set map to Kernel CMP R3,# ;Was this PAR 1? .IFF ;NE SUP$Y MOV KISAR0-UISDR0(R0),UISAR0-UISDR0(R0) ;Set User map to Kernel CMP R0,# ;Was this PAR 1? .ENDC ;NE SUP$Y BNE 20$ ;No MOV #,UISAR0-UISDR0(R0) ;Set =20000 in case PAR 1 borrowed 20$: MOV @SP,(R0)+ ;Set PDR to abort (vir) or to 4K R/W (priv) .IF NE SUP$Y TST (R3)+ ;Bump U-I PDR pointer too .ENDC ;NE SUP$Y DECB W.BNPD(R4) ;Is there another PDR? BGT 10$ ;Yes, do it TST (SP)+ ;Purge the PDR value from the stack ;CLC ;C=0 from 'TST' above .IF NE SUP$Y MOV (SP)+,R3 ;*C* Restore R3 .ENDC ;NE SUP$Y 30$: MOV (SP)+,R0 ;*C* Restore R0 RETURN ;Return ............ .DSABL LSB .IF NE SUP$Y ADJPDR: JSR R3,30$ ;Save R3 and point PICly to table at 10$ 10$: .WORD .WORD .WORD .WORD <177777> 20$: .WORD .WORD .WORD .WORD 30$: CMP R4,(R3)+ ;Search for window's mode and space BHIS 30$ ;Branch until found ADD <20$-10$-2>(R3),R0 ;Adjust for correct mode/space MOV (SP)+,R3 ;Restore R3 RETURN ...... CHKWIN: CALL PS1OF2 ;Is request to do both I and D space? BNE 20$ ;Branch if not CALL GETWN0 ;Look-up window ;If error, GETWN0 returns to CHKWIN's ; caller with carry set and either ; R1=ER.WID or R1=ER.IMS MOV #,R3 ;Get word size of a WCB 10$: CMP (R4),(R4)+ ;Check that a word of WCBs match BNE 30$ ;Branch to set C-bit and return SOB R3,10$ ;Loop through each word of WCBs 20$: TST (PC)+ ;Clear carry and skip SEC 30$: SEC ;Set carry RETURN ...... PS1OF2: MOV I.PLSP(R5),-(SP) ;Get mode/space status BIC #^C,@SP ;Isolate space bits CMP #,(SP)+ ;Is request to do both I and D space? RETURN ...... .ENDC ;NE SUP$Y .SBTTL XALLOC - Allocate A Region In Extended Memory ;+ ; ; XALLOC & XALLOF - ; Allocate a region of extended memory. Returns region address ; as a 32-word multiple, so 2mw (4mb) can be specified in 16 bits. ; ; ** NOTE ** ; ; XALLOC memory allocation requests are satisifed via an ; "exact or best fit" algorithm. ; ; XALLOF tries to allocate memory with the base address given in R1 ; ; CALL: ; R2 = Requested size in 32-word blocks (must not be zero) ; ; CALL XALLOC ; ; OR: ; R1 = Starting address of region (32-word block address) ; R2 = Requested size in 32-word blocks (must not be zero) ; ; CALL XALLOF ; ; RETURN: ; c-bit = 0, region allocated ; R1 = region address/32 ; R2 = region size (same as in call) ; R3 = 0, NRF (non-return to free) region ; z-bit = 1, NRF (non-return to free) region ; c-bit = 1, region not allocated ; R1 = random ; R2 = Size of largest region available at region address R1 ; (0 means, nothing available) ; R3 = random ;- .ENABL LSB XALLOC: CLR R1 ;Non-fixed base allocation XALLOF: MOV R4,-(SP) ;R4 must not be modified by routine TST R1 ;Did the caller specify a base addr? BNE 50$ ;Branch if so ;+ ; Try to get any contiguous memory from the free list that fits the request. ;- .ADDR #<$XMSIZ>,R1 ;R1->Free region table ;>>> MOV #<$XMSIZ>,R1 ;R1 -> Free region table ;>>>$Rel .-2 $XMSIZ RMON ;>>>save 1 CLR R4 ;Reset largest free region MOV #<-1>,R3 ;Reset size ... CLR -(SP) ; ... and best fit region pointer 10$: CMP @R1,#<-1> ;End of table? BEQ 40$ ;Yes... CMP @R1,R2 ;Will this region satisfy request? BLO 20$ ;Nope... CMP @R1,R3 ;Yes, smallest region which will? BHIS 20$ ;Nope... MOV @R1,R3 ;Yes, save its size ... MOV R1,@SP ; ... and the entry address 20$: CMP @R1,R4 ;Largest free region so far? BLOS 30$ ;Nope... MOV @R1,R4 ;Yes, save its size 30$: CMP (R1)+,(R1)+ ;And on to the next entry BR 10$ ............ 40$: MOV (SP)+,R1 ;Get entry address for best fit BEQ X$SZER ;Branch if we couldn't allocate memory MOV 2(R1),R1 ;R1 = chunk addr of region to allocate 50$: CLR R3 ;Assume this is a NRF region ;+ ; What should we do about other NRF/PRM regions that overlap our request? ; Should we ignore them, or indicate the condition somehow? ;- CMP R1,$MSIZ ;Is memory requested owned by system? BHIS 110$ ;No, so go allocate it as a NRF region .ADDR #<$XMSIZ-2>,R3 ;R3 -> free region table ;>>> MOV #<$XMSIZ-2>,R3 ;R3 -> Free region table ;>>>$Rel .-2 $XMSIZ-2 RMON ;>>>save 1 60$: TST (R3)+ ;On to the next entry MOV (R3)+,R4 ;R4 = size of free region BEQ 60$ ;Branch if size is zero CMP R4,#<-1> ;End of table? BEQ 90$ ;Yes... CMP @R3,R1 ;This chunk contains our base addr? BHI 60$ ;Branch if not ADD @R3,R4 ;R4 = trial chunk end addr (plus 1) SUB R1,R4 ;This chunk contains our base addr? BLO 60$ ;Branch if not CMP R4,R2 ;Does it contain our whole region? BLO X$SZER ;Branch if not SUB R2,-2(R3) ;Subtract allocated size from free mem MOV R1,-(SP) SUB @R3,@SP ;@SP = base - start[i] {x} BNE 70$ ;Branch if they don't match ADD R2,@R3 ;Start = start + alloc BR 80$ ............ 70$: MOV -(R3),R4 SUB @SP,R4 ;R4 = size[i] - x {y} BEQ 80$ ;Branch if it fills high part MOV (SP)+,@R3 ;Size[i] = x ;+ ; Deallocate remainder of chunk: @SP = start; R4 = size ;- MOV R1,-(SP) ADD R2,R1 ;Set up start address argument BCS 100$ ;Region wraps 22-bit bound! Error. MOV R2,-(SP) MOV R4,R2 ;Set up size argument CALL XDEALC ;Deallocate memory (if possible) MOV (SP)+,R2 MOV @SP,R1 80$: TST (SP)+ ;Pop stack and clear carry BR 110$ ............ 90$: CLR R4 ;Say we couldn't allocate any memory X$SZER: MOV R4,R2 ;R2 = size of allocated region MOV #,R1 ;Return size error COM -(SP) ;Error return (carry=1) 100$: INC (SP)+ ;*C* Pop stack 110$: MOV (SP)+,R4 ;*C* Restore R4 MOV R3,R3 ;*C* Set Z-bit to indicate NRF/non-NRF RETURN ...... .DSABL LSB .SBTTL XMSTOP - SETTOP For Jobs Created With The Linker /V Switch ;+ ; Jobs created with the LINK /V switch enable special SETTOP features. ; ; 1. The high limit of the job may never be less than the virtual high limit ; of the job. A SETTOP to a value below the virtual high limit of the job ; will return the virtual high limit of the job. ; ; 2. Privileged background jobs may SETTOP to any value above the virtual ; high limit of the job, and less than SYSLOW. ; ; 3. Virtual background jobs may do an initial SETTOP to any value above the ; virtual high limit of the job to the limit of the 32K address ; space (177776). This will create and map a region in XM. ; ; 4. Virtual foreground jobs will work the same way as virtual background ; jobs. Privileged foreground jobs will never be allowed to FRUN or SRUN, ; this will be done by KMON (the information in location 2 will never ; be stored). ; ; If there are no region control blocks, window control blocks, XM memory, ; or any problems, and the memory can not be obtained, the virtual high ; limit of the program will be returned. If less memory than requested ; is available, that will be acquired, and the value returned. ; ; Additional SETTOPS may only remap, or eliminate the region previously ; created. A SETTOP below the virtual high limit will eliminate the region. ; An additional SETTOP to an address greater than the SETTOP region will ; get the entire region previously created, and no more. ; ; R2 = job number ; Condition code set from MOV ...,R2 ; R4 = address of start of job's impure area ; ; JMP XMSTOP ; ; JMP S$ERT1 Return R4,R3 = random ; ; JMP S$ERTN Return R0 = SETTOP address ; R3 = virtual high limit of job ; R4 -> job impure area pointer ; ; JMP S$EPRV Return R0 = SETTOP address ; Loc 50 = SETTOP address ; R1,R2,R3,R4,R5 = Random ; ; Stack usage: ; ; Region definition block, and window definition block are created on the ; stack as needed. Region definition block first, possibly followed by a ; window definition block. ; ; Low ; ENSYS pushes 10. or 12 octal bytes on stack ; [R0 save area (1 word), ONLY if window is here] ; [Window Def. Block (7 octal words)] ; Region Def. Block (3 octal words) ; High <---- SP on entry to S$ETOP: ;- .ENABL LSB XMSTOP:: .IF EQ SB BNE 10$ ;Foreground jobs don't care if KMON is in .ENDC ;EQ SB TST KMONIN ;Is KMON doing it? BNE 20$ ;Yes, use limits from job limit table 10$: MOV I.VHI(R4),R3 ;R3 = virtual high limit of job present? BNE 40$ ;NE -> have a value for the virtual high limit 20$: BIT #,@R4 ;Is job privileged? BEQ 30$ ;Branch if so BIT #,@R4 ;Is job completely virtual? BNE 120$ ;Branch if so -- go JMP S$ERTN .IF EQ SB TST R2 ;Is this a foreground job? BNE 30$ ;Branch if so .ENDC ;EQ SB MOV #,@SP ;Job is biased by V.MAX in Kernel space ;V.MAX = virtual BG job with non-XM .SETTOP ; 0 = all other jobs ADD @SP,R0 ;Convert virtual to Kernel compatible address BCC 30$ ;If no wrap-around we're all set MOV #<-2>,R0 ;Highest allowable value to .SETTOP 30$: JMP S$ERT1 ;Go do regular SETTOP processing ............ ;+ ; Using /V mapping, now check for virtual or privileged job. ;- 40$: ADD #<2>,R3 ;R3 -> next available location (not last used) BEQ 110$ ;'=' ==> at limit of address space already BIT #,@R4 ;Is it a virtual job? BNE 50$ ;Yes, do these separately ;+ ; Have a privileged job with /V mapping ;- CMP R0,R3 ;Check if ARG is less than VHIGH BLO 110$ ;LO -> return VHIGH, can't go < VHIGH CMP R3,SYSLOW ;Is VHIGH more than SYSLOW? BHIS 110$ ;Yes, can't get any more JMP S$EPRV ;No, we can finally SETTOP to a valid addr ............ ;+ ; Have virtual job with /V mapping. ;- .ASSUME R.GSTS EQ R.GNAM-2 50$: CLR -(SP) ;Set up a zero status word in reg def block .ASSUME R.GNAM EQ 6 CMP -(SP),-(SP) ;Allocate rest of region def block on stack MOV #,R5 ;Number of region control blocks ;I&D+ MOV @#KISAR1,-(SP) ;Save kernel PAR1 MOV I.MPTR(R4),@#KISAR1 ;Map kernel PAR1 to job's MCA MOV #,R4 ;R4 -> RCBs ;I&D- 60$: BIT #,R.BSTA(R4) ;Test for a region created by SETTOP BNE 70$ ;NE -> found one, process information ADD #,R4 ;Point to next block DEC R5 ;Is there another? BNE 60$ ;NE -> yes, try it CLR R4 ;If none found -> R4=0, and ID=0 70$: ;I&D+ MOV (SP)+,@#KISAR1 ;Restore kernel PAR1 ;I&D- MOV R4,@SP ;Save region ID BEQ 80$ ;If no region don't try and move size MOV 2(R4),R4 ;Save region size, we may need it later MOV R4,R.GSIZ(SP) ;Store region size in region def. block 80$: CMP R0,R3 ;If arg < VHIGH -> .ELRG prev. regions BHIS 130$ ;LO -> .ELRG region, return VHIGH ;HIS -> keep trying for a region .BR 90$ ............ ;+ ; .ELRG eliminate region. ; If region was never created (ID = 0), returns error #2 which is ignored. ;- 90$: MOV SP,R0 ;Point at region definition blk ENSYS 100$ ;Enter System State ;I&D+ .ADDR #,R5 ;; R5 -> E$LRG CALLR P$LAS1 ;; Call E$LRG with proper mapping ;; P$LAS1 will return to User State ;; and remove ENSYS data ;I&D- ............ 100$: ADD #,SP ;Pop region definition block off stack 110$: MOV CNTXT,R0 ;Reset to VHIGH, we couldn't get any MOV I.VHI(R0),R0 ; more. 120$: JMP S$ERTN ;Return here if we got XM ............ 130$: SUB #,SP ;Save space for window block on stack, ;And fake R0 for C$RRG to return a value in ENS.SZ =: 12 ;Size of ENSYS stuff on stack ENSYS 220$ ;Change to System State CLR W.NOFF+ENS.SZ+2(SP) ;; Clear offset into region, always = 0 MOV #,W.NSTS+ENS.SZ+2(SP) ;; Set up to map automatically SUB R3,R0 ;; Get size of region to create - 2 ADD #,R0 ;; Make into 32. wd, and adjust subtract ASH #<-6.>,R0 ;; Convert to 32. word block BIC #,R0 ;; by unsigned division by 64 ASH #<-5.>,R3 ;; Convert R2 = start of PAR address to BIC #<174000>,R3 ;; and get rid of sign extension MOV R3,W.NID+ENS.SZ+2(SP) ;; ... window def block location TST R.GID+W.NLGH+ENS.SZ+2(SP) ;; Check for region already created BNE 170$ ;; NE -> yes, then .CRAW to old window ;+ ; .CRRG try and create a new region. ;- 140$: MOV R0,R.GSIZ+W.NLGH+ENS.SZ+2(SP) ;; Save in region size MOV R0,W.NSIZ+ENS.SZ+2(SP) ;; Save in window size MOV R0,W.NLEN+ENS.SZ+2(SP) ;; Save in length to map MOV SP,R0 ;; Set up pointer to region blk on stack ADD #,R0 ;; ;I&D+ .ADDR #,R5 ;; R5 -> C$RRG CALL P$LAS1 ;; Call C$RRG with proper mapping ;I&D- MOV ENS.SZ(SP),R0 ;; Set R0 properly for any change C$RRG made BCS 150$ ;; C=1 -> Error in creating region BIS #,-(R5) ;; R5 -> RCB status word +2, set SETTOP bit BR 190$ ;; Call .CRAW function ............ ;+ ; .CRRG region creation error processing. ;- 150$: CMP #,R1 ;; Check 'size' error, if no region of = ... ;; ... or > size, R0=largest avail region size BEQ 140$ ;; Try again with new region size 160$: MOV CNTXT,R0 ;; Otherwise, return VHIGH on all other errors MOV I.VHI(R0),R0 ;; BR 210$ ;; ............ ;+ ; Re-CRAW to old window ;- 170$: MOV R4,W.NSIZ+ENS.SZ+2(SP) ;; R4 = region size, save in window siz CMP R0,R4 ;; Is new size > old region size? BLE 180$ ;; LO -> no, map to R0 in this region MOV R4,R0 ;; Yes, map to all of region/window 180$: MOV R0,W.NLEN+ENS.SZ+2(SP) ;; Set new length to map ;+ ; .CRAW Create window and map it ;- 190$: MOV R.GID+W.NLGH+ENS.SZ+2(SP),W.NRID+ENS.SZ+2(SP) ;; Store reg. ID MOV SP,R0 ;; Point at window def blk ADD #,R0 ;; Skipping over ENSYS data + R0 ;I&D+ .ADDR #,R5 ;; R5 -> C$RAW CALL P$LAS1 ;; Call C$RAW with proper mapping ;I&D- BCS 160$ ;; C=1 -> CRAW error 200$: MOV W.NLEN+ENS.SZ+2(SP),R0 ;; Get size in 32 wd mult SWAB R0 ;; By multiplying by 64. RORB R0 ;; ROR R0 ;; ROR R0 ;; ADD W.NBAS+ENS.SZ+2(SP),R0 ;; Get base addr and add it to size SUB #<2>,R0 ;; Adjust to last used, not next avail 210$: RETURN ;; Return to User State & remove ENSYS data ............ 220$: ADD #,SP ;Pop region, window block & R0 off stack BR 120$ ;And return this value ............ .DSABL LSB .SBTTL VMDALC/1- Deallocate A Global Region ;+ ; Clear a handler region control block and return its memory to the free ; memory allocation table. ; ; VMDALC: ; Called With: JSR R5,VMDALC ; .RAD50 "GBL" ;Global region ; .RAD50 "REG" ;to eliminate ; ; On exit: R1 = random ; R2 = random ; All other registers are not changed. ; C=0 indicates success ; Z is random ; C=1 indicates failure ; Z=1 indicates region not found ; Z=0 indicates that region is permanent or active ; ; VMDAL1: ; On entry: R1 = base address of global region to deallocate ; ; Called With: JSR R5,VMDAL1 ; ; On exit: R1 = random ; R2 = random ; All other registers are not changed. ;- .ENABL LSB VMDALC::CALL FINDGR ;See if we can find this region. BIT (R5)+,(R5)+ ;*C* Skip over global region name data SEZ BCS 20$ ;Doesn't exist, so we're all done. VMDAL1: BITB #,GR.STA(R1) ;Is this a permanent region? BNE 20$ ;Yes, then don't eliminate it. MOVB GR.SHC(R1),-(SP) ;Is the global region active ASLB (SP)+ ; or privately active? BNE 20$ ;Yes, then don't eliminate it. MOV R3,-(SP) ;Save R3 MOV @R1,R2 ;Get size of region to return CLR (R1)+ ;Free the RCB for other use MOV (R1)+,R3 ;Save the region address. BITB #,@R1 ;Return to the free list? BNE 10$ ;Nope... MOV R3,R1 ;R1 -> region address. CALL XDEALC ;Go deallocate the region. 10$: MOV (SP)+,R3 ;Restore R3 TST (PC)+ ;Clear carry and skip "SEC" 20$: SEC ;Set carry indicating error RTS R5 ............ .DSABL LSB .SBTTL FINDGR - Find A Global Region Control Block ;+ ; FINDGR ; Subroutine to find a global region control block by name ; and returns the address of the matching entry. If a region ; with that name does not exist, it returns the address of ; the first free GL$RCB. ; ; To improve the useability of the subroutine, in the case ; where the requested region does not exist, the name re- ; quested is put into the table. Note that although FINDGR ; stuffs the name of the global region into the entry, the ; GL$RCB is still not considered in use. The region is ; considered in use only if the first word (size word) is ; non-zero. The caller must still initialize the size, ; address, and status entries. ; ; ENTRY ; R5 -> Region name (2 words of RADIX 50) ; ; CALL ; CALL FINDGR ; ; RETURN ; C = 0 if region was found. ; R1 -> Size word of the named entry ; ; C = 1 if region was not found. ; R1 -> Size word of next available entry ; ** NOTE **, R1 = 0 if no slots are available. ;- .ENABL LSB FINDGR::.ADDR #<$GLRCB-GR.ESZ>,R1 ;R1 -> RCB table for global regions. ;>>> MOV #<$GLRCB-GR.ESZ>,R1 ;R1 -> RCB table for global regions. ;>>>$Rel .-2 <$GLRCB-GR.ESZ> RMON ;>>>save 1 CLR -(SP) ;Assume no empty entries. 10$: ADD #,R1 ;Move to the next entry. CMP #<-1>,@R1 ;End of table? BEQ 30$ ;Yes, go return TST @R1 ;Is this slot used? BNE 20$ ;Yes, then go check if it is the one. MOV R1,@SP ;Not used so remember for later. BR 10$ ;Continue looking in the loop. ............ 20$: CMP GR.NAM(R1),@R5 ;Is this the correct region. BNE 10$ ;No, then move to the next CMP GR.NAM+2(R1),2(R5) ;Does the second half match? BNE 10$ ;No, then continue looking. ;CLC ;C = 0 from "CMP" TST (SP)+ ;C = 0 and tidy up stack RETURN ............ 30$: MOV (SP)+,R1 ;Was there a free region? BEQ 40$ ;No, then take error return. MOV @R5,GR.NAM(R1) ;Yes, then stuff the requested name. MOV 2(R5),GR.NAM+2(R1) 40$: SEC ;Set carry and return. RETURN ............ .DSABL LSB .SBTTL FGRADR - Find A Global Region Control Block ;+ ; FGRADR ; Subroutine to find a global region control block by address ; and returns a pointer to the global region control block. ; If a matching region control block entry is not found, the ; carry bit is set, indicating an error. ; ; ENTRY ; R1 = Base address of global region ; ; CALL ; CALL FGRADR ; ; RETURN ; C = 0 if region was found. ; R1 -> Size word of global region control block which matches ; ; C = 1 if region was not found. ;- .ENABL LSB FGRADR::.ADDR #<$GLRCB-GR.ESZ+2>,R1,PUSH ;R1 -> RCB table for global regions ; ... and push base address onto stack ;>>>FGRADR:: MOV R1,-(SP) ;Save base address on stack ;>>> MOV #<$GLRCB-GR.ESZ+2>,R1 ;R1 -> RCB table for global regions. ;>>>$Rel .-2 <$GLRCB-GR.ESZ> RMON ;>>>save 0, but faster 10$: ADD #,R1 ;Move to the next entry. CMP #<-2>,@R1 ;End of table? [(@R1=-1) <=> C=1] BLO 20$ ;If @R1 = -1, branch with C=1 TST (R1)+ ;Is this slot used? BEQ 10$ ;If not, check next one .ASSUME GR.ADD EQ GR.SIZ+2 CMP @R1,@SP ;Is this the correct region? BNE 10$ ;Branch if not .ASSUME GR.ADD-2 EQ GR.SIZ TST -(R1) ;R1 -> size word of GRCB and C=0 20$: INC (SP)+ ;*C* Cleanup stack RETURN ............ .DSABL LSB .END