.MCALL .MODULE .MODULE RMON,VERSION=100,COMMENT=,AUDIT=YES ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only with the ; inclusion of the above copyright notice. This software, or ; any other copies thereof, may not be provided or otherwise ; made available to any other person except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. ;++ ; Facility: RT-11 Resident Monitor ; ; Author: ; ; Abstract: With system conditionals appropriately defined, this module ; can be assembled to produce the SB, FB, XB, XM resident ; monitors for the RT11 Operating System. ; ; ; Externals Description ; --------- ----------- ; ; ; Edit Who Date Description of modification ; ---- --- ---- --------------------------- ; 001 WLD 19-JAN-90 Modified EMTLST to disable checking ; R0 for EMT 375 codes 42 (.SFDAT) and ; 44 (.GFDAT, .GFINF, .GFSTA, .SFINF, ; .SFSTA). Changes not needed in SJ. ; Checking R0 poses a problem in the ; case that the DBLK address is odd ; to signal no logical name translation ; in the file specification. ; ; 002 WLD 19-JAN-90 Note on TSWCNT: ; To the application programmer, wcnt ; is a non-negative two's complement ; integer in sixteen bits. ; Within various handlers, it ; becomes an unsigned integer in ; sixteen bits, representing a byte ; count. Ideally, TSWCNT should check ; wcnt, since an absurd value like ; o'100000' would get changed to ; o'000000' by the usual ASL ; instruction. The problem with ; checking wcnt is that a directory ; operation on a non-standard device ; uses the .READx code with wcnt = -1, ; a possible SEQNUM value. ; At present, there is no way to ; detect this alternate use of R$ead. ; ; 003 LB 29-JAN-90 MQ - put in fix lost from common ; monitor ; ; (077) 18-Jun-90 MBG Added multi-terminal handler hooks fixed offset ; and data structure ; ; (079) 23-Sep-90 MBG Change to D$ATE routine to ensure date is correct ; prior to use. ; ; (080) 31-Oct-90 DBB Add I.SSP to impure area to fix SSP context switch ; problem ; ; (081) 19-Nov-90 DBB Add I.VSTP to impure area to allow VBGEXE jobs 64KW ; ; (082) 28-Nov-90 DBB Set CF3.IM to indicate impure area and unprotect ; BPT vector in LOWMAP ; ; (083) 11-Jan-91 DBB Make .IMPDF symbols global so they will appear in ; monitor LINK map as documented ; ; (085) 12-Feb-91 DBB Make .GTJB return highest address available not ; first address unavailable for high limit. Use ; I.VSTP instead of 160000 for completely virtual ; jobs. ;- .SBTTL Post Release Edit History ;+ ; ; (99/01) 07-Dec-93 Megan Gentry ; Corrected problem with .SDTTM programmed request ; which ignored dates in the 2nd and 3rd RT epochs ; (value was negative). Changed check from testing for ; negative value to one which checks specifically ; for a -1 (equivalent check made for time word ; as well). ; ; (99/02) 12-Oct-94 Megan Gentry ; Changed rubout code so that it doesn't echo ; once you have deleted all deletable characters. ; ; (99/03) 01-Feb-95 Megan Gentry ; Added processing code. ; ; (99/04) 03-Feb-95 Megan Gentry ; Changed processing code so that it does a scope-type ; delete operation (BS-SPACE-BS) if the terminal is set scope. ; Underlying terminal output routine TTOPT2 had to be modified ; so that it allowed output interrupts if the output ring was ; full so that no characters for output would be lost. ; ; Note: still have to take care of characters echoed '^x' or ; TABs which are echoed as up to 8 characters. ; ; (99/05) 09-Sep-95 Megan Gentry ; Added century rollover to date rollover code. ; ; (99/06) 30-JUN-97 Alan R. Baldwin ; Added missing SUP$Y conditional which caused an internal ; monitor trap when accessing non-existant MMR3 register ; (11/34, 11/35, 11/40, and 11/60). ; ; (100) 13-Jan-1998 TDS ; Bump version number for RT-11 5.7 release ; ;- ;+ ; "Things are more like they are now than they ever were before." ; - Dwight D. Eisenhower ;- VENU$X = 1 .NLIST BEX,CND .SBTTL ************************************** .SBTTL * RT-11 Resident Monitor For The * .IF NE MMG$T .IF NE SB .SBTTL * Extended Background (XB) Monitor * .IFF ;NE SB .SBTTL * Extended Memory (XM) Monitor * .ENDC ;NE SB .IFF ;NE MMG$T .IF NE RTE$M .SBTTL * RT-11 Emulator (RTEM) Monitor * .IFF ;NE RTE$M .IF NE VENU$C .SBTTL * VENUS (VAX 8600) Console Monitor * .IFF ;NE VENU$C .IF NE SB .SBTTL * Single Background (SB) Monitor * .IFF ;NE SB .SBTTL * Foreground/Background (FB) Monitor * .ENDC ;NE SB .ENDC ;NE VENU$C .ENDC ;NE RTE$M .ENDC ;NE MMG$T .SBTTL ************************************** .LIST CND ;+ ; "The age ... of sophisters, economists and calculators, ; has succeeded." - Burke ;- .SBTTL Conditionalization summary ;+ ;COND ; ; BATC$H 0 No batch support ; BATC$H 1 Batch support ; ; DL11$N n Number of DL11s supported under multi-terminal ; ; ERL$G 0 No error logging support ; ERL$G 1 Error logging support ; ; FJOBS 0-7 Number of foreground (non-BG) jobs ; ; FPU$11 0 No Floating point support ; FPU$11 1 Floating point support ; ; HSR$B 0 No high-speed ring buffering support ; HSR$B 1 High-speed ring buffering support ; ; LIGH$T 0 No idle light pattern ; LIGH$T 1 Idle light pattern ; ; MMG$T 0 No extended memory support ; MMG$T 1 Extended memory support ; ; MPT$Y 0 No memory parity support ; MPT$Y 1 Memory parity support ; ; MQH$P2 0 Embedded MQ uses PAR1 only ; MQH$P2 1 Embedded MQ uses PAR1 and PAR2 ; ; MQ$RES 0 MQ is a separate handler ; MQ$RES 1 MQ is resident in monitor ; ; MAT$S 0 Async terminal status word not supported ; MAT$S 1 Async terminal status word supported ; ; MTT$Y 0 Single terminal support ; MTT$Y 1 Multi-terminal support ; ; MTY$HK (0) No multi-terminal handler hooks support ; MTY$HK 1 Multi-terminal handler hooks support ; ; PDT$OP 0 Use BIC/BIS to reference TT I/O page addresses ; PDT$OP 1 Use CLR/MOV to reference TT I/O page addresses ; ; PWF$L 0 No powerfail message ; PWF$L 1 Provide powerfail message ; ; ROL$OV 0 Do not handle month rollover ; ROL$OV 1 Handle month (and year) rollover ; ; RTE$M 0 No RTEM support ; RTE$M 1 RTEM support ; ; SCCA$G 0 Local (job context only) SCCA support ; SCCA$G 1 Global (cross job context) SCCA support ; ; SPC$PS 0 No .SPCPS support ; SPC$PS 1 .SPCPS support ; ; SYT$K 0 No system job support ; SYT$K 1 System job support ; ; TIM$IT 0 No device timeout support ; TIM$IT 1 Device timeout support ; ; UNI$64 0 No extended device-unit support (in monitor) ; UNI$64 1 Extended device-unit support (in monitor) ; ; VENU$C 0 Not building VENUS (VAX-86xx console) monitor ; VENU$C 1 Building VENUS (VAX-86xx console) monitor ; ; VENU$X 0 Allow race condition in TT processing ; VENU$X 1 Fix race condition in TT processing ; ; XM$FET 0 No fetching in XM ; XM$FET 1 Fetching is XM ;- .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 .CLOSE .EXIT ;SYSMAC .MCALL .CKXX ;SYSMAC .MCALL .HRESET .PRINT .RCTRLO .TTINR .TTYOU ;SYSMAC .CKxx .MCALL ASCR50 .ASTX BSS EMTER0 EMTER1 ;EDTL .MCALL EMTER2 EMTER3 ENSYS GET MONERR ;EDTL .MCALL PUT ;EDTL .MCALL .LB ;SYSTEM ;+ ; Structure Definition Macros ;- .MCALL ..FPRO ..GTJB ..READ ..PURG ..SPFU ;SYSTEM .MCALL .CF1DF .CF2DF .CF3DF .CHADF .CHNDF ;SYSTEM .MCALL .CLIDF .CMPDF .CSTDF .CSWDF .DATDF ;SYSTEM .MCALL .DBKDF .DIEDF .DSCDF .DTMDF .E16DF ;SYSTEM .MCALL .EMTDF .ERRDF .GTJDF .HANDF .HBGDF ;SYSTEM .MCALL .HSRDF .IBKDF .IMPDF .INDDF .IOBDF ;SYSTEM .MCALL .ISTDF .JSWDF .MCADF .QCMDF .QELDF ;SYSTEM .MCALL .QFKDF .QHKDF .QSYDF .QTIDF .RCBDF ;SYSTEM .MCALL .SAVDF .SGNDF .STWDF .SYCDF .TCBDF ;SYSTEM .MCALL .TCFDF .TIMDF .TSTDF .UEBDF .WCBDF ;SYSTEM .MCALL .THKDF ;SYSTEM .SBTTL Invoke Structure Definition Macros ..FPRO ;.FPROT EMT Request Layout/Values ..GTJB ;.GTJB EMT Request Layout/Values ..PURG ;.PURGE EMT Request Layout/Values ..READ ;.READx EMT Request Layout/Values ..SPFU ;Special Function Codes .CF1DF ;CONFIG First System Configuration Word Format .CF2DF ;CONFG2 Second System Configuration Word Format .CF3DF ;CONFG3 Third System Configuration Word Format .CHADF ;CHAIN Area Format .CHNDF ;I/O Channel Format .CLIDF ;CLITYP and CLIFLG Command Processor Definitions .IF NE SUP$Y .CMPDF ;.CMAP Request and I.CMAP Bit Definitions .ENDC ;NE SUP$Y .CSTDF ;.CSTAT Return Area Format .CSWDF ;Channel Status Word (CSW) Bit Definitions .DATDF ;RT-11 Date Format .DBKDF ;File Dblock Format .DIEDF ;Directory Entry Format .DSCDF ;Device Characteristics Bits for .DSTAT Code .DTMDF ;Date/Time Setting Block Format .E16DF ;EMT16 List Layout .EMTDF ;EMT Codes and Subcodes .ERRDF ;EMT Error Code Definitions .GTJDF ;.GTJB Return Area Format .HANDF ;Handler Block 0 Definitions .HBGDF ;Handler Block 1 Definitions .HSRDF ;Handler Service Routine Code Definitions .IBKDF ;I.BLOK Blocking Condition Bit Definitions FIX$ED=0 ;allow floating symbols to be defined .IMPDF ,<==:> ;Impure Area Layout FMPUR ==: ;keep $ and . less symbols out of SYSTEM FIX$ED=1 .INDDF ;INDSTA - IND Status Byte Bit Definitions .IOBDF ;I/O Block Used for System I/O Requests .ISTDF ;I.STAT Job State Word Bit Definitions .JSWDF ;$JSW Job Status Word Bit Definitions .IF NE MMG$T .MCADF ;Job's Mapping Context Area Definitions .ENDC ;NE MMG$T .QCMDF ;Completion Queue Element Format .QELDF ;Queue Element Definition .QFKDF ;FORK Queue Block Format .QHKDF ;$QHOOKS Structure Definition .QSYDF ;SYNC Queue Element Format .QTIDF ;Timer Queue Element Format .IF NE MMG$T .RCBDF ;Region Control Block Format .ENDC ;NE MMG$T .SAVDF ;Block 0 SAVe Image Definitions .SGNDF ;SYSGEN Option Bit Definitions .STWDF ;STATWD DCL/@File Status Bit Definitions .SYCDF ;$SYCOM Definitions .IF NE MTT$Y FIX$ED=0 ;allow floating symbols to be defined .TCBDF ;Terminal Control Block Definitions FIX$ED=1 .IF NE MTY$HK .THKDF ;Define multi-terminal handler hooks structures .ENDC ;NE MTY$HK .TSTDF ;T.STAT Dynamic Terminal Status Bit Definitions .ENDC ;NE MTT$Y .TCFDF ;Terminal Configuration Bits .TIMDF ;Time Word Pair Format .UEBDF ;$USRRB User Error Byte Codes .IF NE MMG$T .WCBDF ;Window Control Block Format .ENDC ;NE MMG$T .SBTTL Delete Structure Definition Macros (Free Up Workfile Space) .MDELET ..FPRO ..GTJB ..READ ..PURG ..SPFU .CF1DF .MDELET .CF2DF .CF3DF .CHADF .CHNDF .CLIDF .CMPDF .MDELET .CSTDF .CSWDF .DATDF .DBKDF .DIEDF .DSCDF .MDELET .DTMDF .E16DF .EMTDF .ERRDF .GTJDF .HANDF .MDELET .HBGDF .HSRDF .IBKDF .IMPDF .INDDF .IOBDF .MDELET .ISTDF .JSWDF .MCADF .QCMDF .QELDF .QFKDF .MDELET .QHKDF .QSYDF .QTIDF .RCBDF .SAVDF .SGNDF .MDELET .STWDF .SYCDF .TCBDF .TCFDF .TIMDF .TSTDF .MDELET .UEBDF .USSDF .WCBDF .THKDF .SBTTL Macros For Monitor Only ;+ ; .MACRO SPL N ; ; Set Priority to 'n', Fast ;- .MACRO SPL N .WORD PSWLST PSWLST == .-2 .IF EQ N .WORD -2 .IFF .WORD ,PS .ENDC .ENDM SPL ;+ ; .MACRO GETPSW ; ; Push the PSW on the Stack, Fast ;- .MACRO GETPSW .WORD PSWLST,-4 PSWLST == .-4 .ENDM GETPSW ;+ ; .MACRO PUTPSW ; ; Pop a Stack Word to the PSW, Fast ;- .MACRO PUTPSW .WORD PSWLST,-6 PSWLST == .-4 .ENDM PUTPSW PSWLST == 0 ;Initialize the list .MCALL ...CMV .SBTTL Miscellaneous Constant Definitions .IF EQ CLOCK-50. ;If 50cycle clock CLK50 = CLK50$ .IFF ;EQ CLOCK-50. CLK50 = 0 .ENDC ;EQ CLOCK-50. .IIF EQ MTT$Y, WRWT$=100000 ;.PRINT - .WRITE sych flag SYSOP$ = ! ! SYSOP$ = SYSOP$ ! SYSOP$ = SYSOP$ ! ! ! SYSOP$ = SYSOP$ ! ! .SBTTL Monitor Data Base - Fixed Offset Area .PSECT RTDATA ;Start of RMON data base ;+ ; Start of Fixed Offset Area ;- ;+ ; $RMON (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; CALLR $INTN ;JMP $INTN ; ; The $INTN routine is located in the RTEM-11 linkage ; routines. This hook allows RTEM-11 to correctly ; handle AST's from device handlers. ;- $RMON:: CALLR $INTEN ;Common entry point for handlers ............ $CSW:: BSS < /2 > ;Channel Status Table SB17 ==: $CSW + + C.SBLK ;-> to start block of channel 17 ;+ ; Internal Channel used ONLY for $SYS calls (KMON uses this as channel 20) ;- $SYSCH::.WORD ;System device index is 2, open .WORD 0 ;Disk opened non-file-structured .WORD 0 ;**BOOT** ** XM ** Device Size .WORD 0 ;Data length = 0 .WORD 0 ;**BOOT** Device Unit Number BLKEY:: .WORD 0 ;Directory block number in core CHKEY:: .WORD 0 ;Device whose directory is in core DATES:: .WORD 0 ;Date word DFLG:: .WORD 0 ;Directory operation in progress flag $USRLC::.WORD USRBUF ;-> Std. USR location(if job not swapping USR) ;>>>$Rel .-2 USRBUF RMON QCOMP:: .WORD COMPLT ;Where handlers go to finish up ;>>>$Rel .-2 COMPLT RMON SPUSR:: .WORD 0 ;Used to report special USR errors SYUNIT::.WORD 0 ;Unit of running system device ...CMV PART=ALL,TYPE=V SYSVER: .BYTE RT$REL ;xrr.vv, rr part SYSUPD: .BYTE RT$VER ;xxrr.vv, vv part CONFIG::.WORD < FBMON$ ! CLK50 ! > > ;CONFIG wd (USR in if XM/XB) SCROLL::.WORD 0 ;Link word for GTON Scroller ;+ ; TTKS,TTKB,TTPS,TTPB (*** RTEM-11 HOOKS ***) ; The following console terminal CSR and STATUS ; register pointers must be kept in the following ; order and globalized: ;- TTKS:: .WORD TKS ;-> Console Keyboard Status Register TTKB:: .WORD TKB ;-> Console Keyboard Buffer TTPS:: .WORD TPS ;-> Console TTY Output Status TTPB:: .WORD TPB ;-> Console TTY Output Buffer ;+ ; ** End critical ordering for RTEM-11 ** ;- MAXBLK::.WORD -1 ;Largest output file openable ;Initially 65K blocks E16LST: .WORD < LST16 - $RMON > ;Offset to EMT 16 list CNTXT:: .WORD BKGND ;-> running job's impure area ;>>>$Rel .-2 BKGND RMON JOBNUM::.WORD 0 ;Active job's number SYNCH:: .WORD $SYNCH ;SYNCH entry point ;>>>$Rel .-2 $SYNCH RMON ;+ ; NOTE: The bootstrap protects the system handler and the memory ; management fault vector. Bytes are read left to right, ; For example, the 4th byte, 11110000, protects the range ; from 60 to 76, and specifically 60,62,64, and 66. ;- LOWMAP::.RADIX 2 ;Map of protected words in low core .BYTE 11111100, 00111100, 00001111, 11110000 ; 0 - 076 .BYTE 11000011, 00000000, 00000000, 00000000 ;100 - 176 .BYTE 00000000, 00000000, 00110000, 00000000 ;200 - 276 .BYTE 00000000, 00000000, 00000000, 00000000 ;300 - 376 .BYTE 00000000, 00000000, 00000000, 00000000 ;400 - 476 .RADIX 8. MAPSIZ =: <. - LOWMAP> / 2 ;Size of protect map in words MAPOFF ==: < LOWMAP - $RMON > ;Offset of map from start of RMON USRLOC::.WORD USRBUF ;-> USR entry point: ;>>>$Rel .-2 USRBUF RMON ; =0 USR is not in memory ; <>0 -> USRBUF before relocation code is run, ; then points to USRST (USRBUF+2000) ;+ ; GTVECT (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap zeros this location, as ; VT11 support does not exist under RTEM-11. ;- GTVECT::.WORD 0 ;Location of VT11 vectors (usually 320) ;Removed for V5.6 ERRCNT: .WORD 0 ;Error count return from CUSPs $MTPS:: BR PUTPSW ;BR to routine to PUT PS ............ $MFPS:: BR GETPSW ;BR to routine to return PS in SP ............ SYINDX::.WORD 2 ;System device index number STATWD::.WORD 0 ;DCL & Indirect File state word CONFG2::.WORD <!> ;Configuration word #2 SYSGEN::.WORD SYSOP$ ;System generation options USRARE: .WORD USRSIZ ;Size of USR in bytes ;+ ; DCL Indirect File Status Bytes ; ; ***** KEEP NEXT TWO BYTES TOGETHER ***** ;- ERRLEV::.BYTE < ERROR$ ! FATAL$ ! UNCON$ > ;Error where we abort DCL/@File IFMXNS::.BYTE MXN$ST ;Maximum @File nest depth ;+ ; **** END Indirect File Status Area ***** ;- EMTRTN: .WORD < EMTRTI - $RMON > ;Offset to EMT RTI for BATCH FORK:: .WORD < $FORK - $RMON > ;Offset to FORK request processor PNPTR:: .WORD < $PNAME - $RMON > ;Offset to $PNAME table MONAME::ASCR50 NAME$1,NAME$2,NAME$3 ;RAD50 monitor name .WORD ...V2 ASCR50 NAME$4,NAME$5,NAME$6 .WORD ...V2 HSUFFX::ASCR50 40,40,SUFX$H ;Handler file suffix (<^r X> for XM) .WORD ...V2 SPSTAT::.WORD 0 ;Spooler status word (Used by VENUS console!) EXTIND::.BYTE 0 ;Stored error byte INDSTA::.BYTE 0 ;IND control status $MSIZ:: .WORD 0 ;Total amount of memory available to system .IF NE TIME$R CONLOG::.WORD < GTIHOK - $RMON > .IFF ;NE TIME$R CONLOG::.WORD 0 .ENDC ;NE TIME$R .IF EQ MTT$Y $TCFIG::.WORD TTCNFG ;Addr of term. SET option stat word (TTCNFG) ;>>>$Rel .-2 TTCNFG RMON .IFF ;EQ MTT$Y $TCFIG::.WORD DLTCB ;Addr of term. SET option stat word (T.CNFG) ;>>>$Rel .-2 DLTCB RMON .ENDC ;EQ MTT$Y $INDDV::.WORD INDDEV ;-> ASCII dev. name & unit # to run IND from ;>>>$Rel .-2 INDDEV RMON MEMPTR::.WORD < CORPTR - $RMON > ;Offset to memory control block pntrs .IF NE MMG$T P1EXT:: .WORD $P1EXT ;-> Kernel PAR1 externalization ;>>>$Rel .-2 $P1EXT RMON $TRPLS::.WORD TRPLST ;-> vector list for FIXTRP code, XB/XM only ;>>>$Rel .-2 TRPLST RMON .IFF ;NE MMG$T P1EXT:: .WORD 0 $TRPLS::.WORD 0 .ENDC ;NE MMG$T GETVEC::.WORD ERRRTN ;Hooked by PI for option slot dev's on PRO3xx ;>>>$Rel .-2 ERRRTN RMON DWTYPE::.WORD 0 ;DW disk type - default is no DW TRPSET::.WORD I.TRAP ;Offset into impure area for TRPSET handler $NULJB::.WORD ..NULJ ;-> WAIT/NOP (null job) ;>>>$Rel .-2 ..NULJ RMON IMPLOC::.WORD < $IMPUR + FJOBNM + 2 > ;-> (after) impure area ptrs table ;>>>$Rel .-2 $IMPUR+FJOBNM+2 RMON KMONIN::.WORD -1 ;0 => User running, -1 => KMON running .IF NE MMG$T PROGDF::.BYTE < 200 ! $$KEX > ;Default Editor to KEX prog .IFF ;NE MMG$T PROGDF::.BYTE < 200 ! $$KED > ;Default Editor to KED prog .ENDC ;NE MMG$T $PROGF::.BYTE < 200 ! $$FORT> ;Default FORTRAN to F4 compiler WILDEF::.BYTE 1 ;Default Wildcards to ON JOBS: .BYTE < 1 + FJOBS > ;Number of job slots in system $QHOOK::.WORD Q2CAHK ;-> RMON QHOOKS ;>>>$Rel .-2 Q2CAHK RMON $H2UB:: .WORD OKRTN ;-> UB communications vector ;>>>$Rel .-2 OKRTN RMON .IF EQ MTT$Y $XOFF:: .WORD XEDOFF ;-> single terminals XOFF flag ;>>>$Rel .-2 XEDOFF RMON .IFF ;EQ MTT$Y $XOFF:: .WORD T.STAT ;Offset to XOFF flag in TCB .ENDC ;EQ MTT$Y $RTSPC::.WORD ERRRTN ;-> default communications vect. (Returns C=1) ;>>>$Rel .-2 ERRRTN RMON TEMP = 0 TEMP1 = 0 .IF EQ MTT$Y TEMP = 1 .IFF ;EQ MTT$Y .IF NE MAT$S TEMP1 = 1 .ENDC ;NE MAT$S .IF EQ DL11$N-1 TEMP = 1 .ENDC ;EQ DL11$N-1 .ENDC ;EQ MTT$Y TEMP2 = !! CONFG3::.WORD TEMP2!!!!CF3.IM ;Configuration word #3 $XTTNR::.WORD OKRTN ;XTT hook routine, reject input char ;>>>$Rel .-2 OKRTN RMON .IF EQ MTY$HK $THKPT::.WORD 0 ;No multi-terminal handler hooks support .IFF ;EQ MTY$HK $THKPT::.WORD THOOKS ;Pointer to terminal hooks data structure .ENDC ;EQ MTY$HK $DECNT::.WORD 0 ;DECNET communications word $XTTPS::.WORD OKRTN ;TTPS hook routine ;>>>$Rel .-2 OKRTN RMON $XTTPB::.WORD OKRTN ;TTPB hook routine ;>>>$Rel .-2 OKRTN RMON $SLOT2::.BYTE <$SLOT*2> ;Value of $SLOT multiplied by 2(8) .BYTE ;reserved for another byte value SPSIZE::.WORD 0 ;Special device return size value MAXOFF ==: < . - $RMON > ;Maximum RMON fixed offset .SBTTL Monitor Data Base - End of Fixed Offset Area ;+ ;*********************** End of Fixed Offset Area ************************* ;- BUFLOC::.WORD 0 ;->USRBUF if USRLOC is non-zero USRLVL: .BYTE 0 ;Depth of USR calls USROWN: .BYTE 377 ;Owner of USR (377 => free) USRSWP: .WORD 0 ;Flag saying whether the USR SWAPs (0 => no) $SWPBL::.WORD 0 ;Start of SWAP area EXLIST: .WORD 0 ;IOB used to write out USER on exit .WORD - .WORD 0 $KMLOC::.WORD KMON ;Permanent address of KMON ;>>>$Rel .-2 KMON RMON .WORD ;Size of KMON and USR .WORD 0 KMLOC:: .WORD KMON ;Current location of KMON (0 => non-resident) ;>>>$REL? $TIME:: BSS ;Double precision time ;+ ; System memory control block pointers. ; ***** The next 5 words must be kept together. ***** ;- $RAMSZ::.WORD 0 ;Total amount of RAM memory available CORPTR::.WORD 0 ;Free core pointer (low memory) .WORD CORPTR ;Pointer to free core pointer (self referent) ;>>>$Rel .-2 CORPTR RMON .IF NE MMG$T ;XM only (these must follow at CORPTR+4) CORPTX::.WORD <$XMSIZ-$RMON> ;Free core offset (high memory) ;I&D+ .WORD I.MPTR ;Impure area offset to MCA chunk address $RCBNM::.BYTE R.GNUM ;# of local RCBs for each job $WCBNM::.BYTE ;# of WCBs for each job .WORD M.RGN ;MCA offset to start of job's RCBs .WORD M.WCB ;MCA offset to start of job's WCBs .WORD M.APR ;MCA offset to start of job's APRs .WORD I.VHI ;Impure area offset to virtual high limit ;I&D- .ENDC ;NE MMG$T .SBTTL GETPSW - Return PSW In A Processor Independent Manner ;+ ; This routine returns on the stack, the contents of the PSW. The PS ; reference is modified by boot to a MFPS instruction if the processor ; is an LSI11. ;- ;+ ; GETPSW (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; CALLR $GTPSW ; ; The $GTPSW routine is located in the RTEM-11 linkage routines and ; allows RTEM-11 to correctly obtain the PSW in the emulated environ- ; ment. ;- .ENABL LSB GETPSW::MOV @#PS,-(SP) ;**BOOT** Get contents of PSW. ;(*** RTEM-11 HOOK ***) .IF EQ MMG$T CLRB 1(SP) ;Make sure it's low bits only. .ENDC ;EQ MMG$T MOV 2(SP),-(SP) ;Copy return address. MOV 2(SP),4(SP) ;Move PSW contents. BR 10$ ............ .SBTTL PUTPSW - Set PSW In A Processor Independent Manner ;+ ; This routine sets the PSW in a processor independant manner. The ; reference is modified by boot to a MTPS instruction if the processor ; is an LSI11. ;- ;+ ; PUTPSW (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; CALLR $PTPSW ; ; The $PTPSW routine is located in the RTEM-11 linkage and allows ; RTEM-11 to correctly set the PSW in the emulated environment. ;- PUTPSW::MOVB 2(SP),@#PS ;**BOOT** Move low byte to PSW. ;(*** RTEM-11 HOOK ***) 10$: MOV (SP)+,@SP ;Purge stack. RETURN ;Return. ............ .DSABL LSB .SBTTL Monitor Data Base - Continued CCB:: BSS 10 ;Resident CCB for KMON SWIIOB: .WORD 0, USRLEN, 0 ;IOB for SWAP into memory SWOIOB: .WORD 0, -USRLEN, 0 ;IOB for writing user to SWAP blocks KMBLK:: BSS 3 ;IOB for final read of USER for R or RUN ;+ ; Indirect File/DCL Status Words: ;- INBFPT::.WORD 0 ;Indirect File buffer pointer IFSVST::.WORD 0 ;Pointer to Indirect File save status area CURLEV::.WORD 0 ;Not equal denotes IND run from @File ;+ ; Begin Critical Ordering ;- FRKCQE: .WORD 0 ;First element in FORK queue FRKLQE: .WORD 0 ;Last element in FORK queue ;+ ; End Critical Ordering ;- SYDVSZ::.WORD 0 ;**BOOT** System device size ;+ ; Table of High Limit (highest SETTOP + 2) and Low Limit for each job ; NOTE: BG High Limit is the lowest loaded handler or FG job, i.e. SYSLOW ;- $JBLIM:: SYSLOW:: .IF EQ MMG$T .WORD $RMON, 0 ;Entire area (up to SYSLOW) ;>>>$Rel .-4 $RMON RMON .IFF ;EQ MMG$T .WORD USRBUF, 0 ;Only up to USR (USR doesn't swap) ;>>>$Rel .-4 USRBUF RMON .ENDC ;EQ MMG$T .REPT FJOBS .WORD 0, 0 ;Initially no FG job(s) .ENDR ;+ ; Multi-terminal handler hooks data structure ;- .IF NE MTY$HK THOOKS:: .BYTE THK.SZ ;Length (bytes) of this structure .BYTE TCBMAX ;Number of TCBs (number of LUNs) .WORD TCBLST ;Pointer to TCB list .WORD MTOENB ;Pointer to Output Enable routine .WORD MTYBRK ;Pointer to Break Control routine .WORD MTYCTL ;Pointer to Modem Control routine .WORD MTYSTA ;Pointer to Modem Status routine .Assume <.-THOOKS> EQ THK.SZ .ENDC ;NE MTY$HK .SBTTL Description Of Monitor Data Base ;+ ; "Merely corroborative detail, intended to give artistic ; verisimilitude to an otherwise bald and unconvincing ; narrative." - W.S. Gilbert, The Mikado ; ; BLKEY and CHKEY indicate which directory block is in memory ; and what device that directory is attached to. ; ; BLKEY is the number of the directory segment now in memory. Segments ; are numbered 1-31 (decimal). They are 2 physical blocks each. ; ; CHKEY describes the device to which the directory is attached. ; ; The even byte contains the device index, identifying the device type, ; and the odd byte contains the unit number of the device ; ;********************************************************************** ; ; $PNAME - Permanent Name Table ; ; $PNAME holds the RAD50 device names, loaded by the bootstrap. ; ;********************************************************************** ; ; $UNAM1/$UNAM2 - User Name Tables ; ; These tables hold the device names defined with the ASSIGN command. ; ; The user specifies 2 names in the ASSIGN: ; .ASSIGN nam1 nam2 ; ; $UNAM1 holds nam1, the system permanent name ; $UNAM2 holds nam2, the user's name, at the corresponding location ; ;********************************************************************** ; ; $STAT Table - Device Status Table ; ; $STAT contains information about the device types and the structure ; of the devices in the system. ; ; Even Byte: contains a number which is unique to that device type: ; ; 0 = RK05 Disk 22= RX11/RX01 Floppy Disk ; 1 = DECtape I 23= RK06 Disk ; 2 = Error Logger 25= Null handler ; 3 = Line Printer 26-30= Reserved DECNET ; 4 = TTY or BA 31-33= Reserved DIBOL ; 5 = RL01/02 Removable Disk 34= TU58 DECtape II ; 6 = RX02 Floppy Disk 35= TK25/TU80/TS04/TS05/TS11 Magtape ; 7 = Hi Speed Reader/Punch (PC11) 36= PDT-11/130 ; 10= RTEM Virtual Device ; 11= TM11/TU10/TS03 Magtape 37= PDT-11/150 ; 12= RF11 Fixed Disk 41= Serial LP (LS) ; 13= TA11 Cassette Tape 42= Message Queue Handler (MQ) ; 14= CR11 Card Reader 43= ??????????? ; 16= RJS03/RJS04 Fixed Head Disk 44= ??????????? ; 20= TJU16 Magtape 45= ??????????? ; 21= RP11/RPR02/RP03 Disk 70-100= Reserved DAEMON ; 200-377= Reserved To Customers ; ; The Odd Byte contains information on the device (see EDTGBL for details) ; ;********************************************************************** ; ; $ENTRY Table - Handler Entry Point Table ; ; When a device handler is in memory, $ENTRY for the device points to ; the handler at its LQE word. 0 => the handler is not in memory ;- .SBTTL Monitor Device Table Layout .IF EQ SB .PSECT OWNER$ $OWNER:: .ENDC ;EQ SB .PSECT UNAM1$ $UNAM1:: .PSECT UNAM2$ $UNAM2:: .PSECT PNAME$ $PNAME:: .PSECT ENTRY$ $ENTRY:: .PSECT STAT$ $STAT:: .PSECT DVREC$ $DVREC:: .PSECT HSIZE$ $HSIZE:: .PSECT DVSIZ$ $DVSIZ:: .IF NE UNI$64 .PSECT PNAM2$ $PNAM2:: .ENDC ;NE UNI$64 .IF NE MMG$T .PSECT DVINT$ $DVINT:: .ENDC ;NE MMG$T .PSECT RMON RTCODE:: .SBTTL BKGND - Background Impure Area ;+ ; The Background has a permanently allocated impure area in the RMON ; ; "In all things, success depends on previous preparation." ; - Confucius ;- .PSECT RMON ;All code goes into RMON. BKGND:: .WORD 0 ;I.STAT BKGND1::.WORD BAVAIL ;Queue header (-> initial Q element) ;>>>$Rel .-2 BAVAIL RMON .WORD 0, 0, 0, 0, 0 ;Completion TAIL, HDR, CHWT, PCHW, PERR .IF EQ MTT$Y .WORD 0 ;TTY line count .IFF ;EQ MTT$Y BKCNSL::.WORD DLTCB ;Pointer to console terminal TCB ;>>>$Rel .-2 DLTCB RMON .ENDC ;EQ MTT$Y .WORD 0 ;Previous character (unused by MTT$Y) BKGND2::.WORD BKGID ;Pointer to job ID area ;>>>$Rel .-2 BKGID RMON .WORD 0 ;Background (B) is always job 0 .WORD CHNUM ;16 channels in background BKGND3::.WORD $CSW ;Pointer to Channel Status Area ;>>>$Rel .-2 $CSW RMON .WORD 0 ;IO count .WORD 0 ;Suspend counter .WORD 0 ;Blocking bits for a job ;+ ; *** End of Fixed Offset Region Within Background Impure Area *** ;- BKGID: .ASCIZ "B>" ;Job ID block for background .IF NE SYT$K .BLKB ;Unused job ID space .ASCII "*KMON*" ;ASCII logical job name (*KMON* at boot) .IFF ;NE SYT$K .BLKB ;Unused job ID space .ENDC ;NE SYT$K BNAME: .WORD 0, 0, 0, 0 ;Name of program running in B/G ;.RAD50 dev:filnam.ext .WORD 0 ;Address of special list .WORD 0 ;TRAP to 4/10 handler .IF NE FPU$11 .WORD 0 ;FPP exception address .ENDC ;NE FPU$11 .IF EQ SB .IF NE MMG$T .WORD 0 ;Kernel SP save area .ENDC ;NE MMG$T .WORD 0, 0 ;Extra stuff to context swap .WORD 0 ;Stack Pointer BSS MAPSIZ ;Bit map .ENDC ;EQ SB .IF NE MTT$Y .WORD 0 ;Unit number of job's console .WORD 0 ;Line count .ENDC ;NE MTT$Y TTIBUF::.WORD IBUFR ;Low input ring buffer pointer limit ;>>>$Rel .-2 IBUFR RMON .WORD IBUFR ;Interrupt pointer for input ring buffer ;>>>$Rel .-2 IBUFR RMON .WORD 0 ;Input ring buffer character count .WORD IBUFR ;EMT pointer for input ring buffer ;>>>$Rel .-2 IBUFR RMON .WORD ;High input ring buffer pointer limit ;>>>$Rel .-2 IBUFR+TTBF$I RMON IBUFR: .BLKB TTBF$I ;Input ring buffer TTOBUF::.WORD OBUFR ;EMT pointer for output ring buffer ;>>>$Rel .-2 OBUFR RMON .WORD 0 ;Output ring buffer character count .WORD OBUFR ;Interrupt pointer for output ring buffer ;>>>$Rel .-2 OBUFR RMON .WORD ;High output ring buffer pointer limit ;>>>$Rel .-2 OBUFR+TTBF$O RMON OBUFR: .BLKB TTBF$O ;Output ring buffer BAVAIL: BSS ;Initial queue element .IF EQ SB .WORD ACTIV$+ ;Message channel .WORD 0, 0, 0 ;3rd word is .SERR flip/flop .BYTE 0 ;I/O count on message channel .BYTE FJOBNM ;Job number of FG job for message chnl .IFF ;EQ SB .WORD 0 ;.SERR flip/flop .ENDC ;EQ SB .WORD 0 ;Terminal Status Word .WORD 0 ;Terminal Status Word 2 .WORD 0 ;CTRL/C Terminal Status Pointer .IF NE MMG$T .WORD 0 ;PAR1 bias .ENDC ;NE MMG$T .WORD 0 ;Linked special list .IF NE MMG$T .IF EQ SB .IF NE FPU$11 BGFPPT::.WORD BGFPSV ;Pointer to FPU save area ;>>>$Rel .-2 BGFPSV RMON .ENDC ;NE FPU$11 .IF EQ MTT$Y BSS 15. ;$SYCOM save area .IFF ;EQ MTT$Y BSS 16. ;$SYCOM save area .ENDC ;EQ MTT$Y BSS 8. ;Register save area .ENDC ;EQ SB BGMPTR::.WORD P28KCK ;Chunk -> to BG's mapping context area (MCA) BSS 7. ;Copy area for user PLAS parameters .IF NE SUP$Y .WORD 0 ;Mode/space parameter for window PLAS passes .WORD ;Initial state of .CMAP .WORD 0 ;Supervisor SP .ENDC ;NE SUP$Y .IF NE FPU$11 & ^c ;If FPU support and FB/XM BGFPSV: BSS < <6*4> + 1 > ;FPU save area .ENDC ;NE FPU$11 & ^c BGVHI:: .WORD 0 ;SETTOP virtual high limit (LINK /V) .WORD 0 ;SETTOP high limit for VBGEXE jobs .ENDC ;NE MMG$T .IF NE SPC$PS .WORD 0 ;EMT depth counter .WORD 0 ;Address of SPCPS block .IF NE MMG$T .WORD 0 ;PAR1 for SPCPS block .ENDC ;NE MMG$T .ENDC ;NE SPC$PS .IF NE MMG$T .IF NE SUP$Y .WORD 0 ;Supervisor mode trap to 4/10 routine address .IF NE FPU$11 .WORD 0 ;Supervisor mode FPP exception routine address .ENDC ;NE FPU$11 .ENDC ;NE SUP$Y .ENDC ;NE MMG$T PBSYCH::.WORD $SYSCH ;Pointer to system I/O channel ;>>>$Rel .-2 $SYSCH RMON .IF NE < . - BKGND + C.SIZ > - IMP.SZ ; +C.SIZ cause Background's system ... ; ... channel isn't in its impure area .ERROR ;Background impure area improperly defined .ENDC ;NE < . - BKGND + C.SIZ > - IMP.SZ .SBTTL $IMPUR - Impure Area Pointers ;+ ; Table of Impure Area Pointers, one entry per job ;- .WORD -1 ;Stopper for searches $IMPUR:: BCNTXT::.WORD BKGND ;Background impure area pointer ;>>>$Rel .-2 BKGND RMON .REPT FJOBS ;Foreground impure area pointer(s) .WORD 0 .ENDR FCNTXT ==: < . - 2 > .SBTTL EMTDEF - EMT Dispatch Table Macro ;+ ; This is a list of the functions available as EMT services ; ; The functions are divided into 2 groups: ; EMT 375 functions, which take more than a code & channel ; EMT 374 functions, which take only code and possibly channel number ; ; Register contents on dispatching to an EMT: ; R0 = First argument ; R1 -> Rest of argument list, if any ; R2 = EMT index for USR plus new format bit ; R3 -> Channel Status Word ; R4 = Channel number *2 ; R5 -> Job's impure area ; ; The EMT dispatcher will address check the R0 argument ; and/or the first R1 argument, as specified in the dispatch table below ; ; The following Macro defines an entry in the EMT dispatch table ;- .MACRO EMTDEF ENTRY,R0CHK=NO,R1CHK=NO,ABBR .GLOBL ENTRY .IF NB ABBR ..'ABBR == ..TEMP .ENDC ..TEMP = < ..TEMP + 1 > .WORD < < < ENTRY - EMTCAL > + R1CHK > * 2 > + R0CHK .ENDM EMTDEF ..TEMP = 0 NO = 0 YES = 1 .SBTTL EMTLST - EMT 375 Dispatch Table ;+ ; EMT 375 Dispatch Table: ; ; Name R0? R1? Code ; ------ ---- --- --- ;- .ENABL LSB EMTLST: EMTDEF D$LETE NO NO ; 0 Delete EMTDEF L$OOK NO NO ; 1 Lookup EMTDEF E$NTER NO NO ; 2 Enter .IF NE SUP$Y EMTDEF S$TRAP NO NO ; 3 Set Trap to 4 & 10 .IFF ;NE SUP$Y EMTDEF S$TRAP YES NO ; 3 Set Trap to 4 & 10 .ENDC ;NE SUP$Y EMTDEF R$NAME NO NO ; 4 Rename EMTDEF S$AVST YES NO ; 5 Savestatus EMTDEF R$OPEN YES NO ; 6 Reopen EMTDEF C$LOSE NO NO ; 7 Close EMTDEF R$EAD NO NO ; 10 Read EMTDEF W$RITE NO NO ; 11 Write EMTDEF W$AIT NO NO ; 12 Wait EMTDEF C$PYCH NO NO ; 13 Copy other job's Channel EMTDEF D$VICE YES NO ; 14 Set Special Devices EMTDEF C$DFN YES NO ; 15 Define Channels EMTDEF EMT16 NO NO ; 16 Group 16 EMTs EMTDEF EMT17 NO NO ; 17 Internal Error EMTDEF G$TJB YES NO ; 20 Get Job parameters EMTDEF G$TIM YES NO GTIM ; 21 Get Time of day .IF NE TIME$R .IF NE SUP$Y EMTDEF M$RKT YES NO MRKT ; 22 Mark Time .IFF ;NE SUP$Y EMTDEF M$RKT YES YES MRKT ; 22 Mark Time .ENDC ;NE SUP$Y EMTDEF C$MKT NO YES CMKT ; 23 Cancel Mark Time EMTDEF T$WAIT YES NO TWAI ; 24 Timed Wait .IFF ;NE TIME$R .IF NE SUP$Y EMTDEF EMTRTI YES NO MRKT ; 22 Mark Time .IFF ;NE SUP$Y EMTDEF EMTRTI YES YES MRKT ; 22 Mark Time .ENDC ;NE SUP$Y EMTDEF EMTRTI NO YES CMKT ; 23 Cancel Mark Time EMTDEF EMTRTI YES NO TWAI ; 24 Timed Wait .ENDC ;NE TIME$R EMTDEF S$DAT NO NO ; 25 Send Data EMTDEF R$CVD NO NO ; 26 Receive Data EMTDEF C$STAT YES NO ; 27 Channel Status EMTDEF S$FPP NO NO ; 30 Set FPP exception EMTDEF P$ROTE NO NO ; 31 Protect vectors EMTDEF S$PFUN NO NO ; 32 Special device Functions EMTDEF S$SWAP YES NO ; 33 Set extra Swap addresses EMTDEF G$VAL NO NO ; 34 GVAL, PVAL, PEEK, POKE .IF NE SUP$Y EMTDEF S$CCA NO NO ; 35 Set CTRL/C AST address .IFF ;NE SUP$Y EMTDEF S$CCA YES NO ; 35 Set CTRL/C AST address .ENDC ;NE SUP$Y EMTDEF P$LAS YES NO ; 36 PLAS mapping (EMTRTI in FB) EMTDEF M$TTIO NO NO ; 37 Multi-TT I/O (ignore if NO MTTY) EMTDEF S$DTTM YES NO SDTM ; 40 Set Date and Time EMTDEF S$PCPS YES NO ; 41 Save/Set main-line PC/PS EMTDEF S$FDAT NO NO ; 42 Set File Date (.SFDAT) EMTDEF F$PROT NO NO ; 43 Set File Protection (.FPROT) EMTDEF F$INFO NO NO ; 44 Get/set File Stuff ; (.GFSTA .GFINF .GFDAT) ; (.SFSTA .SFINF .SFDAT) EMTDEF C$LOSZ NO NO ; 45 Close and Set File Size (.CLOSZ) EMTDEF C$MAP NO NO ; 46 Control mapping E375MX =: < . - EMTLST > / 2 ;Maximum value of EMT 375 code .SBTTL - EMT 374 Dispatch Table 20$: EMTDEF W$AIT ; 0 Wait EMTDEF S$SPND ; 1 Suspend this job EMTDEF R$SUME ; 2 Resume this job EMTDEF P$URGE ; 3 Purge channel EMTDEF S$ERR ; 4 Set soft errors EMTDEF H$ERR ; 5 Set hard errors EMTDEF C$LOSE ; 6 Close (374 style) EMTDEF T$LOCK ; 7 Test & lock USR EMTDEF C$HAIN ;10 Chain EMTDEF M$WAIT ;11 Message wait EMTDEF D$ATE ;12 Date EMTDEF A$BTIO ;13 Abort I/O E374MX =: < . - 20$ > / 2 EMTMAX =: < . - EMTLST > / 2 .DSABL LSB .SBTTL $ERLOG - Error Logging Hooks ;+ ; "As far as we know, our computer has never had an undetected error." ; - Conrad H. Weisert, Union Carbide Corp. ;- .IF NE ERL$G .ENABL LSB $ERLOG:: .IF EQ SB TST (PC)+ ;Is logger task loaded? $ELHND:: .WORD 0 ;If not 0, -> error log task entry point BEQ 20$ ;No, just return CALL @$ELHND ;Call copy routine BCC 20$ ;EL says no need to resume EL task yet MOV R5,-(SP) ;Save R5 MOV (PC)+,R5 ;R5 -> error logger impure area $ELIMP:: .WORD 0 ;-> Error logger impure area INC I.SCTR(R5) ;Increment suspend count (RESUME HIM!) BVC 10$ DEC I.SCTR(R5) 10$: JSR R4,UNBLOK ;Resume error logger job .WORD SPND$ MOV (SP)+,R5 ;Restore R5 .IFF ;EQ SB MOV (PC)+,-(SP) ;Is Error Log (EL) handler loaded? $ELHND:: .WORD 0 ;If not 0, -> EL handler entry point BNE 20$ ;If so, go to it via RETURN w/addr on stack TST (SP)+ ;Not loaded, pop null addr off stack & return .ENDC ;EQ SB 20$: RETURN ............ .DSABL LSB .ENDC ;NE ERL$G .SBTTL Error Processor ;+ ; "The fault, dear Brutus, is not in our stars, ; but in ourselves" - Shakespeare, Julius Caesar ; ; EMT 376 is used to report monitor errors. ; If the error is unconditionally fatal or the user has ; not asked for control on errors, it prints a message and ; aborts the job. ; Otherwise, it reports a non-fatal error code ; ; "And oftentimes, excusing of a fault ; Doth make the fault worse by the excuse." - Shakespeare, John IV ;- .IF NE FPU$11 .SBTTL FPPERR - Floating Point Error Handler .ENABL LSB FPPERR:: .IF NE MMG$T GET SP,R4 ;Get user stack pointer into R4 .ENDC ;NE MMG$T BIT #,CONFIG ;Do we have an FPU? BEQ 10$ ;No .IF NE MMG$T TST (R4)+ ;Bump to 2(USER_SP) to discard FEC 10$: GET @R4,R4 ;Get FEA or interrupted PC into R4 .IFF ;NE MMG$T TST (SP)+ ;Have an FPU, discard FEC 10$: MOV (SP)+,R4 ;Get the address .ENDC ;NE MMG$T MOV #,R3 ;R3 = error code CALLR ERRCOM ;Merge with common error handler ............ .DSABL LSB .ENDC ;NE FPU$11 .IF NE PWF$L .SBTTL TRAPPF - Power Fail ;+ ; "Extreme remedies are very appropriate for extreme diseases." ; - Hippocrates, "Aphorisms" ;- .ENABL LSB TRAPPF::.ADDR #,R0 ;;; R0-> power up routine ;>>>$REL MOV R0,@#V.POWR ;;; Vector to it on power up BR SYHALT ;;; Wait ............ POWRUP::MOV #,SP ;;; Must have good SP JSR R1,2$ ;;; Print power fail message .ASCIZ "?MON-F-Power fail halt " .EVEN ............ .ENDC ;NE PWF$L .SBTTL FATAL - Fatal Error Processing, System Halt ;+ ; FATAL is called when nothing more can be done. ;- ;+ ; FATAL (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; JSR R1,$FATAL ; ; The $FATAL routine is located in the RTEM-11 linkage routines. ; It allows RTEM-11 to correctly handle fatal system errors. ;- FATAL:: .IF EQ VENU$C RESET ;;; (*** RTEM-11 HOOK ***) .IFF ;EQ VENU$C ;;; Don't RESET, we'd zap VENUS T-11 page map .ENDC ;EQ VENU$C .IF NE PWF$L .IF EQ MMG$T MOV R1,(PC)+ ;;; Save R1 in case stack ovrflow in sys state R1SAVE: .WORD 0 .ADDR #,R1 ;;; Point to sys halt message ;>>>$REL BR 2$ ;;; Print message ............ .IFF ;EQ MMG$T JSR R1,2$ ;;; Print crash message .ENDC ;EQ MMG$T SHLT: .ASCIZ "?MON-F-System halt " .EVEN ............ 2$: .IF EQ PDT$OP BIC #,@TTPS .IFF ;EQ PDT$OP CLR @TTPS .ENDC ;EQ PDT$OP 10$: CALL @$XTTPS ;;; Update TTPS, pls .IF NE VENU$C BITB #,@TTPS ;;; TT busy? BEQ 10$ ;;; Keep trying .IFF ;NE VENU$C TSTB @TTPS ;;; TT busy? BPL 10$ ;;; If MI, yes .ENDC ;NE VENU$C ;+ ; HKPC13 (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; CALL PIHK13 ; ; PIHK13 causes the character in the byte at (R1)+ to be displayed ; on the PRO300 video monitor. The Z-bit is set exactly as if the ; "MOVB (R1)+,@TTPB" were executed on a non-PRO300 series processor. ;- HKPC13:: ;;; (*** PRO300 HOOK ***) MOVB (R1)+,@TTPB ;;; No, print a character .ASSUME <.-HKPC13> EQ 4 CALL @$XTTPB ;;; Get data from TTPB BNE 10$ ;;; More to print .IF EQ MMG$T MOV R1SAVE,R1 ;;; Restore R1 (random if powerfail) .IFF ;EQ MMG$T MOV (SP)+,R1 ;;; Restore R1 .ENDC ;EQ MMG$T .ENDC ;NE PWF$L SYHALT::HALT ;;; Aaaaaaaaaaarrrrrrrrrgggggggg! ............ BR SYHALT ;;; and no way out ............ .DSABL LSB ;+ ; "GORT, Klaatu...borada...nikto" ; - "Day the Earth Stood Still" ; ; "The death of God left the angels in a strange position." ; - Barthelme, "On Angels" ; ; "I could prove God statistically." ; - George Gallop ;- .IF NE MPT$Y .SBTTL TRAPMP - Memory Parity Trap Handling ;+ ; "Preventives are far better than remedies." ; - Tryon Edwards ;- .ENABL LSB PARTBL:: BSS 16. ;;; Table of parity CSR's TRAPMP:: BIT #,CONFG2 ;;; Cache on this system? BEQ 10$ ;;; No cache BIT #,@#CMER ;;; Yes, cache error? BNE TRPRTI ;;; Go RTI -- cache errors are recoverable 10$: TST INTLVL ;;; Backing store error. TRAP from system? BPL FATAL ;;; Yes, fatal error .IF EQ MMG$T MOV #,R3 ;;; Put error code in R3 MOV (SP)+,R4 ;;; Get offending address BR ERRCOM ;;; Common code .............. .IFF ;EQ MMG$T CALLR TRPXMP ;;; Go to common parity trap code .............. .ENDC ;EQ MMG$T .DSABL LSB .ENDC ;NE MPT$Y .SBTTL TRAP4/10 - TRAPS to 4, 10 .ENABL LSB TRAP10:: TRAP4:: ;;; carry set => trap 10 else trap 4 ROL @#$ERRBY ;;; Preserve condition in $ERRBY TST INTLVL ;;; TRAP from the system? FTLBEQ: BPL FATAL ;;; Ouch .IF EQ MMG$T CMP #,SP ;;; Stack overflow? BHIS 50$ ;;; Yes, ignore user intercept .ENDC ;EQ MMG$T SPL 0 ;;; No, safe to come down .IF NE MMG$T BIT #,@#PS ;Trap from kernel mode? BNE 10$ ;Branch if not -- don't check for .GVAL trap .ENDC ;NE MMG$T BLETCH ==: .+2 ;exorcise this abomination when $Rel done CMP @SP,# ;Check for trap from .GVAL, et. al. ;>>>$Rel .-2 T4LOW RMON .IF NE MMG$T BLO FATAL ;Bad trap from kernel mode .IFF ;NE MMG$T BLO 10$ ;No, trap not from .GVAL, et. al. .ENDC ;NE MMG$T BARF ==: .+2 ;exorcise this abomination when $Rel done CMP @SP,# ; ... ;>>>$Rel .-2 T4HIGH RMON .IF NE MMG$T BHI FATAL ;Bad trap from kernel mode .IFF ;NE MMG$T BHI 10$ ;No, trap not from .GVAL, et. al. .ENDC ;NE MMG$T .ADDR #,@SP ;Derail to issue error 1 ... ;>>>$Rel .-2 EMT1ER RMON TRPRTI: RTI ; ... and "finish" operation 10$: .IF EQ MMG$T MOV R5,-(SP) ;Save R5 MOV CNTXT,R5 ;Point to current impure area MOV I.TRAP(R5),-(SP) ;Get user intercept address BEQ 40$ ;Branch if no trap address CLR I.TRAP(R5) ;Stop recursive problems MOV (SP)+,R5 ;Get intercept address in R5 ASR @#$ERRBY ;Get indication of TRAP to 4 or 10 RTS R5 ;Go to user .......... .IFF ;EQ MMG$T CLR -(SP) ;Leave room on stack MOV R5,-(SP) ;Save R5 MOV CNTXT,R5 ;R5 -> current impure area ADD #I.TRAP,R5 ;R5 -> user mode trap4/10 address .IF NE SUP$Y BIT #<20000>,@#PS ;Was trap from supervisor mode? BNE 20$ ;Branch if trap was from user mode ADD #,R5 ;R5 -> supervisor mode trap4/10 address 20$: .ENDC ;NE SUP$Y MOV @R5,-(SP) ;Get trap4/10 address for previous mode BEQ 30$ ;None, fatal error ASR @#$ERRBY ;Shift C bit ROL 4(SP) ; into PS CLR @R5 ;Prevent recursion MOV 2(SP),R5 ;Restore R5 MOV @SP,2(SP) ;Move user trap PC into place CALLR XMRERT ;Go reroute trap to user program .............. 30$: TST (SP)+ ;Purge a word .ENDC ;EQ MMG$T 40$: CMP (SP)+,(SP)+ ;;; Purge the 0 50$: MOV (SP)+,R4 ;;; save offending PC .IF EQ MMG$T MOV @#$USRSP,SP ;;; Reset stack .IFF ;EQ MMG$T TST (SP)+ ;;; Purge PS BIS #,@#PS ;;; Previous mode is user mode GET @#$USRSP,-(SP) ;;; Get initial user SP value PUT (SP)+,SP ;;; Reset user stack .ENDC ;EQ MMG$T BEQ FTLBEQ ;;; No user stack specified, so fatal SPL 0 ;;; Good, down to pr0 MOV #,R3 ;Get message number ASR @#$ERRBY ;Restore condition ADC R3 ;Make it TRAP to 10 if it was .BR ERRCOM ;Merge with errors. Watch PSECTS here if ... .............. ; ... the .BR is ever changed to a real BR .DSABL LSB .SBTTL ERRCOM - Fatal Errors: Common Processing ;+ ; Macro to define a monitor fatal error message with text "text". ; The symbol "CODE.E" contains the sequence number of the message. ;- .MACRO ERRMSG CODE,TEXT .ASCII TEXT<200> CODE'.E == ...ERN ...ERN = < ...ERN + 1 > .ENDM ERRMSG ...ERN = 0 ;Initialize the error number index .ENABL LSB ERRCOM::.HRESET ;Stop the world. It's time to get off .RCTRLO .IF EQ MTT$Y CALL CTRLQ2 ;In case lost TTY out interrupt .IFF ;EQ MTT$Y ;+ ; ERRHOK (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; BR .+14 ; ; It does this to prevent output interrupts from being zapped ; under the emulator. Without this hook, low baud terminals ; would lose error messages. ;- ;+ ; ERRHOK (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; CALL ERRHK ; ; ERRHK disables video output interrupts on the PRO300 series ;- ERRHOK:: ;(*** RTEM-11 HOOK ***) ; PDT$OP=0 for RTEM ;(*** PRO300 HOOK ***) .IF NE VENU$C MOVB @TTKCR,-(SP) ;Read command register data BISB #,@SP ;Set Error Reset & Transmit Enable bits MOVB (SP)+,@TTPCR ;Write data to command register .IFF ;NE VENU$C .IF EQ PDT$OP BIC #,@TTPS .IFF ;EQ PDT$OP CLR @TTPS NOP .ENDC ;EQ PDT$OP CALL @$XTTPS ;;; Update TTPS, pls BIS #,@TTPS .ASSUME .-ERRHOK EQ 20 .ENDC ;NE VENU$C .ENDC ;EQ MTT$Y CALL @$XTTPS ;;; Update TTPS, pls JSR R0,20$ ;Point R0 to messages, enter loop .ASCII "?MON-F-"<200> ERRMSG USRX,<"Inv USR"> ERRMSG NODV,<"No dev"> ERRMSG DIRI,<"Dir I/O err"> ERRMSG FETC,<"Bad fetch"> ERRMSG OVLY,<""> ;Always changes to OVER.E ERRMSG DOVR,<"Dir ovflo"> ERRMSG ADDR,<"Inv addr"> ERRMSG CHAN,<"Inv chan"> ERRMSG EMT,<"Inv EMT"> ERRMSG TR04,<"Trap to 4"> ERRMSG TR10,<"Trap to 10"> ERRMSG ILLD,<"Inv dir"> ERRMSG UDRV,<"Unloaded driver"> ERRMSG FPP,<"FPU trap"> ERRMSG MPAR,<"Mem err"> ERRMSG MMUF,<"MMU fault"> ERRMSG ISST,<"Inv SST"> ERRMSG OVER,<"Ovly err"> .EVEN ............ .IF NE VENU$C TTPCR:: .WORD TPCR ;-> Console TTY Command Reg Write Mode TTKCR:: .WORD TKCR ;-> Console TTY Command Reg Read Mode .ENDC ;NE VENU$C ;+ ; Find message, print it, print blank, then address ;- 10$: TSTB (R0)+ ;Advance pointer BPL 10$ ;Not done skipping yet DEC R3 ;This the message? BPL 10$ 20$: .PRINT ;Print a thing TST R3 ;Done printing? BPL 10$ ;No .TTYOUT # ;Print a space MOVB #<30>,R0 ;Print the number in R4 SEC 30$: ROL R4 ROLB R0 .TTYOUT MOV #<206>,R0 40$: ASL R4 BEQ 50$ ROLB R0 BCS 40$ BR 30$ ............ 50$: JSR R0,60$ ;Point to the USR message .ASCII "?MON-W-Directory unsafe" MZEROB: .BYTE 0 .EVEN ............ 60$: .IF EQ SB CMPB JOBNUM,USROWN ;Do we own the USR? BNE 70$ ;No, just print CR/LF .ENDC ;EQ SB TST DFLG ;Abort during critical place BEQ 70$ ;No INC R0 ;Give USR message CLR DFLG ;Avoid a crash 70$: .PRINT ;Print new line, maybe DIR UNSAFE .IF EQ SB TST JOBNUM ;Are we the background? BNE 80$ ;No, skip DCL/@File if FG or system job .ENDC ;EQ SB BIS #,STATWD ;Yes, abort indirect file BISB #,@#$USRRB ;Set user error byte to fatal 80$: CALLR UABORT ;Kill him ............ .DSABL LSB .SBTTL EMT 373 PROCESSING - CALLK (call kernel mode) ;+ ; "Give me a lever and a place to stand and I will move the Earth." ; -Archimedes ; ; "Three things are to be looked to in a building: ; that it stands on the right spot; that it be ; securely founded; that it be successfully executed." ; -Goethe ; ***INTERIM VERSION*** ;- .ENABL LSB .IF NE MMG$T E373: ;Process .CALLK EMT ;+ ; NOTE: SYSCOM is not copied, so access to SYSCOM is NOT recommended ; for the called routine or any EMT issued by it and if EMTs are issued, ; the contents of the error byte will not always be set in the user's SYSCOM. ;- BIT #,@#PS ;Is previous mode kernel? BEQ 10$ ;Kernel mode call, unjumble stack ;NOTE: This is compatible with ... ; ... possible support of SUPY mode GET SP,R4 ;Get user SP into R4 GET (R4)+,R5 ;Get call address PUT R4,SP ;Updated user SP MOV (SP)+,R4 ;Restore R4 ;SP->(R5)(PC)(PS)(oldtop) MOV @SP,-(SP) ;Copy old R5 ;SP->(R5)(R5)(PC)(PS)(oldtop) MOV R5,2(SP) ;Call address to stack ;SP->(R5)(call)(PC)(PS)(oldtop) MOV (SP)+,R5 ;Restore R5 ;SP->(call)(PC)(PS)(oldtop) CALL @(SP)+ ;Call @SP and pop stack ;SP->(PC)(PS)(oldtop) MOV @#PS,-(SP) ;Get PS (for cond codes) BIC #^c,@SP ;Clear all but cond codes BIS (SP)+,2(SP) ;Set into "old" PS on stack ... RTI ;... and return from EMT ............ 10$: ;.CALLK issued from Kernel mode .IFF ;NE MMG$T E373: ;SP->(R4)(R5)(PC)(PS)(call)(oldtop) .ENDC ;NE MMG$T MOV (SP)+,R4 ;Restore R4 ;SP->(R5)(PC)(PS)(call)(oldtop) MOV (SP)+,R5 ;Restore R5 ;SP->(PC)(PS)(call)(oldtop) MOV 4(SP),2(SP) ;Copy call address ;SP->(PC)(call)(call)(oldtop) MOV (SP)+,2(SP) ;Copy return address and align stack ;SP->(call)(PC)(oldtop) CALLR @(SP)+ ;Call kernel routine ............ .DSABL LSB .SBTTL E376 - EMT 376 Processing: Monitor Fatal Traps .ENABL LSB 10$: COM R3 ;Fatal code to positive 20$: MOV -(R2),R4 ;Get offending PC .IF NE MMG$T CMP (R2)+,(R2)+ ;Purge stack .ENDC ;NE MMG$T MOV R2,SP ;Upgrade stack CALLR ERRCOM ;Go give the fatal message ............ E376:: MOV OLDPC(SP),R1 ;R1 -> depth and error code .IF EQ MMG$T MOVB (R1)+,R2 ;R2 = depth of user PS CMPB @R1,#^c ;Is this an overlay error? BEQ 30$ ;Yes, issue another MONERR to deepen the stack ADD SP,R2 ;R2 -> user PS ADD #,R2 MOVB (R1)+,R3 ;R3 = error code .IFF ;EQ MMG$T GET (R1)+,R3,I ;R3 = depth of PS, code MOVB R3,R2 ;Copy depth of PS ADD SP,R2 ;R2 -> user PS on Kernel stack ADD #,R2 SWAB R3 ;Get the code byte CMPB R3,#^c ;Is this an overlay error? BEQ 30$ ;Yes, issue another MONERR to deepen the stack BIT #,OLDPS(SP) ;No, EMT 376 from User Mode? BNE 40$ ;Yes, that's an error MOVB R3,R3 ;Sign extend the code byte .ENDC ;EQ MMG$T BMI 10$ ;<0 is always fatal, fix code and abort MOV CNTXT,R5 ;Point to impure area TSTB I.SERR(R5) ;Not fatal. Does user want soft errors? BEQ 20$ ;Nope, quit now COM R3 ;Yes, make a negative code MOVB R3,@#$ERRBY ;Put it in BIS #,@R2 ;Put carry on in user's PS MOV R1,OLDPC(SP) ;Skip monitor over errors CALLR EMTRTI ............ 30$: MONERR OVER,,FATAL ;Overlay error issued from EMT depth ............ .IF NE MMG$T 40$: CALLR TOOBIG ;Error, EMT 376 (other than ovly) from user ............ .ENDC ;NE MMG$T .DSABL LSB .SBTTL Console TTY Configuration Data ;+ ; Flags to control command interpreters (UCF enabled for RTEM) ;- CLIFLG::.BYTE < UCL.ON ! CCL.ON ! DCL.ON ! > CLITYP::.BYTE -1 ;Current command interpreter in operation INDDEV::.ASCII "SY0:" ;Default device on which IND is run. ;Gets changed by IND during initialization ;and is used by KMON to chain back to IND .IF EQ MTT$Y ;+ ; The console teletype is shared among the active jobs in the system. ; Each job has ring buffers for input and output in its impure area, ; along with buffer pointers, character counts, etc. ;- .IF NE SYT$K ;+ ; For system tasking, ^X support was added. The data area for this is ; located below. *** These MUST BE KEPT IN ORDER and TOGETHER *** !!! ;- XFLAG:: .BYTE 0 ;^X sequence in progress *1* XCOUNT: .BYTE 0 ;Number chars in ^X buffer *2* XPREV: .WORD 0 ;Previous character typed (.WORD for a reason!) *3* XBUFF: .BLKB 6 ;6 character buffer *4* XPROMT: .ASCIZ "Job? " ;Prompt string typed when ^X struck *5* .ENDC ;NE SYT$K ;+ ; The following bytes control printing of special characters ; (TABs, Fills, etc.). *** They MUST BE KEPT IN ORDER and TOGETHER *** !!! ;- .IF NE VENU$C .ODD XEDOFF: .BYTE 0 ;XON/XOFF flag .ENDC ;NE VENU$C TTWIDT::.BYTE 80. ;Width of carriage .BYTE CR FILCHR: .BYTE 0 ;Character used to fill FILCTR: .BYTE 0 ;Number of fills OUTCHR: .BYTE 0 ;Character to print LINPOS: .BYTE 0 ;Position on carriage TTCNFG::.WORD < PAGE$ ! FBTTY$ ! HWTAB$ ! BKSP$ > .ENDC ;EQ MTT$Y .SBTTL EMTPRO - EMT Processor ;+ ; "What's it going to be then, eh?" - A. Burgess, "Clockwork Orange" ; ; This dispatcher must reside BEFORE any EMT routine ;- .ENABL LSB EMTPRO::BIC #,2(SP) ;Clear all condition code bits MOV R5,-(SP) ;Save registers 5 ... MOV R4,-(SP) ; ... and 4 MOV 4(SP),R5 ;R5 -> word after EMT instruction GET -(R5),R4,I ;Pick up user's EMT instruction CMPB R4,#<...CAL> ;Is it a .CALLK? BEQ E373 ;Yes, so go do it (without too much overhead) JSR R3,SAVE30 ;Save registers 3-0 TST (SP)+ ;Purge SAVE30 return address ;+ ; R2 is used when dispatching to an EMT located in the USR. ; It contains the index of the routine in the USR (see EMTUSR). ; The sign bit set indicates a new format (V02+) EMT. ;- CLR R2 ;For calling the USR .IF NE MMG$T MOV @#KISAR1,@SP ;Save current mapping MOV R0,-(SP) ;Put another copy of R0 on top of stack .ENDC ;NE MMG$T .IF NE SPC$PS MOV CNTXT,R5 ;Point to current impure area ... INC I.ECTR(R5) ; ... and bump EMT depth .ENDC ;NE SPC$PS .IF NE MMG$T MOV @#PS,-(SP) ;Save PS BIT #,@SP ;Was previous mode Kernel? BEQ 20$ ;Yes BIS #,@#PS ;Make sure we use user space MOV #<$SYCOM>,R1 ;R1 -> Kernel $SYCOM area 10$: GET @R1,(R1)+ ;Copy a value from user space to Kernel $SYCOM CMP R1,#<$SYPTR> ;Done? BLO 10$ ;BR if more 20$: MOV (SP)+,@#PS ;Restore previous PS .ENDC ;NE MMG$T MOV SP,R1 ;Point R1 to args on stack CMPB R4,#<...R0> ;Is it new format? BLO OLDEMT ;Branch if not ;+ ; At this point we have an EMT code in the range 374-377. ;- NEWEMT: BNE 50$ ;BNE if EMT 375 or 376 or 377 ADD #,R0 ;Index past EMT 375 list CMP #,R0 ;Is it a valid EMT 374 code? BR 70$ ;And link with common code ............ 50$: CMPB R4,#<...ERR> ;Is it 376 (error) or 377 (ignored)? BEQ E376 ;376 is fatal error code BHI EMTOUT ;EMT 377 is ignored ;+ ; EMT 375 Format: R0 -> argument block ;- .IF NE MMG$T BIT #,@#PS ;New EMT from Kernel mode? BEQ 60$ ;Yes, skip address check and map operations .ENDC ;NE MMG$T ;I&D+ ; Check previous mode D-else-I space address ;I&D- JSR R5,CHKSP ;Check list address for validity BR ERRARG ;Soft address check ...... .IF NE MMG$T CALL $RELOM ;R0 -> argument block .ENDC ;NE MMG$T 60$: MOV #<100000>,R2 ;Indicate new format EMT MOV R0,R1 ;Copy argument block pointer MOV (R1)+,R0 ;Put code and channel into R0 MOV (R1)+,@SP ;Normal R0 arg to R0, R1 -> rest of arg list CMP #,R0 ;Is it a valid EMT 375 code? 70$: BLOS TOOBIG ;No, give an error CLR R4 ;R4 will hold channel data BISB R0,R4 ;Put channel byte in R0 BEQ 80$ ;Branch if channel number is 0 MOV CNTXT,R5 ;Compare chan # specified w/ number declared CMPB R4,I.CNUM(R5) ;Is it within range? BHIS CHANER ;Channel is too high, give an error 80$: MOV R0,R5 ;Copy code and channel CLRB R5 ;Clear channel bits SWAB R5 ;Get EMT code ASL R5 ;Double for word indexing MOV @SP,R0 ;R0 argument back to R0 BR EMTCOM ;Branch to common EMT location. .............. OLDEMT: .IF EQ MMG$T ADD #,R1 ;Point R1 to args .IFF ;EQ MMG$T BIT #,@#PS ;EMT from Kernel mode? BNE 30$ ;Branch if not ADD #,R1 ;Yes, V1 args on Kernel stack BR 40$ ;Which is current stack in use ............ 30$: GET SP,R0 ;Get prev. mode SP, R0 -> args on prev. stack CALL $RELOM ;Map R0 to args MOV R0,R1 ;Copy to R1 MOV @SP,R0 ;Restore R0 value CLR R2 ;Indicate old format EMT .ENDC ;EQ MMG$T 40$: MOV R4,R5 ;Copy it BIC #^c<17>,R4 ;Isolate channel number BIC #^c<360>,R5 ;Isolate EMT index ASR R5 ;Shift it to get ... ASR R5 ; ... word index ... ASR R5 ; ... into table .BR EMTCOM ;Merge with common code .............. ;+ ; All paths merge here ;- EMTCOM::ADD PC,R5 ;Get EMT routine offset ... MOV EMTLST-.(R5),R5 ; ... into R5 ;>>>$Rel .-2 EMTLST RMON ROR R5 ;Shift right one BCC 90$ ;Do not check R0 argument ;I&D+ ; Check previous mode D-else-I space address ;I&D- JSR R5,CHKSP ;Check R0 argument BR ERRARG ;Bad address, give address error ...... 90$: ASR R5 ;Check R1 argument? BCC 100$ ;No MOV @R1,-(SP) ;Yes, get R1 argument ... ;I&D+ ; Check previous mode D-else-I space address ;I&D- JSR R5,CHKSP ; ... and check it out BR ERRARH ;Bad address, give address error ...... TST (SP)+ ;Prune argument from stack 100$: ASL R5 ;Fix offset ... MOV R5,-(SP) ; ... and save it MOV CNTXT,R5 ;Get pointer to impure area ASL R4 ;Multiply channel number by 2 MOV R4,R3 ;Now point R3 to correct CSW area ASL R3 ; ... ASL R3 ; ... ADD R4,R3 ; ... (10. bytes per channel) ADD I.CSW(R5),R3 ;Add pointer to start of channel area CLRB @#$ERRBY ;Clear error byte indicator ADD (SP)+,PC ;Jump to routine ;>>>$REL? EMTCAL: ;Used in dispatch table TOOBIG::MONERR EMT ;Give (maybe) fatal error BR EMTOUT ............ ERRARH: TST (SP)+ ;Purge a word first ERRARG::MONERR ADDR ;Illegal address in R0 BR EMTOUT ............ CHANER: MONERR CHAN ;Illegal channel number EMTOUT: CALLR EMTDON ............ .DSABL LSB .IF NE TIME$R .SBTTL MARKTM - Get A Queue Element And Place It On The Timer Queue ;+ ; MARKTM - Get a queue element and place it on the timer queue ; ; R0 -> Time block (2 words): high order ticks, low order ticks ; R1 -> Parameters: completion address, sequence number (for c.r.) ; R5 -> Job impure area ; SP = EMT dispatch level ; State = User ; ; CALL MARKTM ; ; R0-R2 = random ; R3 -> queue element @ C.HOT ; R5 -> job impure area + 2 ; ; If no queue element is available, gives error 0 & does not return ; ; User .MRKT requests MAY NOT use sequence numbers 177000-177777 UNDER ; PENALTY OF SYSTEM CRASH. They are reserved for internal use as follows: ; ; These must be individually cancelled: ; 177000 - 177377 Device handlers ; 177400 - 177477 Multi-terminal support ; 177500 - 177677 (reserved) ; These are cancelled when the associated user job exits or aborts: ; 177700 .TWAIT element ; 177701 - 177766 (reserved) ; 177767 - 177777 DECNET/RT-11 ;- .ENABL LSB MARKTM::TST (R5)+ ;Point to avail header SPL 7 ;Get element at PRIO 7 MOV @R5,R3 ;;; Get element BEQ 60$ ;;; None there, error MOV @R3,@R5 ;;; Link avail queue forward SPL 0 ;;; Back to PRIO 0 GET (R0)+,(R3)+ ;Move in high order time to C.HOT GET (R0)+,(R3)+ ; and low order time to C.LOT ADD #,R3 ;Move in stuff in reverse MOV (R1)+,@R3 ;Completion address CLR -(R3) ;Clear for no channel offset .IF NE MMG$T CMP #,@R1 ;Is this a .TWAIT request? BNE 10$ ;No MOV #,@R3 ;Yes, flag with a -3 code .ENDC ;NE MMG$T 10$: MOV (R1)+,-(R3) ;Identifying number .IF EQ SB MOV JOBNUM,-(R3) ;Job number .IFF ;EQ SB CLR -(R3) ;Job number always 0 (=BG) .ENDC ;EQ SB TST -(R3) ;Point to C.LINK (link word) ENSYS 50$ ;Enter System State, return to 50$ .BR TIMIO ;; Enqueue the element ............ .SBTTL TIMIO - Put An Element On The Timer Queue ;+ ; TIMIO - Put an element on the timer queue ; ; R3 -> timer element @ C.LINK (element + 4) ; C.COMP, C.SYS, C.SEQ, C.JNUM already set ; State = System ; ; CALL TIMIO ; ; R0 = random ; R1 = random ; R2 = random ; R3 -> queue element @ C.HOT ; R4 = random ; R5 = random ;- ;+ ; TIMIO (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; CALL $MRKT ; ; The $MRKT routine is located in the RTEM-11 linkage ; routines. This hook allows RTEM-11 to correctly ; setup a RSX-11 marktime request, since the clock ; never ticks under RTEM-11. ;- ;; (*** RTEM-11 HOOK ***) TIMIO:: ADD PSCLOK,-(R3) ;; Change time to system relative ... ADC -(R3) ;; ... as double precision MOV (R3)+,R0 ;; R0 = high order time .ADDR #,R2 ;; R2 -> clock queue header ;>>>$REL 20$: MOV R2,R1 ;; R1 -> previous link word MOV @R1,R2 ;; R2 -> next element to consider BEQ 40$ ;; Put it at end of queue MOV (R2)+,R4 ;; Get time of expiration of this element MOV (R2)+,R5 ;; CMP R0,R4 ;; Compare high order times BNE 30$ ;; Go loop if user time >= this time CMP @R3,R5 ;; Equal, compare low order times 30$: BHIS 20$ ;; Not yet 40$: TST -(R3) ;; Back up to start of element (C.HOT) MOV @R1,C.LINK(R3) ;; Link new element to next of prev. @ C.HOT MOV R3,@R1 ;; Link prev. element to new element @ C.HOT 50$: RETURN ;; Get out of System State ............ 60$: SPL 0 ;;; to Priority 0 .BR ER0SP ;Fall through to give error ............ .DSABL LSB .ENDC ;NE TIME$R ER0SP: TST (SP)+ ;Purge return address ERRLK0: CALLR ER0EMT ;Give an error ............ .IF NE TIM$IT .SBTTL $TIMIO - Device I/O Time Out Service ;+ ; $TIMIO - Put driver timeout element on timer queue ; ; State = any ; ; JSR R5,$TIMIO [Macro call: .TIMIO TBK,HI,LO] ; .WORD TBK-. (See below) ; .WORD 0, , ; ; TBK is a 7-word pseudo-queue element containing: ; ; Word Contents ; ; 0 Hi order delta time in ticks (set by this call) ; 2 Lo order delta time in ticks (set by this call) ; 4 Zero ; 6 Job number ; 10 Sequence number of this request ; 12 -1 (Set by this call) ; 14 Completion address to run on time out ;- .ENABL LSB $TIMIO::JSR R3,SAVE30 ;Save registers MOV R5,R3 ;Copy return address ADD (R5)+,R3 ;R3 -> timer element MOV 12(SP),-(SP) ;Saved R5 to top of SP MOV R4,-(SP) ;Save R4 TST (R5)+ ;Test function code BNE $CANIO ;Code 0, go cancel timer element MOV (R5)+,(R3)+ ;Move in high order time MOV (R5)+,(R3)+ ;Move in low order time MOV R5,16(SP) ;Return address to SP MOV #,C.SYS-C.LINK(R3) ;Make sure it's system element ENSYS 10$ ;Enter System State to lockout clock BR TIMIO ;; Queue up request, return to 10$ ............ .SBTTL $CANIO - Cancel Device I/O Timeout ;+ ; $CANIO - Remove driver timeout element from timer queue ; ; State = System ; ; JSR R5,$TIMIO [Macro call: .CANIO TBK] ; .WORD TBK-. (As passed to $TIMIO) ; .WORD 1 ; ; C=1 if Cancel failed ;- $CANIO::MOV R5,16(SP) ;; Put return address on stack MOV C.SEQ(R3),R0 ;; R0 = sequence number to cancel MOV #,R1 ;; System cancel limit (cancel all) .IF EQ SB MOV C.JNUM(R3),R2 ;; R2 = job number to cancel .ENDC ;EQ SB CLR R5 ;; R5 = 0 => don't return unexpired time CALL CMARKT ;; Go cancel the mark time 10$: MOV (SP)+,R4 ;; Restore registers MOV (SP)+,R5 ;; 20$: RETURN ;; ............ .DSABL LSB .ENDC ;NE TIM$IT .SBTTL .CDFN - Channel Define EMT ;+ ; (*** DBGEXE *** Following section modified for DBGEXE support.) ;- .ENABL LSB C$DFN: MOV @R1,-(SP) ;@SP = channel count .IF NE MMG$T CALL $V2P1 ;Convert virtual to physical BCC 10$ ;Ok to use user address ;+ ; If user memory is in extended memory or in PAR1, ; try allocating requested memory from pool ;- MOV @SP,R0 ;R0 = number of channels (5-word blocks) CALL PL5WD ;Allocate memory from pool BCS ER0SP ;Branch if memory allocation failed 10$: MOV R2,R0 ;Copy physical address to R0 MOV R2,2(SP) ;Return physical address in R0 CALL P1SD ;Restore Kernel PAR1 .ENDC ;NE MMG$T ADD #,R5 ;Point to channel count MOV I.CSW-I.CNUM(R5),R2 ;R2 -> old channel area CMPB @SP,@R5 ;New count <= old count? BLOS ER0SP ;Yep, error CALL QUIESCE ;Wait for quietness CLR R3 ;Clear channel counter 20$: MOV #,R4 ;5 words / channel CMPB @R5,R3 ;Old count >= channel we are working on BHI 40$ ;Yes, so copy it 30$: CLR (R0)+ ;No, clear it SOB R4,30$ ;5 words BR 50$ ............ 40$: MOV (R2)+,(R0)+ ;Copy the channel SOB R4,40$ ;Repeat until done 50$: INCB R3 ;Bump number of working channel CMPB @SP,R3 ;New count >= this channel? BHI 20$ ;Yes, keep going MOV (SP)+,(R5)+ ;Set new count BR 190$ ;Go set new pointer ............ .IF NE TIME$R .SBTTL .TWAIT - Timed Wait EMT ;+ ; "But we like sentries are obliged to stand in starless nights, ; and wait th' appointed hour." - Dryden, "Don Sebastian" ;- FUDGE2::.WORD RESUM ;Pointer to completion routine ;>>>$Rel .-2 RESUM RMON .WORD C.TWAI ;Identifying number for XM and FB T$WAIT: MOV (PC)+,R1 ;Point to completion routine FUDGE1:: .WORD FUDGE2 ;Address of completion routine pointer ;>>>$Rel .-2 FUDGE2 RMON CALL MARKTM ;Do a mark time for the interval .BR S$SPND ;And suspend the guy ............ .ENDC ;NE TIME$R .SBTTL .SPND - Suspend Job EMT S$SPND: .IF EQ SB MOV CNTXT,R1 ;Copy impure pointer DEC I.SCTR(R1) ;Suspend him BVC 60$ ;Too much suspense? INC I.SCTR(R1) ;Yes, just stick at max 60$: BPL RTILK0 ;Not suspended yet, leave .ASSUME I.STAT EQ 0 TST @R1 ;Is he in completion routine? BMI RTILK0 ;Yes, he can't be suspended here JSR R4,$SYSWT ;No, wait till we are resumed (suspend-cnt>=0) .WORD SPND$ MOV I.SCTR(R1),R0 ;; Get suspend count .IFF ;EQ SB DEC I.SCTR+BKGND ;Suspend him BVC 60$ ;Too much suspense? INC I.SCTR+BKGND ;Yes, just stick at max 60$: BPL RTILK0 ;Not suspended yet, leave TST I.STAT+BKGND ;Is he in completion routine? BMI RTILK0 ;Yes, he can't be suspended here JSR R4,$SYSWT ;No, wait till we are resumed (suspend-cnt>=0) .WORD SPND$ MOV I.SCTR+BKGND,R0 ;; Get suspend count .ENDC ;EQ SB ASL R0 ;; If suspend-count < 0, still blocked CALL @(SP)+ ;; Coroutine return for blocking check BR RTILK0 ;Done ............ RESUM: ;Completion type resume .IF EQ SB MOV CNTXT,R0 ; (-> impure area) INC I.SCTR(R0) ; to restart job suspended from timed wait BVC 70$ ;Resume' too long? DEC I.SCTR(R0) ;Trim it back .IFF ;EQ SB INC I.SCTR+BKGND ; to restart job suspended from timed wait BVC 70$ ;Resume' too long? DEC I.SCTR+BKGND ;Trim it back .ENDC ;EQ SB 70$: RETURN ............ .SBTTL .RSUM - Resume Job EMT R$SUME: CALL RESUM ;Resume him (note: we are in compl routine & BR RTILK0 ; running, no need to change dispatchability) ............ .IF NE TIME$R .SBTTL .MRKT - Mark Time EMT M$RKT: CALL MARKTM ;Call mark time BR RTILK0 ;Exit EMT when done ............ .ENDC ;NE TIME$R ;+ ; When any of these entry points are taken in the mapped monitor, ; R0 contains a pointer to the first argument and is mapped via PAR1 ; to the user EMT argument block. @SP contains the original contents ; of R0, which is the User Virtual Address of the EMT argument list. ;- .IF EQ SB .SBTTL .CNTXSW - Specify Context Switched Locations EMT S$SWAP: .IF NE MMG$T BIT (R5)+,(R5)+ ;In XM, I.SWAP = I.SPSV+2 BIT #,I.STAT-4(R5) ;Virtual tasks don't have ... BNE 80$ ; ... swap lists .IFF ;NE MMG$T TST (R5)+ ;I.SWAP = I.FPP + 2 .ENDC ;NE MMG$T TST @R0 ;R0 -> list, is it null? BNE 90$ ;No 80$: CLR @SP ;Yes, nullify pointer 90$: TST @SP ;Is pointer null? BEQ 150$ ;Yes, set it up 100$: MOV (R0)+,-(SP) ;Check a pointer CMP #,@SP ;Is pointer a vector? BHI 110$ ;Yes, it won't be in his area CMP (PC)+,@SP ;Well, is it in the I/O page? M$SV11:: .WORD KW$28 ;**BOOT** Update in case of MSV11 BLOS 110$ ;Yes, allow that, too ;I&D+ ; Check ?????????? ;I&D- JSR R5,CHKSPU ;No, it must be in his area CLR @SP ;Signal error ...... 110$: ASR (SP)+ ;Error or odd address? BLOS ER0EMT ;Yes TST @R0 ;End of list? BNE 100$ ;No .ENDC ;EQ SB .IF EQ FPU$11 .BR 150$ ;Go stuff I.SWAP ............ .IFF ;EQ FPU$11 BR 150$ ;Go stuff I.SWAP ............ .SBTTL .SFPA - Set FPU Exception Address EMT S$FPP: CMP #<1>,R0 ;Set FPP switch but no trap? BHIS 150$ ;Yes ;I&D+ .IF NE SUP$Y CMP #<3>,R0 ;Special clear supy FPP exception routine? BNE 120$ ;Branch if not CLR @SP ;Yes -- prepare to clear I.FPPS offset BR 130$ ;Join supy FPP common code ............ 120$: .ENDC ;NE SUP$Y ; Check user/supy (even/odd) mode I-space address ;I&D- JSR R5,CHKSPI ;No, check interrupt address BR ER0EMT ;Invalid address ...... ;I&D+ .IF NE SUP$Y ASR @SP ;Is this a supy FPP exception routine? BCC 140$ ;Branch if user mode instead 130$: ADD #,R5 ;Point to supy offset instead of user 140$: ASL @SP ;Make good even address .ENDC ;NE SUP$Y ;I&D- .ENDC ;EQ FPU$11 150$: .IF NE FPU$11 TST (R5)+ ;I.FPP = I.TRAP + 2 .ENDC ;NE FPU$11 .IF NE SUP$Y BR 170$ ;Go to common code .IFF ;NE SUP$Y .BR 170$ ;Fall into common code .ENDC ;NE SUP$Y ............ .SBTTL .TRPSET - Set TRAP To 4/10 Intercept EMT ;I&D+ .IF NE SUP$Y ERRARI: JMP ERRARG ;Issue invalid address error .ENDC ;NE SUP$Y ;I&D- S$TRAP: ;I&D+ .IF NE SUP$Y ; Check user/supy (even/odd) mode I-space address JSR R5,CHKSPI ;Check trap routine address BR ERRARI ;Invalid address ...... ASR @SP ;Is this a supervisor trap4/10 routine? BCC 160$ ;Branch if user mode instead ADD #,R5 ;Point to supy offset instead of user 160$: ASL @SP ;Make good even address .ENDC ;NE SUP$Y ;I&D- 170$: TST (R5)+ ;I.TRAP = I.SPLS + 2 180$: ADD #,R5 ;Point to word to be filled 190$: MOV @SP,@R5 ;Yes, plug word in impure area .IF NE SB S$SWAP: .ENDC ;NE SB .IF EQ FPU$11 S$FPP: .ENDC ;EQ FPU$11 RTILK0: CALLR EMTRTI ;And exit .............. .SBTTL .DEVICE - Set Program Termination Jam List EMT D$VICE: .IF NE MMG$T BIT #,@R5 ;Virtual jobs don't have BEQ 200$ ;Device lists CLR @SP ;So clear it out CLR R4 ; and ignore linked flag 200$: MOV @SP,R0 ;Get user virtual address of jam list .IF EQ SUP$Y CALL $USRPH ;Convert virtual address to physical .IFF ;EQ SUP$Y MOV #<<..CURR!..DSPA>/4>,R1 ;Get mode/space argument CALL $VIRPH ;Convert virtual address to physical .ENDC ;EQ SUP$Y BCS ER0EMT ;Error if above 28kw boundary .ENDC ;NE MMG$T TSTB R4 ;Linked .DEVICE? BEQ 180$ ;No MOV @SP,R0 ;Copy -> new node MOV I.DEVL(R5),@R0 ;Insert node at front of list MOV R0,I.DEVL(R5) ; BR RTILK4 .............. .SBTTL .SCCA - Set CTRL/C AST EMT S$CCA: ;I&D+ .IF NE SUP$Y ; Check user/supy (even/odd) mode D-space address JSR R5,CHKSPD ;Check status word BR ERRARI ;Invalid address ...... .ENDC ;NE SUP$Y ;I&D- .IF EQ MMG$T MOV I.SCCA(R5),R0 ;Save the old SCCA address. .IF NE SCCA$G .IF EQ SB TST JOBNUM ;Is this the BG job? BNE 220$ ;No, then global SCCA not valid. .ENDC ;EQ SB TST R4 ;Is this a global setting? BEQ 220$ ;Branch if not CLR R0 ;Set old value for return BITB #,INDSTA ;Was it on before? BEQ 210$ ;Branch if not MOV PC,R0 ;Set old value on for return 210$: BICB #,INDSTA ;Assume we're turning global off TST @SP ;Check address BEQ 230$ ;Global is being turned off BISB #,INDSTA ;Turn global on BR 230$ ;Don't change I.SCCA if global setting ............ .ENDC ;NE SCCA$G 220$: MOV @SP,I.SCCA(R5) ;Put AST address in header. 230$: MOV R0,@SP ;Return old addr in user's R0. .IFF ;EQ MMG$T ;+ ; NOTE: this is really a value that should be in the IMPURE area, move it ; and recode for V5.1 ;- JSR R1,240$ ;Save R1, point to table, skip table SCCATB:: .WORD <.-.> ;BG old SCCA value (16 bit) .REPT FJOBS .WORD <.-.> ;FG old SCCA value (16 bit) .ENDR ............ 240$: .IF NE SCCA$G .IF EQ SB TST JOBNUM ;Is this the background job? BNE 260$ ;No, then global .SCCA not valid .ENDC ;EQ SB TST R4 ;Is this a global setting? BEQ 260$ ;Branch if not CLR 2(SP) ;Save old value for return BITB #,INDSTA ;Was it on before? BEQ 250$ ;Branch if not INC 2(SP) 250$: TST (SP)+ ;Pop R1 off stack BICB #,INDSTA ;Assume we're turning Global off TST R0 ;Check address BEQ 270$ ;We're turning global off BISB #,INDSTA ;Turn global on BR 270$ ;Don't change I.SCCA if global setting ............ .ENDC ;NE SCCA$G 260$: .IF EQ SB ADD JOBNUM,R1 ;Point to entry for this job .ENDC ;EQ SB MOV @R1,2(SP) ;Return old value in R0 (@SP at exit) MOV R0,@R1 ;Store new value into table MOV (SP)+,R1 ;Restore R1 and align stack MOV R0,I.SCCA(R5) ;Put in impure area too BEQ RTILK4 ;Zero address, disable inhibit CALL $RELOC ;Convert to PAR1 bias/displ MOV R2,I.SCCA(R5) ;Store displacement ... MOV R1,I.SCC1(R5) ; ... and PAR1 bias .ENDC ;EQ MMG$T 270$: BR RTILK4 ;Return .............. .DSABL LSB .SBTTL .TTYOUT - Terminal Output EMT ;+ ; EMT 16(1) - .TTYOUT ;- T$TOUT: .IF EQ MTT$Y MOV R0,R4 JSR R0,TTOUT ;Output the character, wait if need be .WORD TCBIT$ ;Don't wait if TCBIT$ is set .IFF ;EQ MTT$Y MOV I.CNSL(R5),R3 ;R3 -> TCB of console JSR R1,MTTPUT ;Output the char .WORD TCBIT$ ;Don't wait if TCBIT$ is set .ENDC ;EQ MTT$Y BCC RTILK4 ;Got it out (or TCBIT$ was clear) ER0EMT: EMTER0 ;Set C bit in status BR RTILK4 ;Say goodbye .............. .SBTTL .TTYIN - Terminal Input EMT ;+ ; EMT 16(0) - .TTYIN ;- .ENABL LSB T$TIN:: .IF EQ MTT$Y MOV R5,R2 ;Copy to call IGET MOV R5,R1 ;We need copies later on ADD #,R1 ;R1 -> line count CALL TTRSET ;Copy special-mode bit, etc. TST @R1 ;Is count=0? BNE 10$ ;No, we can give him stuff BIT #,@#$JSW ;Does he really want C-bit return? BNE ER0EMT ;Yes JSR R4,$SYSWT ;No, wait for terminal input available .WORD TTIWT$ CMP @R1,#<1> ;; Do we have a character yet? CALL @(SP)+ ;; Coroutine return for blocking check 10$: CALL IGET ;Get a character from the ring BNE 20$ ;BR if not CTRL/C TST I.SCCA(R5) ;Is CTRL/C inhibit enabled? BEQ 40$ ;BR if not, do an exit 20$: MOV R4,@SP ;Give it to him in R0 .IFF ;EQ MTT$Y MOV I.CNSL(R5),R3 ;R3 -> TCB of console CALL MTTIN ;Get a character BCS ER0EMT ;No character available, give error 0 BNE 30$ ;Got character, not CTRL/C TST I.SCCA(R5) ;Got CTRL/C, is CTRL/C intercept enabled? BEQ 40$ ;No, abort job 30$: MOV R0,@SP ;Yes, return char to the job .ENDC ;EQ MTT$Y RTILK4: BR EMTRTI ;And leave .............. 40$: .IF EQ SB TST I.JNUM(R5) ;Which job? BNE 50$ ;Foreground or System, no DCL/@File .ENDC ;EQ SB BIS #,STATWD ;Background, abort any DCL/@File 50$: MOV R4,R0 ;Make R0 non 0 GOEXIT::MOV #,R4 ;Exit via table in case of BATCH CALLR EMT16 ;Dispatch an EXIT ............ .DSABL LSB .IF NE SUP$Y SETPMD: MOV (SP),R1 ;Get caller's stacked PS (+2 for ret addr) ASR R1 ;Get current mode bits to ASR R1 ; location of previous mode bits BIC #,@#PS ;Clear out previous mode bits in PS BIC #^c,R1 ;Was caller in Kernel mode? BEQ 10$ ;Yes, return with Z-bit set BIS R1,@#PS ;Make sure we use previous space (Z-bit clear) 10$: RETURN COPYSC: MOV #<$SYCOM>,R1 ;Update user $SYCOM area 10$: PUT @R1,(R1)+ ;Move a value to user space CMP R1,#<$SYPTR> ;Done? BLO 10$ ;BR if more RETURN .ENDC ;NE SUP$Y .SBTTL EMTDON - Return From EMT ;+ ; Come here to return from an EMT which took arguments on the stack ; If it is an old style EMT, we pop off the args ;- .ENABL LSB EMTDON::ASL R2 ;Convert word count to bytes BEQ EMTRTI ;None to pop MOV OLDPC(SP),R3 ;Point to the EMT that called us .IF EQ MMG$T CMP #,-(R3) ;Is it new style? .IFF ;EQ MMG$T GET -(R3),-(SP),I ;Get EMT code CMP #,(SP)+ ;Is it new style .ENDC ;EQ MMG$T BLOS EMTRTI ;Yes, no pop .IF NE MMG$T .IF NE SUP$Y CALL SETPMD ;Set prev mode from OLDPS's current mode .IFF ;NE SUP$Y BIT #,OLDPS(SP) ;Was caller in Kernel mode? .ENDC ;NE SUP$Y BNE 20$ ;Branch if not called from kernel mode .ENDC ;NE MMG$T ;+ ; Old style EMTs have arguments pushed on stack. In mapped ; monitor, these arguments go on the User Stack if the EMT was ; issued from a user job, and on the Kernel Stack if issued from ; Kernel mode, e.g., the USR. In either case the interrupt goes on ; the Kernel Stack. ;- MOV SP,R3 ;No, point R3 above Regs, PC, PS ADD #,R3 ;Point R3 at the EMT's arguments ADD R3,R2 ;Point R2 above where it should go 10$: MOV -(R3),-(R2) ;Move a word CMP R3,SP ;Done yet? BHI 10$ ;No MOV R2,SP ;Yes, reset stack pointer .IF NE MMG$T BR EMTRTI ;Finish up .............. 20$: .IF EQ SUP$Y BIS #,@#PS ;Make sure we use user space .ENDC ;EQ SUP$Y GET SP,-(SP) ;Get user stack pointer ADD R2,@SP ;Pop past arguments PUT (SP)+,SP ;Restore user stack .ENDC ;NE MMG$T .BR EMTRTI ............ .DSABL LSB ;+ ; Come here if there is no popping to be done ;- .ENABL LSB .IF EQ MMG$T P$LAS: ;Ignore PLAS requests if not XM .ENDC ;EQ MMG$T .IF EQ SUP$Y C$MAP: ;Ignore .CMAP class requests if not ZB nor ZM .ENDC ;EQ SUP$Y .IF EQ MTT$Y M$TTIO: ;Ignore MTTY requests if no MTTY .ENDC ;EQ MTT$Y .IF EQ SPC$PS S$PCPS: ;Ignore .SPCPS if not supported. .ENDC ;EQ SPC$PS EMTRTI:: .IF NE MMG$T .IF NE SUP$Y CALL SETPMD ;Set prev mode from OLDPS's current mode BEQ 20$ ;Branch if kernel -- leave $SYCOM alone CALL COPYSC ;Copy SYSCOM BIS #,@#PS ;Make sure we use user space CALL COPYSC ;Copy SYSCOM .IFF ;NE SUP$Y BIT #,OLDPS(SP) ;Was caller in Kernel mode? BEQ 20$ ;Yes, leave $SYCOM alone BIS #,@#PS ;Make sure we use user space MOV #<$SYCOM>,R1 ;Update user $SYCOM area 10$: PUT @R1,(R1)+ ;Move a value to user space CMP R1,#<$SYPTR> ;Done? BLO 10$ ;BR if more .ENDC ;NE SUP$Y 20$: .ENDC ;NE MMG$T MOV (SP)+,R0 ;Restore all regs .IF NE MMG$T MOV (SP)+,@#KISAR1 ;Restore Kernel PAR1 .ENDC ;NE MMG$T MOV (SP)+,R1 MOV (SP)+,R2 MOV (SP)+,R3 .IF NE SPC$PS MOV CNTXT,R5 ;Point to current context DEC I.ECTR(R5) ;Count down EMT depth BNE 30$ ;Not out of the monitor yet MOV I.SPCP(R5),R4 ;Point to user's derail block address BEQ 30$ ;None, just return TST @R5 ;Returning to completion code? BMI 30$ ;Yes, don't derail yet .IF EQ MMG$T MOV 6(SP),@R4 ;Give him old main line PS MOV 4(SP),-(R4) ; and PC MOV -(R4),4(SP) ;Set new main line PC .IFF ;EQ MMG$T MOV @#KISAR1,-(SP) ;Save Kernel PAR1 MOV I.SPC1(R5),@#KISAR1 ; and point to user's block MOV 10(SP),@R4 ;Give him old main line PS MOV 6(SP),-(R4) ; and PC MOV -(R4),6(SP) ;Set new main line PC MOV (SP)+,@#KISAR1 ;Restore Kernel PAR1 .ENDC ;EQ MMG$T SPL 7 ;Up to PR7 to avoid synchronization bug CLR I.SPCP(R5) ;;; Say that the dispatch is done 30$: .ENDC ;NE SPC$PS ;+ ; RTICML (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; CALLR $RTIC ; ; The $RTCI routine is located in the RTEM-11 linkage ; routines. This hook allows RTEM-11 to correctly ; enable AST recognition before returning, using the ; RTI instruction. ;- RTICML::CALLR RTICMN ;;; Restore R4-R5 and exit EMT ............ ;;; (*** RTEM-11 HOOK ***) .DSABL LSB .SBTTL .SETTOP - Set Top Of Memory In Use EMT ;+ ; EMT 16(12) - Set top of memory ; Attempt to make the given address the job's new high core limit. ; If the number is valid, and the job is the background, ; it is determined whether or not USR swapping will be required. ;- .ENABL LSB S$ETOP: .IF NE MMG$T CLR -(SP) ;Assume no bias necessary MOV CNTXT,R4 ;R4 -> Job's impure area .ENDC ;NE MMG$T ;+ ; (*** DBGEXE *** Following section modified for DBGEXE support.) ;- .IF NE MMG$T BIT #,@R4 ;Is this a purely virtual job? BEQ 20$ ;Branch if not CMP R0,I.VSTP(R4) ;Request : high limit BLOS 20$ ;Ok to do the .SETTOP MOV I.VSTP(R4),R0 ;No, reset to high limit 20$: .ENDC ;NE MMG$T .IF EQ SB MOV JOBNUM,R2 ;Point to limit tables .ENDC ;EQ SB .IF NE MMG$T JMP XMSTOP ;Go do special XM SETTOP code S$ERT1:: .ENDC ;NE MMG$T .IF EQ SB ASL R2 .ADDR #<$JBLIM+2>,R2,ADD ;R2 -> low limit ;>>>$REL .IFF ;EQ SB .ADDR #<$JBLIM+2>,R2 ;R2 -> low limit ;>>>$REL .ENDC ;EQ SB CMP R0,@R2 ;Request : low limit BHIS 10$ ;Ok MOV @R2,R0 ;No, reset to low limit 10$: CMP R0,-(R2) ;Request : high limit BLO S$EPRV ;Ok MOV @R2,R0 ;No, reset to high limit 30$: TST -(R0) ;Compute high limit - 2 S$EPRV:: .IF EQ SB TST JOBNUM ;Is this the background? BNE S$ERTN ;No, then it's easy CALL ENQUSR ;Own the USR to change SWAPability .IFF ;EQ SB CLRB USROWN ;Own the USR to change SWAPability .ENDC ;EQ SB CLR USRSWP ;Guess at NO USR SWAPping ;+ ; This is a temporary patch until S$ETOP can be rewritten. S$ETOP uses ; a virtual job's program high limit in the following checks when it ; should convert that high limit to a physical address (i.e. add 500) ;- .IF NE MMG$T CLR KMLOC ;Always kill KMON (temporary fix) CMP R0,$KMLOC ;Killing KMON? BLO 50$ ;No, obviously not USR, either .IFF ;NE MMG$T CMP R0,$KMLOC ;Killing KMON? BLO 50$ ;No, obviously not USR, either CLR KMLOC ;Yes, KMON non-resident .ENDC ;NE MMG$T CMP R0,$USRLC ;Killing USR? BLO 50$ ;No BIT #,CONFIG ;Are we forbidden to SWAP the USR? BEQ 40$ ;No, do it MOV $USRLC,R0 ;Yes, point to the USR BR 30$ ;And decrement by 2 ........... 40$: CLR USRLOC ;It is non-resident MOV SP,USRSWP ;Set the USR-is-SWAPping flag 50$: TSTB USRLVL ;Did he own the USR before that ENQ? BNE S$ERTN ;Yes, retain possession CALL DEQUSR ;Disown USR S$ERTN:: .IF NE MMG$T SUB (SP)+,R0 ;Convert Kernel compatible to user address .ENDC ;NE MMG$T MOV R0,@SP ;Return R0=top MOV R0,@#$USRTO ;And location 50 RTILK3: BR EMTRTI .............. .DSABL LSB .SBTTL .RCTRLO - Reset CTRL/O EMT ;+ ; EMT 16(13) - Cancel Control O ;- R$CTLO: CLRB I.OCTR+1(R5) ;Clear flag byte .IF NE MTT$Y MOV I.CNSL(R5),R3 ;R3 -> console TCB .ENDC ;NE MTT$Y ;+ ; RCTHOK (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; CALL $RSCT ; ; The $RSCT routine is located in the RTEM-11 linkage ; routines. This hook allows RTEM-11 to correctly ; reset CTRL/O under RTEM-11. ;- RCTHOK:: ;(*** RTEM-11 HOOK ***) CALL TTRSET ;Copy special-mode flag BR RTILK3 .............. .SBTTL .PRINT - Print String EMT ;+ ; EMT 16(9) - String Print ;- .ENABL LSB P$RINT: .IF NE MMG$T! CALL PRINTR ;Call print subroutine BR RTILK3 ;Done ............ .ENDC ;NE MMG$T! PRINTR:: .IF EQ MTT$Y .IF EQ SB MOVB #,OUTCHR ;Force console context switch .ENDC ;EQ SB .IF NE MMG$T BIT #,@#PS ;Caller in Kernel mode? BEQ 10$ ;Yes, don't remap CALL $RELOM ;Point R0 at buffer 10$: .ENDC ;NE MMG$T 20$: MOVB (R0)+,R4 ;Character to R4 BEQ 30$ ;0=> put in CRLF CMP R4,#<177600> ;200 ends it all .IF EQ MMG$T! BEQ EMTRTI ;(other negatives are ok) .IFF ;EQ MMG$T! BEQ 40$ ;Done .ENDC ;EQ MMG$T! JSR R0,TTOUT ;Put out the character .WORD 0 ;Wait even if TCBIT$ is on BR 20$ ;Try again on return ............ 30$: .ADDR #<50$>,R0 ;Point to CRLF ;>>>$REL BR 20$ ;Print another character ............ .IFF ;EQ MTT$Y MOV I.CNSL(R5),R3 ;R3 -> console TCB .IF EQ SB MOVB #,T.OCHR(R3) ;Force console context switch .ENDC ;EQ SB .IF NE MMG$T BIT #,@#PS ;Caller in Kernel mode? BEQ 10$ ;Yes, don't map CALL $RELOM ;No, map to char string 10$: .ENDC ;NE MMG$T MOV R0,R1 ;Copy pointer to string 20$: MOVB (R1)+,R0 ;Get a character BEQ 30$ ;End, print CR/LF CMP R0,#<177600> ;200 code? .IF EQ MMG$T! BEQ EMTRTI ;Done .IFF ;EQ MMG$T! BEQ 40$ ;Done .ENDC ;EQ MMG$T! JSR R1,MTTPUT ;Put char in output ring .WORD 0 ;Wait even if TCBIT$ is set BR 20$ ;Try next character ............ 30$: .ADDR #<50$>,R1 ;Point to CR/LF ;>>>$REL BR 20$ ;And print them ............ .ENDC ;EQ MTT$Y .IF NE MMG$T! 40$: RETURN ...... .ENDC ;NE MMG$T! 50$: .ASCII <200> ;CR LF terminator .EVEN .DSABL LSB .IF EQ SB .SBTTL .TLOCK - Test And Lock USR EMT ;+ ; EMT 16(6) - Lock USR in core ; If a job needs the USR for a series of I/O type operations, ; it can lock it into core with the LOCK EMT. ; Entering at TLOCK sets the Carry if the USR is not free, ; rather than waiting for it and claiming it. ;- .ENABL LSB T$LOCK: ENSYS 20$ ;Enter System State CMPB #<377>,USROWN ;; Is the USR free? BNE 10$ ;; No, Exit System State MOVB JOBNUM,USROWN ;; Yes, claim it 10$: RETURN ;; Back to user ............ 20$: CMPB JOBNUM,USROWN ;Do we own it now? BEQ L$OCK ;Yes, lock the USR .BR EMT0ER ............ .DSABL LSB .ENDC ;EQ SB EMT0ER: EMTER0 ;No, return a Carry RTILK2: BR RTILK3 ;And return ............ .SBTTL .LOCK - Lock USR EMT .IF NE SB T$LOCK: .ENDC ;NE SB L$OCK: CALL CALUSR ;Read monitor in BR RTILK3 ............ .SBTTL .UNLOCK - Unlock USR EMT ;+ ; EMT 16(7) - Release USR from core ; After a LOCK, this EMT releases the USR. ; It also is the entry point for USR return. ;- .ENABL LSB U$NLOK: .IF EQ SB CMPB USROWN,JOBNUM ;Do we own the USR? BNE RTILK3 ;No, we have no right to unlock it .ENDC ;EQ SB TSTB USRLVL ;We own it, did we lock it? BEQ 10$ ;No, it's not called MONOUT::BIC #,@CNTXT ;Turn on address checking again DECB USRLVL ;Up a level BNE 20$ ;USR called self, leave it in core 10$: CALL RIDUSR ;Out of USR, get rid of it 20$: CALLR EMTDON ;And exit ............ .DSABL LSB .SBTTL EMT17 - Internal Error EMT (Set C bit, $ERRBY) ;+ ; EMT 17--Used for internal purposes only. Should not be ; called by the user. Moves an error code into location ; set aside for the code, and turns the C bit on in the ; offending EMT's status. ;- EMT17: ASR R4 ;Need number between 0-17 MOVB R4,@#$ERRBY ;Set the error code BIS #,ERRPS(SP) ;C=1 to flag error BR RTILK2 ............ .SBTTL .SERR - Set Soft Monitor Errors EMT ;+ ; .SERR indicates that no monitor fatal errors are to be reported ;- S$ERR: INC R2 ;R2 was 0 from EMTPRO .BR H$ERR ;Fall into hard error code ............ .SBTTL .HERR - Disable Soft Monitor Errors EMT ;+ ; .HERR indicates that hard monitor errors are to be reported ;- H$ERR: CLR @SP ;Clear top of stack MOVB I.SERR(R5),@SP ;Return R0 = old flag value MOVB R2,I.SERR(R5) ;Put the value into flag RTILK1: BR RTILK2 ............ .SBTTL .DATE, .GVAL, .PVAL, .POKE, and .PEEK EMT's ;+ ; D$ATE ; Date EMT gets the date fixed offset and goes to the GVAL routine to return ; the date in R0. Uses subcode 0 for GVAL (in R4)> ; ; Note: ; o Calls UPDDAT routine first to ensure date has been updated ; ;- ;+ ; D$ATE (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; CALL $GTDA ; ; The $GTDA routine is located in the RTEM-11 linkage ; routines. This hook allows RTEM-11 to correctly ; obtain the date in the emulated enviornment, as the ; clock never ticks under RTEM-11. ;- .ENABL LSB D$ATE:: ;(*** RTEM-11 HOOK ***) MOV #,R0 ;Get fixed offset date word .IF NE TIME$R CALL UPDDAT ;*R0* Ensure date word is up-to-date ;Note: routine is coded in USR, but ; resides in RMON .ENDC ;NE TIME$R CLR R4 ;Clear R4 for 0 subcode (GVAL) BR 20$ ;Treat as normal GVAL operation ............ .Rem % >>>consider this new code (RTEM implications) (SHOULD D$ATE BE GLOBAL??) D$ATE: MOV DATES,@SP ;Return current date value BR RTILK2 ;Return % ;+ ; G$VAL ; This is a common entry point for GVAL, PVAL, POKE, and PEEK requests. ; Each EMT has a subcode which upon entry is in R4 (subcode*2). ; ; Subcodes (after first ASR): ; ; .GVAL -> 0 Obtain a monitor fixed offset value and return it in R0. ; .PEEK -> 1 Obtain the contents of a given location and return it ; in R0. ; .PVAL -> 2 Obtain a monitor fixed offset value and load a new value ; into that location. The old value is returned in R0. ; .POKE -> 3 Obtain the contents of a given location and load a new ; value into that location. The old value is returned in R0. ; .PVAL/BIC -> 4 BIC the value into a monitor offset. The old value is ; returned in R0. ; .POKE/BIC -> 5 BIC the value into a given location. The old value is ; returned in R0 ; .PVAL/BIS -> 6 BIS the value into a monitor offset. The old value is ; returned in R0. ; .POKE/BIS -> 7 BIS the value into a given location. The old value is ; returned in R0 ; ; INPUTS: ; R0 Address to read / modify ; @R1 Value to mov / bic / bis (for PVAL, POKE) ; R4 "channel" * 2 ; R5 non-zero ; ; OUTPUTS: ; @SP old contents of address ; R1 random ; R4 random ; R5 random ; ; ERRORS: ; ; 0 invalid offset (offset too high) .GVAL and .PVAL[/BI{C|S}] ; 1 invalid address (odd or NXM) all requests. ; This is detected by TRAP4 routine and derails to EMT1ER if ; the T4LOW <= PC <= T4HIGH. ; ; SPECIAL CASE: ; ; If the PS address is referenced (177776), then the copy of ; the PS on the stack (for the RTI) will be modified. If the ; PS is referenced then the CMODE and TRACE (140020) bits will ; NOT be changed. ; ; NOTE: since EMT service code is executed at PR0 this .POKE ; of the PS address should not be used to alter the priority ; if dropping to PR0 in the interim is not acceptable. ; ; SPECIAL CASE FOR MAPPED MONITORS (MMG$T = 1): ; ; If the KISAR1 address is referenced (172342), then the copy ; of KISAR1 on the stack is used instead. This is because it ; is saved and restored during EMT processing. ;- ;+ ; The following is a brief description of how the individual bits ; of the subcode values are interpreted: ; ; subcodes | bit interpretations ; | ; ..GVAL = ^b000 | ; ..PEEK = ^b001 | aa0 add in $SYPTR ; ..PVAL = ^b010 | aa1 use address as is ; ..POKE = ^b011 | 00b read ; ..BICV = ^b100 | 01b write (mov) ; ..BICO = ^b101 | 10b write (bic) ; ..BISV = ^b110 | 11b write (bis) ; ..BISO = ^b111 | ;- G$VAL:: CMP #<..BISO*2>,R4 ;Valid subcode? BLO 100$ ;No, give error ASR R4 ;Divide to get true subcode ASR R4 ;Carry indicates PEEK/POKE/GVAL/PVAL BCS 30$ ;Use address as is 10$: CMP R0,# ;Is the offset too big? BHIS EMT0ER ;Error 0 if out of range VOMIT ==: .+2 ;Dump this when $Rel done 20$: ADD #<$RMON>,R0 ;Point R0 to $RMON + offset ;>>>$Rel .-2 $RMON RMON ;Drop thru is ok if RMON isn't overlapping PS 30$: .IF NE MMG$T MOV #,R3 ;Assume we're referencing KISAR1 CMP R0,# ;KISAR1 reference? BEQ 40$ ;Branch if yes MOV #,R3 ;Assume we're referencing PS CMP R0,# ;PS reference? BNE 50$ ;Branch if not CLR R5 ;Indicate special operation (on PS) 40$: ADD SP,R3 ;Point to replacement reference ... MOV R3,R0 ; ... and use it, not the real one .IFF ;NE MMG$T CMP R0,# ;PS reference? BNE 50$ ;No CLR R5 ;Indicate special operation (on PS) MOV SP,R0 ;Point to old PS on stack ... ADD #,R0 ; ... and use it, not the real one .ENDC ;NE MMG$T 50$: T4LOW: MOV @R0,@SP ;Return (offset) value in R0 *TRAP?* ASR R4 ;If bit set, update contents in R0 BNE 60$ ;BIC/BIS operation BCC 80$ ;Join common code (no update) MOV @R1,@R0 ;Put new contents into address *TRAP?* BR 80$ ;Join common code ........... 60$: BCC 70$ ;BIC operation BIS @R1,@R0 ;BIS in value *TRAP?* BR 80$ ;Join common code ........... 70$: BIC @R1,@R0 ;BIC using value mask *TRAP?* .BR 80$ ........... 80$: ;;; NOP ;Give J11 time to notice any trap TST R5 ;Doing PS? T4HIGH: BNE 90$ ;No BIC #,@R0 ;Clear CMODE & TRACE in "new" PS MOV @SP,R1 ;Get "old" PS BIC #^c,R1 ;Clear all but CMODE & TRACE in "old" PS BIS R1,@R0 ;Force old CMODE and TRACE into "new" PS 90$: BR RTILK2 ;Return .............. 100$: CALLR TOOBIG ;Illegal EMT .............. .DSABL LSB .SBTTL .SRESET - Soft Reset EMT ;+ ; EMT 16(10) - Soft Reset ; Soft Reset clears all channels (except 17 if overlaying is on) ; It then falls into QRESET, which resets the I/O queue to ; one element. ; For the background, any non-LOADed handlers are purged ;- .ENABL LSB S$RSET: CALL QUIESCE ;Quiesce I/O CALL REVERT ;Revert channels, ... ; ... reset queue, release handlers BR 10$ ;Join common .HRSET/.SRSET code HRSET1: CALL REVRT1 ;Revert channels, reset queue, release ; handlers (but don't do IORSET again) 10$: MOV I.CSW(R3),R1 ;Point to channels MOV #,R0 ;Original 16 channels, 5 wds each BIT #,@#$JSW ;Overlaid? BEQ 20$ ;Nyet SUB #,R0 ;Da, reducing count 20$: CLR (R1)+ ;Zap SOB R0,20$ ;Rezap, zip... RTILK9: BR RTILK2 ;Zoop ............ .DSABL LSB ;+ ; The following subroutine waits for all I/O to stop ;- QUIESCE::MOV CNTXT,R3 ;Get impure pointer JSR R4,$SYSWT ;Wait for all I/O to complete .WORD EXIT$ MOV I.IOCT(R3),-(SP) ;; Set C if I/O count non-zero NEG (SP)+ ;; ;>>> CALLR @(SP)+ ;substitute for next two instructions CALL @(SP)+ ;; Coroutine return for blocking check RETURN ............ .SBTTL EMT16 - EMT 16 Subcode Dispatcher EMT16: TST (R4)+ ;R4 has subcode to dispatch ADD PC,R4 ;Add table address-2 (table is at .+2) ;>>>$REL? ADD @R4,PC ;Jump to table dispatch LST16:: .WORD < T$TIN - LST16 > ;Get a Character (0) .WORD < T$TOUT - LST16 > ;Put a Character (1) .WORD < D$STAT - LST16 > ;Device Status (2) .WORD < F$ETCH - LST16 > ;Fetch/Release (3) .WORD < C$SIGN - LST16 > ;General Mode CSI (4) .WORD < C$SISP - LST16 > ;Special Mode CSI (5) .WORD < L$OCK - LST16 > ;Lock USR (6) .WORD < U$NLOK - LST16 > ;Release USR (7) .WORD < E$XIT - LST16 > ;Exit Program (10) .WORD < P$RINT - LST16 > ;String Print (11) .WORD < S$RSET - LST16 > ;Soft Reset (12) .WORD < Q$SET - LST16 > ;Set I/O Queue (13) .WORD < S$ETOP - LST16 > ;Set Top of Core (14) .WORD < R$CTLO - LST16 > ;Reset ^O Bit (15) .IF NE MMG$T .WORD < A$STX - LST16 > ;Exit AST (16) .IFF ;NE MMG$T .WORD < E$XIT - LST16 > ;Treat as .EXIT .ENDC ;NE MMG$T .WORD < H$RSET - LST16 > ;Hard Reset (17) ;+ ; Special P$RINT for .GTLINE prompt required by SL under XM. ; ; NOTE: this subcode may be pushed down to make room for future EMT 16 ; subcodes provided that the change is reflected in the SL handler too. ; Also note that any changes to SL$E16 affect EL$E16 below and the ; EL error logger handler. ;- .IF NE MMG$T SL$E16: .WORD < PRINTR - LST16 > ;Make it appear as subcode (20) .ENDC ;NE MMG$T ;+ ; Special P$RINT for error logger handler (EL) under error logging SB/XB/ZB ; ; NOTE: this subcode may be pushed down to make room for future EMT 16 ; subcodes provided that the change is reflected in the EL handler too. ; Also, this subcode is dependent on SL$E16 existing only for MMG$T=1. ; If that is changed, EL LOAD code will need to be changed. ;- .IF NE ERL$G & SB EL$E16: .WORD < PRINTR - LST16 > ;Make it appear as ; subcode 20 for SB ; subcode 21 for XB/ZB .ENDC ;NE ERL$G & SB .SBTTL .CLOSE, .CLOSZ and .PURGE EMTs ;+ ; CLOSZ EMT ; If the channel is open on an RT-11 directory device, the highest ; block written is replaced by a passed in value, if the passed in ; value is less than or equal to the allocated size of the file. ; The operation then joins that of CLOSE. ; ; CLOSE EMT ; If no directory operation is required, the channel is dissociated, ; and we are done. If directory work is required, the USR is called. ;- .ENABL LSB .SBTTL .CLOSZ - CLOSE CHANNEL AND SET FILE SIZE EMT C$LOSZ: JSR R0,CHKSPL ;If special directory, go do it .WORD CLOZ.. ;Code value to use BEQ 10$ ;Branch if .CLOSZ is invalid CMP R0,C.LENG(R3) ;Trying to EXTEND RT-11 file? BHI 20$ ;Yes, can't do that MOV R0,C.USED(R3) ;Truncate (or full use), set last block used BR CLOS2 ;Join common code ............ 10$: EMTER2 ;Channel not opened with .ENTER BR PURGE ;Purge it ............ 20$: ASR R4 ;Get real channel number back $1 = ...V1 ;Save current setting ...V1 = 3. ;Choose reasonable (V3+ version) .CLOSE R4 ;Close the channel ...V1 = $1 ;Restore previous setting of version EMTER1 ;Error, trying to extend the file ;>>> Replace with BR RTILK9 ??? BR 30$ ;But close anyway ............ .SBTTL .CLOSE - CLOSE CHANNEL EMT C$LOSE: JSR R0,CHKSPL ;If special directory, go do it .WORD CLOS.. ;Code value to use BEQ PURGE ;No, just purge the channel CLOS2: CALLR C$LOS2 ............ .SBTTL .PURGE - PURGE CHANNEL EMT P$URGE: JSR R0,CHKSPL ;If special directory, go do it .WORD PURG.. ;Code value to use PURGE: CLR (R3)+ ;Dissociate channel 30$: BR RTILK9 ;Exit ............ .SBTTL CHKSPL - Service routine for CLOSZ, CLOSE and PURGE CHKSPL: ADD (R0)+,R2 ;Add special directory code to R2 ... ; ... assuming we're going to use it ... ; ... and point to next instruction MOV @R3,R5 ;Get CSW status word BIC #^c,R5 ;Isolate device index .ADDR #<$STAT>,R5,ADD ;R5 -> $STAT entry for this device (PICly) ;>>>$REL BIT @R5,# ;Is this a special device? BEQ 40$ ;If not, branch BIT #,@R3 ;Directory rewrite needed? BEQ 40$ ;No MOV (SP)+,R0 ;Restore register / align stack CALLR EMTUSR ;Go to special directory code ............ 40$: CLRB R2 ;Clear assumed special directory code ... ; ... not changing high bit (byte?) of word BIT #,@R3 ;Directory rewrite needed? RTS R0 ;Return ............ .DSABL LSB .SBTTL .ABTIO - Abort I/O On A Channel .ENABL LSB A$BTIO: MOV @R3,R2 ;R2 = channel status word. BPL RTILK9 ;Plus means channel isn't open. TSTB C.DEVQ(R3) ;Any I/O outstanding? BEQ RTILK9 ;No, then just exit. ;+ ; Run down the queue elements ;- ENSYS RTILK9 ;Enter System State, exit when done. .IF NE < MMG$T & XM$FET > ;If .FETCH in XB/XM CALL KPSAVE ;; Save and set default for PAR 1. .ENDC ;NE < MMG$T & XM$FET > ;+ ; Stack pointer to CSW of aborting channel and handler start ; address of handler that is referenced by the CSW ; of the aborting channel. ;- .ADDR #<$ENTRY>,R2 ;; R2 -> $ENTRY table ;>>>$REL MOV R3,-(SP) ;; Stack pointer to aborting channel MOV @R3,R3 ;; R3 = CSW BIC #^c,R3 ;; Isolate handler's DEVICE table index ADD R2,R3 ;; R3 -> Handler's entry address MOV @R3,-(SP) ;; Stack it ;+ ; Scan the device tables, calling IOQABT for all entries that ; have an XOR value of true for the ABTIO$ and HNDLR$ bits in the ; $STAT table and for the specific entry that is referenced by the ; CSW of the aborting channel. ;- 10$: MOV (R2)+,R3 ;; R3 = Handler entry address BEQ 10$ ;; Branch if handler not resident CMP #<-1>,R3 ;; At end of table? BEQ 50$ ;; Yes, branch to exit CMP R3,@SP ;; Same entry as on stack? BEQ 20$ ;; Yes, abort I/O for this channel & job MOV <$STAT-$ENTRY-2>(R2),-(SP) ;Abort I/O for this handler? BIC #^c,@SP ;If yes, one and only one bit is set BNE 15$ ;Branch if at least one is set TST (SP)+ ;Neither bit is set BR 10$ ;Go try next handler 15$: CMP #,(SP)+ ;Just one bit set? BEQ 10$ ;No, go try next handler ;+ ; Abort I/O for this channel and job. ;- 20$: MOV R2,-(SP) ;; Save R2 around CALL & stacked params TST -(R2) ;; R2 -> Handler's $ENTRY for IOQABT CLR -(SP) ;; Head of aborted queue element list CLR -(SP) ;; Tail of aborted queue element list MOV 10(SP),-(SP) ;; Save pointer to channel we're aborting on MOV #<100000>,-(SP) ;; Assume no elements will be aborted and ... ;; ... set sign bit as flag for IOQABT to ... ;; ... indicate that it was called from A$BTIO MOV R3,R0 ;; R0 -> handler's LQE TST (R3)+ ;; R3 -> handler's CQE CALL IOQABT ;; Abort all items in the queue. BIC #<100000>,@SP ;; Get count of elements aborted BEQ 40$ ;; If none were aborted, go clean up stack .IF EQ SB MOV CNTXT,R3 ;; R3 -> jobs impure area. SUB (SP)+,I.IOCT(R3) ;; Subtract the aborted from the total. .IFF ;EQ SB SUB (SP)+,I.IOCT+BKGND ;; Subtract the aborted from the total. .ENDC ;EQ SB .ASSUME I.QHDR EQ 2 CMP (SP)+,(R3)+ ;; R3 -> free queue element list (pop stack) SPL 7 ;; Must lock out for queue manipulation MOV @R3,@(SP)+ ;;; Link in aborted queue element list MOV (SP)+,@R3 ;;; at beginning of free list SPL 0 ;;; Now it's safe to be interrupted 30$: MOV (SP)+,R2 ;; Restore R2 BR 10$ ;; Go check next entry ............ ;+ ; Clean up stack, etc., and go back to try the next table entry ;- 40$: ADD #<4*2>,SP ;; None aborted, (discard the 4 stacked words) BR 30$ ;; Merge with common check next entry code ............ ;+ ; Done with ABORT. Restore User's PAR1 and stack. ;- 50$: CMP (SP)+,(SP)+ ;; Discard four stacked words .IF NE < MMG$T & XM$FET > ;If .FETCH in XB/XM CALL KPREST ;; Restore PAR 1 mapping. .ENDC ;NE < MMG$T & XM$FET > RETURN ;; Exit System State, return from EMT. ............ .DSABL LSB .SBTTL .CSIxxx - CSI Call EMTS ;+ ; Reenter here from USR if TT input and CSI error. Purge 0-8. if Special Mode ; ; WARNING*******WARNING*******WARNING ; This code is essentially duplicated in USR.MAC for the SB/XB versions. (???) ; If you change it here, change it there too. ;- .ENABL LSB C$SIGN::CLR R4 ;Clear the flag word .IF EQ SB MOV (PC)+,R0 ;Get a PURGE code for channel 8. .BYTE <8.>,<.PURGE> ;Channel 8., code 3=PURGE 10$: EMT ...PUR ;PURGE a channel DECB R0 ;More to kill? BGE 10$ ;Yes .ENDC ;EQ SB BR 20$ ;Enter the CSI ............ C$SISP: MOV #<100000>,R4 ;Set the flag word 20$: .IF EQ SB BIS #,@R5 ;Say that the CSI is running .ENDC ;EQ SB MOV #,R2 ;CSI number for EMTUSR .IF EQ SB MOVB JOBNUM,R3 ;Get job number. Are we the background? BEQ 30$ ;Yes, special GETLINE is ok BIS #,@#$JSW ;No, skip special .GTLIN code 30$: TST @R1 ;Is input string from the TTY? BEQ 40$ ;Yes, proceed CALLR EMTUSR ;Nyet, go doing things ............ .IFF ;EQ SB BR EMTUSR ;Nyet, go doing things ............ .IFT ;EQ SB 40$: INCB R4 ;If we don't own USR yet, enter it at de CMPB USROWN,R3 ;Do we own it? BNE 50$ ;No, use the level 1 INCB USRLVL ;Yes, CSI make USR level one deeper CSIERR::CLRB R4 ;Pick up USR level BISB USRLVL,R4 ; in low byte of R4 CALL RIDUSR ;Disown the USR while we collect a line .BR 50$ ............ 50$: .IF EQ MMG$T MOV SP,R1 ;Repoint to args on stack ADD #,R1 ;Point to third argument .IFF ;EQ MMG$T GET SP,R0 ;Get prev. mode SP -> arguments on stack CALL $RELOM ;Map to the arguments MOV R0,R1 ;Put addr in R1 CMP (R1)+,(R1)+ ;Point to third argument .ENDC ;EQ MMG$T MOV PC,R0 ;R0 -> asterisk for prompt ;>>>$REL? CMP (R0)+,(PC)+ .ASCII "*"<200> .IF NE MMG$T CLR (PC)+ ;Init to Kernel mode prompt print UKFLG: .WORD 0 ;Flag 0=Kernel or 1=User mode prompt print .ENDC ;NE MMG$T MOV @R1,(PC)+ ;Save third argument to use as flag word GTLFLG: .WORD 0 ;Used to determine if GTLINE later CMP @R1,#<3> ;Look at 3rd arg on stack-is this GTLINE? BHI 60$ ;No, use star prompt INC R0 ;.GTLIN, if no prompt given, use null TST -(R1) ;Did user give prompt? BEQ 60$ ;No, use the null prompt MOV @R1,R0 ;Point to user's prompt string .IF NE MMG$T INC UKFLG ;Flag that prompt is from user space .ENDC ;NE MMG$T 60$: MOV R0,-(SP) ;Save prompt string address 70$: CLR -(SP) TST JOBNUM ;Is this the background? BNE 150$ ;No, no special .GTLIN BIT #,@#$JSW ;Is this special .GTLIN/CSI? BNE 80$ ;Yes, CTRL/C is special TSTB STATWD ;No, did we get ^C on prior request? BMI 220$ ;If so, go to CSI now for abort 80$: BIT #,STATWD ;Are we to revert to TTY? BNE 150$ ;Yes, go do it MOV INBFPT,R0 ;No, any DCL/@File input? BEQ 150$ ;No, input is from TTY ;+ ; DCL/@File input ;- CMPB @R0,# ;At end of DCL/@File data? BEQ 140$ ;Yes, revert to TTY, go prompt and wait BIT #,@#$JSW ;No, special non-terminating CSI/GTLIN? BEQ 110$ ;No, just DCL/@File input MOVB @R0,-(SP) ;Yes, get next DCL/@File character BIC #,@SP ;Clear high byte and parity CMPB (SP)+,# ;Is it a CTRL/C? BNE 110$ ;No, normal character TSTB (R0)+ ;Yes, is it from DCL? (high bit=0) BPL 90$ ;Yes, do not revert BIS #,STATWD ;CTRL/C from @File makes us revert to TTY 90$: BIS #,STATWD ;Flag ^C during non-terminating CSI/GTLIN 100$: TSTB (R0)+ ;Scan to end of line, we ignore ^C BNE 100$ ; for now, since its a nonterminating request MOV R0,INBFPT ;Update permanent buffer pointer TST (SP)+ ;Dump input flag from stack BR 70$ ;Retry with the appropriate flags set ............ 110$: INC @SP ;Flag input from DCL/@File input 120$: CMPB @R0,# ;Coming from IND DCL? BEQ 130$ ;Branch if yes TSTB @R0 ;Are we to echo this line? BPL 220$ ;No, DCL line proceed ;+ ;Note that the following 2 lines are for the FB/XM version only ;They are NOT duplicated in the USR for SJ ;- 130$: CMP GTLFLG,#<3> ;Is this .GTLIN *,*,TERM? BEQ 170$ ;Branch if yes BIT #,STATWD ;Maybe, is suppress echo bit set? BNE 220$ ;Yes, don't print the line BR 170$ ;No, check if BATCH around, else prompt ............ ;+ ; End of DCL/@File data ;- 140$: BIC #,STATWD ;Revert to TT, clear DCL/@File input 150$: MOV CNTXT,R1 ;R1 -> impure area BIC #,I.TERM(R1) ;Don't gather string in special mode CMP GTLFLG,#<3> ;GTLINE? BHI 160$ ;No CSI EMT MOV @#$JSW,R0 ;Get contents of current $JSW BIC #^c,R0 ;Isolate lower case bit BIS R0,I.TERM(R1) ;Set bit in terminal status word 160$: .IF NE BATC$H TST JOBNUM ;Running in background? BNE 180$ ;No, we must wait .ENDC ;NE BATC$H 170$: .IF NE BATC$H MOV $ENTRY+BA.NUM,R0 ;Background job, is BATCH resident BEQ 180$ ;No, we must wait! TST BATSW$(R0) ;Yes, is BATCH active? BNE 220$ ;Yes, we can avoid the wait .ENDC ;NE BATC$H 180$: MOV 2(SP),R0 ;Get prompt address .IF NE MMG$T TST UKFLG ;Print from Kernel or user space? BNE 190$ ;User, can't do a simple EMT .ENDC ;NE MMG$T ;+ ; NOTE: The .PRINT must be followed by MOV R5,R5 to indicate to SL.SYS ; that the .PRINT is printing a prompt. This causes SL.SYS to not print ; the prompt for CSISPC/GEN/ GTLIN. ;- .PRINT ;Prompt user MOV R5,R5 ;Indicate this is CSI for SL .IF NE MMG$T BR 200$ ............ 190$: MOV R1,-(SP) ;Save registers MOV R4,-(SP) .ADDR #,R1 ;R1 -> EMT 16 dispatch list ;>>>$REL ADD SL$E16,R1 ;R1 -> subroutine equivelant to P$RINT CALL @R1 ;Print prompt from user space MOV (SP)+,R4 MOV (SP)+,R1 ;Restore registers .ENDC ;NE MMG$T 200$: TST @SP ;Where is input from? BNE 220$ ;If DCL/@File, don't have to wait TST JOBNUM ;Is this the BG? BNE 210$ ;No, then always wait BIT #,CONFIG ;Is SL handling this? BEQ 210$ ;No, don't do standard wait .TTINR ;Ask for a char MOV R4,R4 ;But tell SL this is a line wait ;+ ; NOTE: the TTINR is a dummy, SL just return trash to it, but it tells ; SL to wait for a line (to keep from locking the USR in TTIN wait) ;- BR 220$ ;Now go to common code ............ 210$: JSR R4,$SYSWT ;Wait for terminal input available .WORD TTIWT$ CMP I.TTLC(R1),#<1> ;; Got input line yet? (set C bit if no) CALL @(SP)+ ;; Coroutine return for blocking check 220$: CMP (SP)+,(SP)+ ;Pop input flag & prompt address 230$: MOV #,R2 ;CSI index CALL CALUSR ;Get the USR in core and ours MOVB R4,USRLVL ;Restore (or set) proper depth CLRB R4 ;R4 = special/general flag .ASSUME I.STAT EQ 0 BIS #,@CNTXT ;Flag CSI is running BR 240$ ;Well, go do it! ............ .ENDC ;EQ SB .SBTTL EMTUSR - Dispatcher For EMTs Handled In The USR ;+ ; Following is a table of calls into the USR. R2 is used as an index to ; the proper function once control has passed into the USR. R2 will have ; bit 15 (100000) set if new format EMT. ; ; xxxx.. are special directory device codes ; xxxx.$ are NOT ... ; ; NOTE: A dispatch table exists in the USR, which must be the same as this ; table, but in reverse order!!! (See label ULS:) ;- D$STAT: INC R2 ;Device Status F$ETCH: INC R2 ;Fetch/Release C$LOS2: INC R2 ;Close (RT-11 directory only) CLOSZE: INC R2 ;Close and set file size FSINFO: INC R2 ;(Get|Set)File(DATE|STATus|INFOrmation) PURGES: INC R2 ;Purge (special directory only) R$NAME: INC R2 ;Rename E$NTER: INC R2 ;Enter L$OOK: INC R2 ;Lookup D$LETE: INC R2 ;Delete INC R2 ;Close (special directory only) Q$SET2: ;Set I/O Queue EMTUSR: CALL CALUSR ;Grab the USR .ASSUME I.STAT EQ 0 240$: BIS #,@CNTXT ;Say that the USR is in control USRDBG::NOP ;Replace with BPT for debugging USR CALLR @USRLOC ............ Q$SET: .IF EQ SB CALL ENQUSR ;Own the USR to kick it out .IFF ;EQ SB CLRB USROWN ;Own the USR to kick it out .ENDC ;EQ SB CLR USRLOC ;Read in fresh copy of USR CLR KMLOC ;Read in fresh copy of KMON too! BR Q$SET2 ;GO TO IT ............ .DSABL LSB .SBTTL .CHAIN - Chain To Program EMT ;+ ; "You will softly and suddenly vanish away ; And never be met with again." - Lewis Carroll ; "The Hunting of the Snark" ;- ;+ ; EXIT causes the executing program to return to the Monitor. ; EXIT first releases the USR and waits for all user I/O to complete. ; If the FG is EXITing, it is linked into the free space list. ; If the BG job is EXITing, it is swapped out if necessary ; and the KMON and USR are read into their standard place. ;- .ENABL LSB C$HAIN: BIS #,@#$JSW ;CHAIN simply sets CHAIN bit MOV SP,R0 ;Avoid hard exit BR 10$ ............ .SBTTL .EXIT - Exit From Program EMT E$XIT: BIC #,@#$JSW ;Indicate no CHAINing 10$: MOV R0,-(SP) ;Preserve hard/soft flag .IF NE MMG$T CALL P1SD ;Restore PAR1 mapping .ENDC ;NE MMG$T .IF EQ SB MOV JOBNUM,R2 ;Get our job number CMPB USROWN,R2 ;Do we own the USR? .IFF ;EQ SB TSTB USROWN ;Do we own the USR? .ENDC ;EQ SB BNE 20$ ;No CLR BLKEY CALL RIDUSR ;Get rid of USR .ASSUME I.STAT EQ 0 .ASSUME CMPLT$ LT 0 20$: TST @CNTXT ;Trying EXIT from completion? BPL 30$ ;That's naughty CALLR UABORT ;Abort the job ............ 30$: CALL QUIESCE ;Allow I/O to complete CALL REVRT2 ;Wait for all I/O to stop .IF NE MTT$Y CALL MTRSET ;Detach termials .ENDC ;NE MTT$Y CLR @R3 ;Clear abort flag in I.STAT .IF NE SPC$PS CLR I.ECTR(R3) ;Reset EMT level counter CLR I.SPCP(R3) ; and derail address .ENDC ;NE SPC$PS 40$: CLR I.SERR(R3) ;Cancel soft errors CLR I.SCCA(R3) ;Clear CTRL/C inhibit .IF NE MMG$T BIS #,@#PS ;Make sure previous is USER .IF EQ SB .ADDR #,R1 ;R1 -> SCCA Virtual address table ;>>>$REL ADD JOBNUM,R1 ;Add offset to this job's entry CLR @R1 ;Clear it .IFF ;EQ SB CLR SCCATB ;Clear job's SCCA Virtual address .ENDC ;EQ SB .ENDC ;NE MMG$T 50$: MOV I.DEVL(R3),R1 ;R1->next node in .DEVICE list BEQ 70$ ;BR if none or done MOV (R1)+,I.DEVL(R3) ;Remove node from .DEVICE list 60$: MOV (R1)+,R2 ;Get a pointer BEQ 50$ ;BR if end of node MOV (R1)+,@R2 ;Stuff data in device address BR 60$ ;Loop again ............ 70$: ADD #,R3 ;Point to impure goodies MOV @R3,R0 ;Point to special list to kill on EXIT BEQ 100$ ;Nothing CLR @R3 ;Turn it off just in case it traps BR 90$ ;Enter loop ............ 80$: MOV (R0)+,@R2 ;Jam a word 90$: MOV (R0)+,R2 ;Get a pointer BNE 80$ 100$: MOV (R3)+,(R3)+ ;Clear TRAP intercept (jam addr now 0) .IF NE FPU$11 CLR (R3)+ ;Clear FPP intercept .ENDC ;NE FPU$11 .IF NE MMG$T .IF EQ SB TST (R3)+ ;Skip I.SPSV .ENDC ;EQ SB .ENDC ;NE MMG$T .IF EQ SB CLR (R3)+ ;Clear special SWAPs CMP (R3)+,(R3)+ ;Skip over SWAP2, saved SP .ADDR #,R5 ;Point to protection bit map ;>>>$REL MOV #,R2 ;Clear all map words 110$: BIC @R3,(R5)+ ;Clear permanent protection map CLR (R3)+ ;And job map SOB R2,110$ ;Loop .ENDC ;EQ SB .BR EXIHOK ............ .DSABL LSB ;+ ; EXIHOK (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; CALL $DARLN ; ; The $DARLN routine is located in the RTEM-11 linkage ; routines. This hook allows RTEM-11 to correctly ; release RSX-11 LUNs at RT-11 job exit. ;- EXIHOK:: ;(*** RTEM-11 HOOK ***) TST JOBNUM ;Are we exiting from the FG? .IF NE SB .BR EXITBG ............ .IFF ;NE SB BEQ EXITBG ;Yes, no KMON, no nothing .BR EXITFG ............ ;+ ; Exiting from the foreground job ;- .ENABL LSB EXITFG::MOV CNTXT,R5 ;Flush output buffer ;I&D+ .IF NE SUP$Y ;99/06 BIC #,@#MMR3 ;Turn off user/supy ; I&D separation and CSM .ENDC ;NE SUP$Y ;99/06 ;I&D- .IF EQ MTT$Y JSR R4,$SYSWT ;Wait for terminal output ring buffer empty .WORD TTOEM$ MOVB I.OCTR(R5),-(SP) ;; Get output ring byte count NEGB (SP)+ ;; Set Carry if not zero yet CALL @(SP)+ ;; Coroutine return for blocking check .ADDR #,R4 ;Now throw away the TTY ;>>>$REL CALL CTRL.B ; by giving it to the BG .IFF ;EQ MTT$Y MOV I.CNSL(R5),R3 ;Get pointer to FG console TCB CALL TTOEWT ;Go wait for output to finish on the terminal MOV R3,R2 ;R2 -> F/G TCB MOV T.CSR(R2),R4 ;R4 -> F/G console CSR MOV BKCNSL,R3 ;Get background console TCB CMP R2,R3 ;Already same as BG console? BEQ 10$ ;Yes, don't change it BIC #,T.STAT(R2) ;Our terminal is no longer a console .IF NE SYT$K CLR T.CNT(R2) ;No more jobs using it as console INC T.CNT(R3) ;One more job for BG console .ENDC ;NE SYT$K CALL MTRSET ;Release ownership of private console 10$: BIS #,T.STAT(R3) ;FG job gone, so BG console is SHARED MOV BCNTXT,R2 ;Get background impure pointer CMP R5,TTIUSR ;Is FG job using the input side of BG console? BNE 20$ ;Nope, someone else is (or FG had private TCB) MOV R2,TTIUSR ;Yes, give keyboard to the BG 20$: CMP R5,TTOUSR ;Are we using the output side? BNE 30$ ;Nope, done CALL TTOSET ;Yes, give printer to the BG and print ID 30$: .ENDC ;EQ MTT$Y .IF EQ MMG$T BIS #,I.BLOK(R5) ;Do not let it run again CALLR USWAPO ;Say Goodnight, Dick ............ .IFF ;EQ MMG$T ENSYS QGTELT ;Enter System State for waiting CALL REGABT ;; Eliminate any ext mem regions BIS #,I.BLOK(R5) ;; Do not let it run again CALLR QWAIT ;; Say Goodnight, Dick ............ .ENDC ;EQ MMG$T .DSABL LSB .ENDC ;NE SB ;+ ; Exiting from B/G job to the KMON ;- .ENABL LSB EXITBG::MOV SP,(PC)+ ;Flag B/G abort in progress EXTFLG:: .WORD 0 ;Flag: not 0 => B/G abort in progress .IF EQ SB ADD #>>,R5 ;Point to KMON stack ;>>>$REL? .IFF ;EQ SB .ADDR #,R5 ;Point to KMON stack ;>>>$REL .ENDC ;EQ SB MOV (SP)+,-(R5) ;Put passed R0 onto KMON's stack .IF EQ MMG$T MOV R5,SP ;Switch stacks to KMON stack .IFF ;EQ MMG$T MOV R5,R2 ;Save pointer to new user stack ADD #>,R5 ;Reset KERNEL stack MOV R5,SP ; BIT #,@#$JSW ;Is this a virtual job? BEQ 20$ ;Branch if not MOV #,R0 ;Copy chain area to physical 500-777 10$: GET @R0,(R0)+ ;Copy a word CMP R0,#<1000> ;Are we done? BLO 10$ ;Branch if not 20$: ;I&D+ MOV @#KISAR1,-(SP) ;; Save kernel PAR1 ;I&D- ENSYS 40$ ;Don't allow context switch PUT R2,SP ;; Set up user stack pointer for KMON MOV CNTXT,R5 ;; R5 -> B/G impure area ;I&D+ .IF NE SUP$Y MOV #,I.CMAP(R5) ;Reset .CMAP state BIC #,@#MMR3 ;Turn off user/supy I&D and CSM .ENDC ;NE SUP$Y ;I&D- CALL REGABT ;; Eliminate any ext mem regions ;I&D+ MOV I.MPTR(R5),@#KISAR1 ;; Map to job's MCA MOVB $WCBNM,R0 ;; R0 = number of WCBs MOV #,R5 ;; R5 -> first WCB ;I&D- 30$: CLR @R5 ;; Clear window control block CLR W.BSIZ(R5) ;; ADD #,R5 ;; Advance to next window block SOB R0,30$ ;; More to clear? BR if yes CALLR MAPLO ;; Set up KMON mapping ............ 40$: ;I&D+ MOV (SP)+,@#KISAR1 ;; Restore kernel PAR1 ;I&D- CALL FIXTRP ;Restore monitor TRAPs .ENDC ;EQ MMG$T .BR 50$ ............ 50$: MOV $KMLOC,R2 ;Point to perm address for KMON TST KMLOC ;Is keyboard in core? BNE 100$ ;Yes, just go to it .IF EQ SB CALL ENQUSR ;We must own the USR for this .IFF ;EQ SB CLRB USROWN ;We must own the USR for this .ENDC ;EQ SB .ADDR #,R5 ;Point to SWAP data ;>>>$REL CLR (R5)+ ;USR DOES NOT SWAP MOV (R5)+,R0 ;Get start of SWAP area .IF NE MMG$T CLR R3 ;Assume job is privileged (no bias) BIT #,@#$JSW ;Is job privileged? BEQ 60$ ;Branch if it is MOV #,R3 ;Virtual job has bias of V.MAX 60$: .ENDC ;NE MMG$T MOV R2,@R5 ;Set pointer to KMON .IF NE MMG$T SUB R3,@R5 ;Convert to virtual address .ENDC ;NE MMG$T BIC #,@R5 ;Round it down to swap out MOV (R5)+,@R5 ;Compute amount to write out .IF NE MMG$T MOV USRLOC,R4 ;Compute virtual address of TST -(R4) ; base of USR minus 2 SUB R3,R4 ; (maximum low memory SETTOP) CMP R4,@#$USRTO ;Virtual SETTOP too big? BHIS 70$ ;Branch if not MOV R4,@#$USRTO ;Change to maximum low memory SETTOP 70$: .ENDC ;NE MMG$T BIT #,CONFG2 ;Has SET EXIT NOSWAP been issued? BNE 80$ ;Branch if yes SUB @#$USRTO,@R5 ;It's a negative number BHI 80$ ;KMON rounded > his top, don't write ROR @R5 ;Make it a word count DEC @R5 ;Top was off by 2 TST -(R5) ;Fix R5 CALL $SYS ;And swap the guy out BCS SWPERR ;Error, go abort the job TST (R5)+ ;Fix R5 so 80$ entered same way 80$: CMP (R5)+,(R5)+ ;Advance pointer to swap-in IOB MOV $MONBL,R0 ;Point to USR SUB #,R0 ;Point to beginning of KMON CMP -(R2),-(R2) ;Back up so we call LOCATE first CALL $SYS ;Read in the KMON/USR BCC 100$ ;AOK read, go enter at MEXIT JSR R0,90$ ;Oops, read failed. Save R0 and print msg. .ASCIZ "?MON-F-System read error" .EVEN ............ 90$: .PRINT ;Do the print MOV (SP)+,R0 ;Restore block number .BR EXRDKM ;Fall through ............ ;+ ; EXRDKM (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; CALL $RDKM ; ; The $RDKM routine is located in the RTEM-11 linkage ; routines. This hook allows RTEM-11 to correctly ; prevent an I/O error from looping indefinitly under ; RTEM-11. ;- EXRDKM:: ;(*** RTEM-11 HOOK ***) .IF EQ VENU$C CALL $SYS ;And keep trying desperately BCS EXRDKM ;Until it succeeds .IFF ;EQ VENU$C BITB #,@TTPS ;TT still printing the error msg? BEQ EXRDKM ;Yes HALT ;Don't retry and hang VENUS console. HALT ... ............ ; ... will give control back to console PROM. .ENDC ;EQ VENU$C 100$: .IF EQ VENU$C BIC #<3400>,SPSTAT ;Reset flagpage bits in SP status wrd .IFF ;EQ VENU$C ;VENUS uses SPSTAT as "DCON running" flag .ENDC ;EQ VENU$C .IF EQ MMG$T CALLR MEXIT2-KMON(R2) ;Enter the KMON ............ .IFF ;EQ MMG$T ADD #,R2 ;R2 -> KMON MOV #,-(SP) ;Go into User mode on dispatch MOV R2,-(SP) ;Push PC RTI ;Go to KMON in User mode ............ .ENDC ;EQ MMG$T .DSABL LSB SWPERR::.HRESET ;Stop everything .RCTRLO ;Insure message gets out CLR @#$USRTO ;Don't try to write the guy out .ADDR #,R0 ;Point to message to print ;>>>$REL .PRINT ;Print it CLR R4 ;So we get HARD EXIT at GOEXIT CALLR GOEXIT ;EXIT via table for BATCH ............ SWPMSG: .ASCIZ "?MON-F-Swap error" .EVEN .SBTTL CALUSR - SWAP USR Routine ;+ ; CALUSR - Load the USR into core, swapping out the user program if necessary ; ; Destroys R0 and R5 ;- .ENABL LSB CALUSR:: .IF EQ SB CALL ENQUSR ;Own the USR before using it .IFF ;EQ SB CLRB USROWN ;Own the USR before using it .ENDC ;EQ SB INCB USRLVL ;Bump usage count TST USRLOC ;Monitor in core? BNE 40$ MOV $USRLC,-(SP) ;If not floating, it goes here TST USRSWP ;Float? BEQ 30$ ;No, read in a good perm copy MOV @#$UFLOA,@SP ;Address of floating USR BEQ 10$ ;Doesn't float, see if resident ;I&D+ ; Check ?????????? ;I&D- JSR R5,CHKSPU ;Check low limit BR 50$ ;Error ...... ADD #,@SP ;Check top limit ;I&D+ ; Check ?????????? ;I&D- JSR R5,CHKSPU ;Check high limit BR 50$ ...... SUB #,@SP ;Fix address BR 20$ ;Ok, continue ............ 10$: .IF EQ SB TST JOBNUM ;Only BG can swap in standard place BNE 50$ ;And this isn't he .ENDC ;EQ SB MOV $USRLC,@SP ;Ah, swap it there 20$: MOV (PC)+,R5 ;Point to IOB for system write SWOPTR:: .WORD SWOIOB ;Address of system write IOB ;>>>$Rel .-2 SWOIOB RMON MOV @SP,@R5 ;Put in address of buffer CMPB USRLVL,#<1> ;Really need to swap out? BHI 30$ ;No, lock is deeper than 1, just refresh USR CALL $SYSSW ;Do I/O to SWAP blocks BCS SWPERR ;Swap error 30$: MOV (PC)+,R5 ;Point to IOB for system read SWIPTR:: .WORD SWIIOB ;Address of system read IOB ;>>>$Rel .-2 SWIIOB RMON MOV (PC)+,R0 ;Get block number of USR $MONBL:: .WORD 0 ;**BOOT** Block number of USR within monitor file MOV @SP,@R5 ;Put in address of area .IF NE MMG$T MOV @#PS,-(SP) ;Save previous mode CLRB @SP ;Save only mapping modes BIC #,@#PS ;Force previous mode to Kernel .ENDC ;NE MMG$T CALL $SYS ;Do the I/O .IF NE MMG$T BIS (SP)+,@#PS ;Restore previous mode, C bit unaffected .ENDC ;NE MMG$T BCS SWPERR ;Oops, got an error MOV (SP)+,USRLOC ;We now have a good USR copy in core 40$: RETURN ;Return with USR in core ............ 50$: CMP (SP)+,(SP)+ ;Prune MONERR USRX,,FATAL ;Attempt to swap USR into illegal area ............ .DSABL LSB .SBTTL ENTRPG, RDOVLY - Enter B/G Job ;+ ; RDOVLY - Entered from KMON when starting a B/G program that is ; large enough to overlay the KMON. The GET routine loads the ; overlaying part into the SWAP blocks and RDOVLY reads them into memory. ; ; ENTRPG - Start a B/G program. Entered from KMON ; for small programs not requiring a SWAP, or from RDOVLY. ; ; "Well, it's blast-off time for galacto-city." - Perry Rhodan ;- .ENABL LSB RDOVLY:: .IF EQ MMG$T CLR KMONIN ;KMON dead as soon as READ starts .IFF ;EQ MMG$T .ADDR #,-(SP) ;Change user SP to point to ;>>>$REL PUT (SP)+,SP ; transitional KMON stack .ENDC ;EQ MMG$T CALL $SYS ;The KMON set up KMBLK for final read SWPLNK: BCS SWPERR ;Bad save file, give '?M-Swap Err' ENTRPG:: .IF EQ MMG$T CLR KMONIN ;User is running CLRB USRLVL ;Get rid of the USR MOV @#$USRSP,SP ;New stack pointer MOV R2,-(SP) ;Set to return to the user start address BR DEQUSR ;And release the USR with no swapping ............ .IFF ;EQ MMG$T ENSYS 30$ ;Avoid context switch PUT @#$USRSP,SP ;; Set up user stack pointer CLR KMONIN ;; User is running CLRB USRLVL ;; Get rid of the USR MOV #,10(SP) ;; Build a fake interrupt MOV R2,6(SP) ;; User start address CALL DEQUSR ;; Release USR MOV CNTXT,R4 ;; R4 -> impure area BIT #,@R4 ;; Is the job virtual? BEQ 30$ ;; No CALL CLRPDR ;; Clear previous user mapping MOV @#KISAR1,-(SP) ;; Save kernel PAR1 MOV I.MPTR(R4),@#KISAR1 ;; Map job's MCA with kernel PAR1 MOV #,R4 ;; R4 -> Window Control Blocks CALL MAPWN ;; Set up map registers MOV (SP)+,@#KISAR1 ;; Restore kernel PAR1 CLR R0 ;; Start at virtual 0 CALL $RELOM ;; Map it TST V.EMT(R0) ;; Does he have a value in location 30? BNE 10$ ;; Yes, leave it MOV @#V.EMT,V.EMT(R0) ;; No, set up monitor value for 30 10$: MOV (PC)+,(R0)+ ;; BIC R0,R0 ;; MOV (PC)+,(R0)+ ;; Put an .ASTX in its .ASTX ;; Virtual 0 and 2 ADD #<$SYCOM-4>,R0 ;; R0 -> $SYCOM area MOV #<$SYCOM>,R1 ;; R1 -> Kernel $SYCOM MOV #<<<$SYPTR+2>-$SYCOM>/2>,R2 ;; Copy 40 - 54 20$: MOV (R1)+,(R0)+ ;; Move a word SOB R2,20$ ;; Loop until done CALL P1SD ;; Restore PAR1 30$: RETURN ;; Enter the job ............ .ENDC ;EQ MMG$T .DSABL LSB .SBTTL ENQUSR - Obtain Ownership Of The USR, Waiting If Necessary ;+ ; ENQUSR - Obtain Ownership of the USR, Waiting If Necessary ; ; State = User ; ; CALL ENQUSR ; ; If USR is free or is owned by calling job, returns immediately ; If USR is owned by another job, job is blocked on USRWT$ ; NOTE: Does not bring USR into memory! ;- .ENABL LSB ENQUSR:: .IF EQ SB CMPB JOBNUM,USROWN ;Do we own it already? BEQ 10$ ;Yep ENSYS ENQUSR ;No, Enter System State to get it CMPB USROWN,#<377> ;; Is it free? BNE 20$ ;; No, delay until it is ours .ENDC ;EQ SB MOVB JOBNUM,USROWN ;; Yes, stake our claim 10$: RETURN ;; Get Out of System State ............ .IF EQ SB 20$: CALLR DLYUSR ;; Jump to delay code (and exit system state) ............ .ENDC ;EQ SB .DSABL LSB ;+ ; RIDUSR - Release the USR, Swap in User If Needed, Give USR To Others ; ; State = User ; USR owned by calling job ; ; CALL RIDUSR ; ; R0 = random ; R5 = random ; ; USR is disowned no matter what LOCK level it is at ; If USR is SWAPping, job is read in (if it was written) and USR marked out ; Other job(s) waiting for USR are unblocked ;- .ENABL LSB .ASSUME I.STAT EQ 0 RIDUSR::BIC #,@CNTXT ;USR/CSI not running for this job CLRB USRLVL ;Insure 0 LOCK level TST USRSWP ;Is the USR swapping? BEQ DEQUSR ;No, don't read the user in CLR BLKEY ;Yes, kill directory block in memory MOV SWIPTR,R5 ;Point to IOB for reading job image MOV SWOIOB,@R5 ;Address for read is same place we wrote user BEQ 10$ ;No read to do (SETTOP over USR during LOCK) CALL $SYSSW ;Read job image in from SWAP blocks BCS SWPLNK ;Swapping error! CLR SWOIOB ;Indicate no user is out there 10$: CLR USRLOC ;USR no longer in core CLR KMLOC ;Read in new copy of KMON next time! .BR DEQUSR ;Now release ownership ............ .DSABL LSB .SBTTL DEQUSR - Release Ownership Of The USR ;+ ; DEQUSR - Release ownership of the USR, give it to waiting job ; ; CALL DEQUSR ; ; USR is released if it is owned by the calling job ; The highest priority job that is blocked on USRWT$ is given the USR ; NOTE: DEQUSR can be called even if the USR is not owned ;- .ENABL LSB DEQUSR:: .IF EQ SB CMPB JOBNUM,USROWN ;Do we own the USR? BNE 20$ ;No, ignore attempts to disown it ENSYS 30$ ;Gotta give it away .ENDC ;EQ SB MOVB #<377>,USROWN ;; Mark it not in use .IF NE SB BR 30$ ;; Check if abort requested ............ .IFF ;NE SB MOV IMPLOC,R4 ;; Point to impure pointers 10$: MOV -(R4),R5 ;; Get an impure pointer BEQ 10$ ;; Job not active CMP #<-1>,R5 ;; End of table? BEQ 20$ ;; Yes, it is free BIT #,I.BLOK(R5) ;; Is job waiting for USR? BEQ 10$ ;; No BIT #,I.BLOK(R5) ;; Is job suspended by 'SUSPEND' command? BNE 10$ ;; Yes, Keep it that way JSR R4,UNBLOK ;; Unblock job which was waiting for USR .WORD USRWT$ ;; MOVB I.JNUM(R5),USROWN ;; Give USR to the job we just unblocked .ENDC ;NE SB 20$: RETURN ;; Done ............ .ASSUME I.STAT EQ 0 30$: BIT #,@CNTXT ;Was abort requested during directory op? BEQ 20$ ;Nope UABT2: CALLR UABORT ;Go to aborter ............ .DSABL LSB .SBTTL TT - Resident Teletype Handler .ENABL LSB .WORD ;Offset to abort entry .WORD 0 ;Handler hold flag TTLQE:: .WORD 0 ;Pointer to last queue element TTCQE:: .WORD 0 ;Current queue element MOV TTCQE,R3 ;R3 -> CQE MOV (R3)+,R4 ;R4 = block number .IF EQ SB MOV (R3)+,R1 ;Get job number from queue element SWAB R1 ;Get it into the low byte ASR R1 ;Shift it ASR R1 ; to be ASR R1 ; true job number BIC #^c<16>,R1 ;Isolate number ADD PC,R1 ;Point to impure area (pic) MOV $IMPUR-.(R1),R2 ;Get job's impure area pointer ;>>>$REL .IFF ;EQ SB TST (R3)+ ;Skip job number in queue element MOV CNTXT,R2 ;Get job's impure area pointer .ENDC ;EQ SB ASL Q.WCNT-Q.BUFF(R3) ;Change word count to byte count BEQ TTCMPL ;0 => done seek BCS 70$ ;<0 => write TST TTEOF ;Read, have we encountered an EOF? BNE TTCLEF ;Yes, return EOF at once .IF EQ MTT$Y MOV R2,(PC)+ ;Save impure of input user TTHIUS: .WORD 0 ;-> impure area of input user .IFF ;EQ MTT$Y MOV R2,TTHIUS ;Save impure of input user .ENDC ;EQ MTT$Y TST R4 ;Is this block 0? BNE TTHIN ;No .IF EQ MTT$Y MOVB #<'^>,R4 ;Yes, put a prompt in his buffer CALL TTOPT2 ;Send the prompt ;+ ; TTHIN is entered when the handler is first called, and again ; each time the resident service detects a line delimiter. ; It gets as many lines as possible out of the ring buffer ;- TTHIN:: MOV TTCQE,R3 ;R3 -> queue element .IF EQ MMG$T CMP (R3)+,(R3)+ ;Advance to buffer pointer .ENDC ;EQ MMG$T 10$: .IF EQ SB MOV TTHIUS,R2 ;R2 -> impure area .IFF ;EQ SB MOV CNTXT,R2 ;R2 -> impure area .ENDC ;EQ SB TST I.TTLC(R2) ;Is there a line available now? BEQ 60$ ;No, return CALL IGET ;Yes, get a character from the input ring BEQ $RQABT ;^C aborts us CMPB #,R4 ;End of file marker? BEQ 30$ ;Yes, go zero out his buffer .IF EQ MMG$T MOVB R4,@(R3)+ ;Put this byte in the user buffer DEC @R3 ;Decrement byte counter BEQ 50$ ;Request is complete, go complete I/O INC -(R3) ;Bump buffer pointer BR 10$ ;Empty out the ring ............ 20$: INC -(R3) ;Bump buffer pointer 30$: CLRB @(R3)+ ;Clear an unfulfilled byte DEC @R3 ;Count down BNE 20$ ;Keep going .IFF ;EQ MMG$T MOVB R4,-(SP) ;Stack the character MOV R3,R4 ;Copy queue element pointer for PUTBYT CALL $PUTBYT ;Move to user buffer DEC Q$WCNT(R4) ;Decrement byte count BEQ 50$ ;Request is complete, go complete I/O MOVB R0,R4 ;Restore character for echo (?????) BR 10$ ;Loop ............ 30$: MOV R3,R4 ;PUTBYT wants pointer in R4 40$: CLR -(SP) ;Clear an unfulfilled byte CALL $PUTBYT ;Move to user buffer DEC Q$WCNT(R4) ;Count down BNE 40$ ;Keep going .ENDC ;EQ MMG$T .IFF ;EQ MTT$Y MOV I.CNSL(R2),R3 ;Point to console TCB MOV T.CSR(R3),R4 ;Point to CSR for device ADD #,R2 ;R2 -> input ring count MOVB #<'^>,R0 ;Prompt with '^' CALL TTOPT2 ;Put in output ring buffer ;+ ; TTHIN is entered when the handler is first called, and again ; each time the resident service detects a line delimiter. ; It gets as many lines as possible out of the ring buffer ;- TTHIN:: MOV TTCQE,R4 ;R4 -> Q.BLKN in queue element 10$: .IF EQ SB MOV TTHIUS,R1 ;R1 -> owner's impure area .IFF ;EQ SB MOV CNTXT,R1 ;R1 -> owner's impure area .ENDC ;EQ SB ADD #,R1 ;R1 -> input get pointer TST I.TTLC-I.IGET(R1) ;Any lines avaliable? BNE 40$ ;Yes, empty the ring to the user buffer TST -(R1) ;R1 -> I.ICTR for return to interupt service BR 60$ ;Return ............ 40$: CALL MTTGET ;Get a character from the input ring BEQ $RQABT ;Abort if CTRL/C was struck CMPB #,R0 ;End of file? BEQ 30$ ;Yes, go zero-fill and complete I/O .IF EQ MMG$T MOVB R0,@Q$BUFF(R4) ;Move character to buffer DEC Q$WCNT(R4) ;Decrement byte count BEQ 50$ ;Done INC Q$BUFF(R4) ;Bump buffer pointer BR 10$ ;Try another until done ............ ;+ ; EOF was encountered on input. Zero fill rest of buffer ;- 20$: INC Q$BUFF(R4) ;Bump buffer pointer 30$: CLRB @Q$BUFF(R4) ;Zero a byte DEC Q$WCNT(R4) ;Count down BNE 20$ ;Loop .IFF ;EQ MMG$T MOVB R0,-(SP) ;Pass character on stack CALL $PUTBYT ;Move to user buffer DEC Q$WCNT(R4) ;Decrement byte count BEQ 50$ ;Done BR 10$ ;Try another until done ............ ;+ ; EOF was encountered on input. Zero fill rest of buffer ;- 30$: CLR -(SP) ;Clear a byte CALL $PUTBYT ;Move to user buffer DEC Q$WCNT(R4) ;Count down BNE 30$ ;More to do .ENDC ;EQ MMG$T .ENDC ;EQ MTT$Y MOV SP,(PC)+ ;Set end-of-file flag TTEOF: .WORD 0 ;Flag: not 0 => end-of-file 50$: MOV R5,R2 ;Preserve R5 CALL TTCMPL ;Call completion MOV R2,R5 ;Restore R5 .IF EQ MTT$Y MOV R0,R4 ;Put char to echo in R4 .ENDC ;EQ MTT$Y 60$: RETURN ;Return to TT or monitor ............ TTCLEF: CLR TTEOF ;Clear EOF flag BIS #,@Q.CSW-Q.BUFF(R3) ;Set end of file TTCMPL::CLR TTHIUS ;Stop using the TT: CLR TTHOUS .ADDR #,R4 ;Point to CQE ;>>>$REL CALLR COMPLT ;Exit via completion ............ ;+ ; Set up TT: for output ;- 70$: MOV (R3)+,-(SP) ;Reverse buffer pointer and byte count ... MOV @R3,-(R3) ; ... to resemble monitor's ring pointers .IF EQ MTT$Y BIC #,I.TERM(R2) ;Wait for output ring .ENDC ;EQ MTT$Y NEG (R3)+ ;Convert to real byte count MOV (SP)+,@R3 ;Finish reversing MOV R2,TTHOUS ;Say we are using the TT handler for output .IF NE MTT$Y MOV I.CNSL(R2),R3 ;R3 -> console TCB BIC #,T.STAT(R3) ;Wait for output ring MOV T.CSR(R3),R4 ;R4 -> console CSR .ENDC ;NE MTT$Y CALLR TTOENB ;Turn on output interrupts ............ .DSABL LSB ;+ ; Ask for an abort when we are about to return from level 0 ; The following routine requests that a user be aborted ; It is called from System State with R5 -> User's impure area ;- $RQABT::BIS #<100000>,INTACT ;; Set 'Abort Pending' flag BIS #,@R5 ;; Turn on abort rquest in user's I.STAT RETURN ;; Return ............ .IF EQ MTT$Y .SBTTL TT - Terminal Service Routines (IGET, TTRSET, TTOUT) ;+ ; IGET - Get a character from input ring buffer ; ; R2 -> impure area ; ; CALL IGET ; ; R2 -> I.ICTR (in impure area) ; R4 = character ; Z=1 if character is CTRL/C ; I.TTLC (line count) decremented if EOL ;- .ENABL LSB IGET:: ADD #,R2 ;Point to input ring get pointer INC @R2 ;Bump pointer CMP (R2)+,@R2 ;Time to wrap? BNE 10$ ;No SUB #,I.IGET-I.ITOP(R2) ;Wrap the buffer pointer 10$: MOVB @-(R2),R4 ;Get the character DEC -(R2) ;Decrease the character count CALL EOLTST ;End of line (^C, ^Z, LF)? BNE 20$ ;No, return Z=0 DEC I.TTLC-I.ICTR(R2) ;Decrement number of lines in buffer CMPB #,R4 ;Set Z=1 if CTRL/C 20$: RETURN ............ .DSABL LSB ;+ ; TTRSET - Reset terminal related bits in I.TERM from job's $JSW ; ; R1 -> I.TTLC ; R5 -> impure area ; Job context set up ; ; CALL TTRSET ; ; R1 -> I.ICTR if TTSPC$ now on ; (i.e. R1 -> pertinent count) ; R3 = new terminal related bits (TTSPC$, TTLC$) ;- .ENABL LSB TTRSET::MOV @#$JSW,R3 ;Get the $JSW BIC #^c,R3 ;Clear all but special and LC bits BIT #,R3 ;Is special bit on in $JSW? BEQ 10$ ;No ADD #,R1 ;Yes, adjust pointer to relevant counter 10$: SPL 7 ;Lock out interrupts BIC #,I.TERM(R5) ;;; Remove old terminal status BIS R3,I.TERM(R5) ;;; Set new terminal status bits SPL 0 ;;; Allow interrupts RETURN ............ .DSABL LSB ;+ ; TTOUT - Put output character into ring, start output ; ; R4 = character to print ; Job context set up ; ; JSR R0,TTOUT ; .WORD WAITBITS 0 => Stall if output ring full (.PRINT) ; TCBIT$ => Return C=1 if TCBIT$ is on in $JSW ; ; R2 = undefined ; R4 = trimmed character (7-bit) ; C=1 if (output ring full) & (WAITBITS=TCBIT$) & (TCBIT$ on in $JSW) ;- .ENABL LSB 10$: .IF NE SYT$K TSTB XFLAG ;Is a ^X sequence in progress? BEQ 20$ ;No, allow the character to go out ENSYS TTOUT ;Yes, wait for sequence to finish CALLR QWAIT ;; Start scheduling below us ............ 20$: .ENDC ;NE SYT$K JSR R4,$SYSWT ;Wait for room in terminal output ring buffer .WORD TTOWT$ CMPB #,@R2 ;; Set Carry if still no room in ring buffer CALL @(SP)+ ;; Coroutine return for blocking check TTOUT:: .IF NE SYT$K TSTB XFLAG ;Are we in ^X sequence? BNE 30$ ;Yes, stall until he's done typing a job name .ENDC ;NE SYT$K MOV CNTXT,R2 ;Point to job impure area .IF EQ VENU$X CALL TTOPT2 ;Put it out (Real RT) .IFF ;EQ VENU$X CALL TTOPT5 ;Put it out (other) .ENDC ;EQ VENU$X BCC 40$ ;It fit in the ring, return C=0 30$: BIT @R0,@#$JSW ;No room, does he want C-bit? BEQ 10$ ;No, TCBIT off or doing .PRINT, go stall him 40$: BIT (R0)+,R1 ;Pop return pointer without changing Carry RTS R0 ;Return with C-bit set or clear ............ .DSABL LSB .ENABL LSB .IF NE SYT$K .SBTTL XRESET - Reset CTRL/X flags and buffer ;+ ; XRESET - Reset CTRL/X flags and buffer ; ; R3 -> XCOUNT ; ; CALL XRESET ; ; R3 -> XPROMT ;- XRESET: CLRB (R3)+ ;Clear count, point to XPREV CLR (R3)+ ;Clear XPREV, point to XBUFF CLR (R3)+ ;Clear CLR (R3)+ ; all the buffer CLR (R3)+ ;Clear buffer, point R3 to ^X ID RETURN ............ 10$: JSR R5,ECHO0C ;Echo ^C, CR-LF .ASCII CLR XFLAG ;Exit ^X sequence (clears flag, count) RETURN ;Exit this interrupt ............ .ENDC ;NE SYT$K .SBTTL CTRL.C - Process CTRL/C Input 20$: .IF NE SYT$K TSTB XFLAG ;^X sequence in progress? BNE 10$ ;Yes, end it .ENDC ;NE SYT$K TST I.SCCA(R5) ;Is user ^C processing enabled? BEQ 30$ ;No, always echo CTRL/C BIT #,I.TERM(R5) ;Is he in special mode with user ^C? BNE 40$ ;Yes, don't echo CTRL/C 30$: JSR R5,ECHO0C ;Type a ^C and CR/LF .ASCII 40$: CMPB R0,I.PTTI(R5) ;Is it second ^C? BNE TT3LNK ;No, ignore it for now MOV I.SCCA(R5),R4 ;Get user's CTRL/C status address BNE TTICCA ;Got it, go set status .IF EQ SB TST I.JNUM(R5) ;Was ^C typed to background? BNE $RQABT ;No, simply abort the job .ENDC ;EQ SB BICB #,INDSTA ;Make sure the status is clear BIS #,STATWD ;Abort indirect file, if any TST EXTFLG ;EXIT in progress? BNE TT3LNK ;Yes, don't abort yet again .IF NE BATC$H MOV $ENTRY+BA.NUM,R3 ;Is BA.SYS resident? BEQ $RQABT ;No CLR BATSW$(R3) ;Yes, stop BATCH if active .ENDC ;NE BATC$H BR $RQABT ;Abort the background ............ CTRL.C::BR 20$ ;Link to CTRL/C processor ............ .DSABL LSB .SBTTL CTRL.Q - Process CTRL/Q Input CTRL.Q::TSTB TTCNFG ;Are we set to nostall? BPL TTIDSP ;If so, this is an ordinary character CTRLQ2: CLR XEDOFF ;Turn off output stall to allow output ;+ ; HKPC10 (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; CALL PIHK10 ; ; PIHK10 turns off video output interrupts on the PRO300 series processor ;- HKPC10:: ;(*** PRO300 HOOK ***) .IF EQ VENU$C .IF EQ PDT$OP BIC #,@TTPS ;Turn off output interrupt bit .ASSUME <.-HKPC10> EQ 6 .IFF ;EQ PDT$OP CLR @TTPS ;Turn off output interrupt bit NOP .ENDC ;EQ PDT$OP .ENDC ;EQ VENU$C CALL @$XTTPS ;;; Update TTPS, pls BR TTOENB ; and force an interrupt if idle ............ .IF NE SYT$K .SBTTL CTRL.X - Process CTRL/X Input CTRL.X::.ADDR #,R3 ;Point to CTRL/X data area ;>>>$REL MOVB #<201>,(R3)+ ;Start a CTRL/X sequence CALL XRESET ;Initialize ^X data area MOV TTIUSR,TTOUSR ;Grab terminal for both output and input BR TTOENB ;Enable output interrupts, exit this one ............ .ENDC ;NE SYT$K .ENABL LSB .IF EQ SB .SBTTL CTRL.B - Process CTRL/B Input CTRL.B:: .IF NE SYT$K CLR XFLAG ;Exit ^X seq, if any (clears count,flag) .ENDC ;NE SYT$K MOV BCNTXT,R0 ;Get background impure area pointer XCOM:: MOV R0,@R4 ;Set new user of input side CMP -(R4),R0 ;Does new input user already own output? BEQ 10$ ;Yes, no need to print the user ID MOV R0,@R4 ;No, give him the output side MOV I.TID(R0),-(R4) ;Start to print the ID change .BR TTOENB ............ .ENDC ;EQ SB .SBTTL TTOENB - Enable terminal output interrupts ;+ ; TTOENB - Enable terminal output interrupts ; ; CALL TTOENB ;- ;+ ; TTOENB (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; CALL TTOEN1 ; ; TTOEN1 enables video output interrupts for the PRO300 series processor ;- TTOENB:: ;(*** PRO300 HOOK ***) .IF NE VENU$C MOVB @TTKCR,-(SP) ;Read command register data BISB #,@SP ;Set Error Reset & Transmit Enable bits MOVB (SP)+,@TTPCR ;Write data to command register .IFF ;NE VENU$C .IF EQ PDT$OP BIS #,@TTPS ;Enable output interrupts .IFF ;EQ PDT$OP MOV #,@TTPS ;Enable output interrupts .ENDC ;EQ PDT$OP .ASSUME .-TTOENB EQ 6 .ENDC ;NE VENU$C CALL @$XTTPS ;TTPS may have been changed 10$: RETURN ............ .IF EQ SB .SBTTL CTRL.F - Process CTRL/F Input CTRL.F:: .IF NE SYT$K CLR XFLAG ;Stop ^X seq, if any (clears count, flag) .ENDC ;NE SYT$K MOV FCNTXT,R0 ;Point to foreground impure area BEQ 20$ ;No foreground, tell him we can't do it BIT #,I.BLOK(R0) ;Is he dead? BEQ XCOM ;Nay, he liveth, give him control 20$: JSR R5,ECHO ;Smite him who typeth ^F .ASCII "F?" .BR ECHOCL ............ .ENDC ;EQ SB ;+ ; ECHOCL - Print a return/line feed for TTIUSR ; ; CALL ECHOCL ; ; R2 = undefined ; R4 = undefined ;- ECHOCL: JSR R5,ECHO ;Put out CR/LF .ASCII RETURN ............ ;+ ; TTICCA - Set sign bit in user ^C status word ; ; R4 -> user status word (from I.SCCA) ; R5 -> impure area ; ; CALL TTICCA ; ; Exit through TTINC3 to put in input ring as normal character ;- TTICCA:: .IF NE MMG$T MOV @#KISAR1,-(SP) ;Preserve PAR1 contents MOV I.SCC1(R5),@#KISAR1 ;Set up PAR1 .ENDC ;NE MMG$T BIS #<100000>,@R4 ;Set CTRL/C flag .IF NE MMG$T MOV (SP)+,@#KISAR1 ;Restore PAR1 mapping .ENDC ;NE MMG$T TT3LNK: BR TTINC3 ;Treat as normal character ............ .IF EQ HSR$B .SBTTL TTIINT - Terminal Input Interrupt Processor ;+ ; TTIINT (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; CALLR TTIIN1 ; ; TTIIN1 gets the keyboard matrix code from the PRO300 series processor ; keyboard and converts it to ASCII and stores this character in the ; Pseudo-keyboard receiver buffer KBDBUF in PI. Since PI has TTKB ; to contain the address of KBDBUF, all @TTKB references access the ; KBDBUF on PRO300 series processors. ; ; TTIIN1 will call us back at TTIIN2. ;- TTIINT:: ;;; (*** PRO300 HOOK ***) .IF EQ VENU$C JSR R5,$INTEN ;;; Do interrupt common entry .WORD < ^c & PR7 > ; (level 4) .IFF ;EQ VENU$C ;+ ; Only one interrupt per terminal on VENUS console. The "JSR R5,$INTEN" ; was done by the output interrupt handler. ;- .ENDC ;EQ VENU$C MOV @TTKB,R4 ;Get the character JSR R3,SAVE30 ;Save regs 3-0 TTIIN2:: .IFF ;EQ HSR$B .SBTTL TTIIN2 - Terminal Input Character FORK Level Processing TTIIN2:: TTISTF: .ENDC ;EQ HSR$B .IF NE VENU$C BIT #,@#$JSW ;Pass all? BNE 30$ ;Yes .ENDC ;NE VENU$C BIC #,R4 ;Clear parity BEQ 10$ ;Ignore nulls 30$: .ADDR #,R2 ;Point to specials list ;>>>$REL MOV R2,R3 ;Copy pointer for ^F, ^B MOV -(R3),R5 ;Point to terminal input user's impure area .IF NE SCCA$G CMPB R4,# ;Is it a Control C? BNE 40$ ;No, then carry on BITB #,INDSTA ;Yes, then is Global SCCA on? .IF EQ SB BEQ 40$ ;No, then carry on .ADDR #,R1 ;Get the address of the background impure area ;>>>$REL CMP R5,R1 ;Is the ^C destined for the background? BEQ 10$ ;Yes, then drop the character on the floor .IFF ;EQ SB BNE 10$ ;Global SCCA on, so throw the character away .ENDC ;EQ SB 40$: .ENDC ;NE SCCA$G MOV R5,R1 ;Copy impure pointer ADD #,R1 ; and point to input ring count MOV R4,R0 ;Move the input character MOV R3,R4 ;R4 -> TTIUSR .IF NE SYT$K TSTB XFLAG ;Is a ^X sequence in progress? BNE 50$ ;Yes, always change lower case to upper .ENDC ;NE SYT$K .IF NE VENU$C BIT #,@#$JSW ;"PASSALL"? BNE 60$ ;Yes .ENDC ;NE VENU$C BIT #,I.TERM(R5) ;Does he want lower case input? BNE 60$ ;Yes, don't convert 50$: CALL UCASE ;Else convert it 60$: .DSABL LSB .ENABL LSB .IF NE VENU$C BIT #,@#$JSW ;"PASSALL"? BNE TTINC3 ;Yes, just put in ring and unblock. TST SPSTAT ;Check "DCON Running" flag ;( *** This assumes that VENUS console will ; never never use SPOOLER! *** ) BEQ 10$ ;BR if DCON is not running CMPB #,R0 ;Is the char < space? (i.e., special char?) BLE 10$ ;BR if not a control char CALL @SPSTAT ;Call to DCON special char input routine BCS SCNOP ;BR if DCON took care of the char .ENDC ;NE VENU$C 10$: MOVB (R2)+,R3 ;Get dispatch offset for special character BEQ TTINCC ;All done checking ASLB R3 ;Make it a byte offset. Done generals? BEQ TTIDSP ;Yes, go stop this if special mode input CMPB (R2)+,R0 ;Is this the special character? BNE 10$ ;No, keep looking ADD R3,PC ;Jump (NON-STANDARD) to input processor ;>>>$REL? TTIBAS: ;Reference tag for special input list TTIERB: CLR @R5 ;CTRL/U or RUBOUT failed, so no previous input RETURN ............ CTRL.R: CALLR CTRL$R ;Link to actual CTRL-R processing routine .SBTTL CTRL.S - Process CTRL/S Input CTRL.S::MOVB TTCNFG,XEDOFF ;Set X-ed OFF switch BMI SCNOP ;If enabled, it's on, so all done now .BR TTIDSP ;TT is set nostall, process CTRL/S normally ............ TTIDSP:: .IF NE SYT$K TSTB XFLAG ;^X sequence in progress? BNE XPROCL ;Yes, process ^X sequence characters .ENDC ;NE SYT$K BIT #,I.TERM(R5) ;Is the user in special input mode? BEQ 10$ ;No, check out the other characters BR TTINC3 ;Yes, pass this through ............ .SBTTL ALT - Process ALTMODE Input ALT: MOV #,R0 ;Use 33 code as standard .BR TTINCC ;Fall into ordinary input code ............ .SBTTL TTINCC - Process Ordinary Input Character TTINCC::CMPB I.PTTI(R5),# ;Was previous input character a RUBOUT? BNE TTINC3 ;No, no BACKSLASH to close out TST TTCNFG ;Yes, but is console a scope? BMI TTINC3 ;Don't print BACKSLASHes if so JSR R5,ECHO ;Close out the RUBOUT sequence .ASCII "\" .BR TTINC3 ............ .SBTTL TTINC3 - Put Input Character Into Ring and Echo TTINC3::CMP @R1,# ;Will this character fit in buffer? BGE 60$ ;No, send him a BELL MOV R0,R4 ;Copy character for echoing INC @R1 ;Bump count of characters in input ring INC -(R1) ;Bump input pointer CMP @R1,I.ITOP-I.IPUT(R1) ;Time to wrap? BNE 20$ ;Nope SUB #,@R1 ;Back to beginning of input ring 20$: MOVB R0,@(R1)+ ;Put character into buffer CALL EOLTST ;Is this an end of line? BNE 30$ ;No INC I.TTLC(R5) ;Yes, bump line count CMP TTHIUS,R5 ;Is he using the TT: handler for input? BNE 30$ ;No CALL TTHIN ;Yes, call the handler 30$: MOV R0,I.PTTI(R5) ;Remember previous character JSR R4,UNBLOK ;Unblock job if it's waiting for input .WORD TTIWT$ BIT #,I.TERM(R5) ;Is he in special input mode? BNE 40$ ;Yes, no echo CALL TTOPT3 ;Echo it (if no output room, it won't echo!) 40$: ADD #,R0 ;Change a RETURN to a LINE FEED CMPB #,R0 ;Was that a carriage RETURN? BEQ TTINC3 ;Yes, put in a free LINE FEED SCNOP:: RETURN ............ .IF NE SYT$K XPROCL: BR XPROC ;Branch link .ENDC ;NE SYT$K .SBTTL CTRL.O - Process CTRL/O Input CTRL.O::ADD #,R1 ;R1 -> output count CLRB (R1)+ ;Clear the count MOVB @R1,-(SP) ;Get former ^O condition CLRB (R1)+ ;Turn it off temporarily MOV @R1,I.OPUT-I.OGET(R1) ;Set buffer pointers equal JSR R5,ECHO0C ;Echo ^O CR LF .ASCII COM @SP ;Flip the flop ... MOVB (SP)+,-(R1) ; ... and set up the new CTRL/O flag BEQ 50$ ;Turning it on is easy JSR R4,UNBLOK ;Turning off TTY output means buffer empty ... .WORD ; ... so unblock job if waiting on output bfr. 50$: RETURN ;Return from interrupt ............ 60$: CALL @$XTTNR ;Allow hook routine to know the char won't fit MOV R0,I.PTTI(R5) ;Can't fit input, but remember in case ^C^C DING: MOV #,R4 ;Ding him for overflow CALLR TTOPT4 ;Go ding ............ .DSABL LSB .SBTTL CTRL.U - Process CTRL/U Input ;+ ; Entered with: ; R0 = Control character being processed ; R1 -> Input ring buffer structure (at I.ICNT) in impure area ; R5 -> Impure area ;- .ENABL LSB CTRL.U:: TST @R1 ;Any characters to delete? BEQ TTIERB ;Nope... TST TTCNFG ;Is terminal set SCOPE? BMI RUB ;Yes, do scope-type operation CALL ECHOR0 ;Echo ^U CALL ECHOCL ; and .BR RUB ;Fall into RUBOUT code ............ .SBTTL RUB - Process Rubout Input ;+ ; Entered with: ; R0 = Control character being processed ; R1 -> Input ring buffer structure (at I.ICNT) in impure area ; R5 -> Impure area ;- RUB: MOV R0,(PC)+ ;Save character for later check RIFLAG: .WORD 0 ; : Character we are processing (RUBOUT v. ^U) ADD #,R5 ;R5 -> previous input char 10$: TST @R1 ;Any chars to delete? TIERBL: BEQ TTIERB ;No, print a new line MOVB @-(R1),R4 ;Get the last character in the input ring CALL EOLTST ;Line terminator? BEQ TTIERB ;Yes, can't delete it CMP @R1,-2(R1) ;Need to wrap around backwards? BNE 20$ ;No ADD #,@R1 ;Yes, bump to top of buffer 20$: DEC (R1)+ ;Back up pointer DEC @R1 ;Decrease character count 30$: 40$: TST TTCNFG ;RUBOUT on a scope? BPL 50$ ;No, enclose it in '\'s JSR R5,ECHO ;Yes, echo BS and SPACE .ASCII MOV #,R4 ;Set to send final BS CALL TTOPT4 ;Do it... BR 65$ ;See if there is more to do (^U) ............ 50$: CMPB RIFLAG,# ;Processing a CTRL-U? BEQ 65$ ;Yes, but on tty, do it without echo MOV R4,-(SP) ;Save character being rubbed CMPB @R5,R0 ;Was last character typed a RUBOUT? BEQ 60$ ;Yes, we are already in a '\' sequence MOV R0,@R5 ;No, set 'RUBOUT' as previous character typed JSR R5,ECHO ;Type the leading '\' .ASCII "\" 60$: MOV (SP)+,R0 ;Restore the MOV R0,R4 ; character to delete CALL TTOPT3 ;Output the character (w/conversions) 65$: CMPB RIFLAG,# ;Are we processing a ^U? BEQ 10$ ;Yes, then we may have more to do... RETURN ;Nope, all done... ............ .IF NE SYT$K .SBTTL XPROC - Process ^X Sequence Characters ;+ ; XPROC - Process ^X sequence characters ; ; ^X is typed to change the job that a shared console is talking to. When ; typed, the monitor prompts with 'Job? '. A logical job name ( =< 6 chars) ; is then entered. If the job exists and is running, the console is connected ; to that job. All further input is directed to that job. When in a CTRL/X ; sequence, RUB and ^U are valid. CTRL/X sequences are terminated by CR, LF, ; or ^Z. ^C will abort a ^X sequence. ; ; When ^X is typed, XFLAG is made non-zero. Up to 6 subsequent characters ; are stored in a 6 character buffer, XBUFF. If more than 6 characters are ; entered, the bell is rung. When EOL (CR,LF,^Z) is detected, the name ; in the buffer is checked against existing logical job names. If it ; is found, the impure pointer of that job is stuffed in TTIUSR. If the ; job name is not found, or the job is no longer running, ? is echoed. ;- XPROC:: .ADDR #,R3 ;R3 -> previous character ;>>>$REL CMPB R0,# ;CTRL/U typed? BEQ 100$ ;Yes, process it CMPB R0,# ;RUBOUT typed? BEQ 110$ ;Yes, process RUBOUT CMPB @R3,# ;Was previous character a rubout? BNE 70$ ;No TST TTCNFG ;Yes, but is it a scope? BMI 70$ ;Yes JSR R5,ECHO ;No, echo \ to close out rubouts .ASCII "\" 70$: MOV R0,R4 ;Copy character for echoing CMPB #,R0 ;Is it a CR? BEQ 80$ ;Yes, treat like EOL CALL EOLTST ;Is it EOL? (LF, ^Z) BEQ 80$ ;Yes, find the job MOVB -(R3),R1 ;R1 = character count CMP #,R1 ;Room in buffer? BEQ DING ;If 6 chars already there, no room, ding him INC R1 ;Bump character count MOVB R1,(R3)+ ;Store char count MOVB R0,(R3)+ ;Save character in 'previous char' ADD R3,R1 ;Point to buffer position MOVB R0,@R1 ;Stuff char CALLR TTOPT3 ;Echo it, and leave ............ 80$: TST (R3)+ ;R3 -> XBUFF MOV R3,R0 ;Copy into R0 for FNDJOB CALL FNDJOB ;Convert to impure pointer pointer BEQ 90$ ;No such job MOV R2,R0 ;R0 -> impure area BIT #,I.BLOK(R0) ;Is he running? BNE 90$ ;No CLR XFLAG ;Say we're done with ^X sequence .ADDR #,R4 ;R4 -> console output owner ;>>>$REL CLR (R4)+ ;Clear so ID always printed. R4->TTIUSR CALLR XCOM ;Merge with common ^F, ^B code ............ 90$: JSR R5,ECHO ;Output a question mark .ASCII "?" CALL ECHOCL ;Tack on a CR-LF CLR XFLAG ;Say we're done with ^X sequence ;Do this here so chars will echo even ;If TTOUSR is in ^O state RETURN ............ 100$: CALL ECHOR0 ;Echo ^U DEC R3 ;Setup R3 (it's -> XPREV now) CALL XRESET ;Initialize ^X data area (R3 -> XCOUNT) CALLR ECHOCL ;Echo a CR-LF, leave ............ 110$: MOV R3,R5 ;Copy pointer to XPREV MOVB -(R3),R1 ;Get count of characters in X buffer BEQ TIERBL ;None, clear XPREV, echo and leave ADD R5,R1 ;R1 -> char-1 INC R1 ;R1 -> char MOVB @R1,R4 ;R4 = char to delete CLRB @R1 ;Erase character DECB @R3 ;Decrease count by one BR 40$ ;Merge with common code ............ .ENDC ;NE SYT$K .DSABL LSB .SBTTL CTRL$R - Process CTRL/R Input .ENABL LSB CTRL$R::CLR -(SP) ;Count of characters to echo MOV @R1,-(SP) ;Save current character count BEQ 50$ ;Input ring buffer is empty... ; Here we scan backwards through the input ring buffer until we ; encounter 1) a line terminator or 2) the first character in the ring MOV (R1),R0 ;R0 -> last character placed in ring BR 15$ 10$: DEC @SP ;Any more characters to check? BLE 20$ ;Nope... 15$: MOVB @R0,R4 ;R4 = a previous character CALL EOLTST ;Is it a line termintor? BEQ 20$ ;Yes... INC 2(SP) ;Bump count of characters to echo DEC R0 ;Back up pointer CMP R0,(R1) ;Time to wrap backwards? BHIS 10$ ;Nope... ADD #,R0 ;Yes, update pointer BR 10$ 20$: TST 2(SP) ;Any characters to echo? BEQ 50$ ;Nope... MOV R0,@SP ;@SP -> Earliest character checked ; should be one before first to print MOV #CTRLR,R0 ;R0 = CTRL/R CALL ECHOR0 ;Echo it CALL ECHOCL ; followed by BR 35$ ; Now we echo characters, one at a time, until the last ; character in the buffer 30$: CLR R4 ;Avoid sign extend BISB @(SP),R4 ;Get a character CALL TTOPT3 ; and echo it (w/conversions) 35$: INC @SP ;Bump pointer CMP @SP,(R1) ;Time to wrap forwards? BLO 40$ ;Nope... SUB #,@SP ;Yes... 40$: DEC 2(SP) ;Reduce count of characters to echo BGE 30$ ;More to do... 50$: CMP (SP)+,(SP)+ ;Discard two elements from stack RETURN .DSABL LSB .SBTTL INLST - Special Input Character List And Macro .MACRO INLST LOC,CHAR ... = < LOC - TTIBAS > / 2 .ASSUME ... GE -177 MESSAGE=<...;Dispatch range too big - 'LOC> .ASSUME ... LE +177 MESSAGE=<...;Dispatch range too big - 'LOC> .BYTE ..., CHAR .ENDM INLST ;+ ; TTOID points to a job ID area when one is being printed. ; The job ID is "B>" for background, similar for FG. ; TTIUSR/TTOUSR point to the impure areas of the jobs currently ; controlling the TTY input and output, respectively. ;- TTOID: .WORD 0 ;Points to ID when ID print in progress TTOUSR::.WORD BKGND ;Initially background controls TTY output ;>>>$Rel .-2 BKGND RMON TTIUSR::.WORD BKGND ;Initially background controls TTY input ;>>>$Rel .-2 BKGND RMON ; The following list is in two parts. The first part is the list of ; control characters processed at all times. The second part is the ; list of control characters not processed when is in ; special mode. LIST:: INLST CTRL.C, CTRLC INLST CTRL.O, CTRLO INLST CTRL.S, CTRLS INLST CTRL.Q, CTRLQ LISTFB:: .IF EQ SB INLST CTRL.F, CTRLF INLST CTRL.B, CTRLB .IF NE SYT$K INLST CTRL.X, CANCEL .ENDC ;NE SYT$K .ENDC ;EQ SB .BYTE 200 ;End of general list INLST CTRL.R, CTRLR INLST CTRL.U, CTRLU INLST RUB, RUBOUT .BYTE 0, 0 ;Unused, patchable to handle .BYTE 0, 0 ;BRACE (175) and TILDE (176) .BYTE 0 .EVEN .SBTTL TT - Character Output Subroutines .ENABL LSB .SBTTL ECHOR0 - Print A Control Character In "^X" Form ;+ ; ECHOR0 - Print a control character in "^X" form ; ; R0 = character to print (normally 0 - 37) ; ; CALL ECHOR0 ; ; R2 = undefined ; R4 = original character ! 100 ; C=0 if successful ; Character(s) in ring ; Output interrupts enabled ; C=1 if no room in output ring ; The uparrow may be lost without warning ;- ECHOR0: MOV #<'^>,R4 ;Get the leading uparrow CALL TTOPT3 ;Send it out MOV R0,R4 ;Copy the control character BIS #,R4 ;Make it visible .BR TTOPT3 ; and print it ............ .SBTTL TTOPT3 - Print A Character, Check For Special Changes ;+ ; TTOPT3 - Print a character, check for special changes: ; CTRL/C not printed ; ESCAPE changed to $ ; 0-10, 16-37 printed as "^X" ; Other characters printed unchanged ; ; R4 = Character to print ; ; CALL TTOPT3 ; ; R2 = Undefined ; R4 = (Last) character printed (different if changed as above) ; C=0 if successful ; Character in ring ; Output interrupts enabled ; C=1 if no room in output ring ; If "^X" form, the "^" is discarded without warning ;- TTOPT3::CMPB #,R4 ;Is this a CTRL/C? BEQ 60$ ;Don't echo it if so CMPB #,R4 ;Is this an ESCAPE? BNE 10$ ;No MOV #<'$>,R4 ;Yes, echo ESCAPE as dollar sign 10$: CMPB #<' >,R4 ;Is it printable? BLOS TTOPT4 ;Yes, just print it CMPB #,R4 ;Is it above a carriage RETURN? BLO ECHOR0 ;Yes, echo in uparrow mode CMPB #,R4 ;Is it below a TAB? BHI ECHOR0 ;Yes, echo non-special in uparrow mode .BR TTOPT4 ;Fall into TTOPT4 to print the character ............ .SBTTL TTOPT4 - Print A Character For TTIUSR ;+ ; TTOPT4 - Print a character for TTIUSR ; ; R4 = character to print ; ; CALL TTOPT4 ; ; R2 = undefined ; C=0 if successful ; Character in ring ; Output interrupts enabled ; C=1 if no room in output ring ;- TTOPT4::MOV TTIUSR,R2 ;Put characters into input owners buff .BR TTOPT2 ............ .SBTTL TTOPT2 - Print A Character For Specified User ;+ ; TTOPT2 - Print a character for a specified user ; ; R2 -> impure area of user ; R4 = character to print ; ; CALL TTOPT2 ; ; R2 = undefined ; C=0 if successful ; Character in ring ; Output interrupts enabled ; C=1 if no room in output ring ; ; Notes: ; o Modified to occasionally open a window for output ; interrupts to output buffer can empty for more ;- TTOPT2::ADD #,R2 ;Point to output count in impure area .IF NE SYT$K TSTB XFLAG ;^X sequence in progress? BNE 20$ ;Yes, always send the character .ENDC ;NE SYT$K TST @R2 ;Is CTRL/O in effect? BMI 60$ ;If so, act like success 20$: .IF NE VENU$C BIT #,@#$JSW ;"PASSALL"? BNE 30$ ;Yes .ENDC ;NE VENU$C BICB #,R4 ;Remove parity bit .IF NE VENU$C 30$: .ENDC ;NE VENU$C 32$: CMPB #,@R2 ;Will this fit in the output ring? BHIS 34$ ;Yes... GETPSW ;Get current SPL level SPL 0 ;Lower it for a brief time NOP ; to allow an output interrupt PUTPSW ;Restore previous priority BR 32$ ; and go check again 34$: CMP I.OTOP-I.OCTR(R2),-(R2) ;Time to wrap buffer? BHI 40$ ;No SUB #,@R2 ;Point back to beginning of ring buffer 40$: MOVB R4,@(R2)+ ;Insert character in ring INC -(R2) ;Bump 'PUT' pointer INC I.OCTR-I.OPUT(R2) ;Bump count (after pointer to avoid race!) CALLR TTOENB ;Enable output interrupts ............ .SBTTL ECHO0C - Print Control Character, Then 1 Or 2 Constant Characters ;+ ; ECHO0C - Print control character, then 1 or 2 constant characters ; ; R0 = character to print ; ; JSR R5,ECHO0C ; .BYTE char1,char2 (if char2 = 0, only one character is printed) ; ; R2 = undefined ; R4 = char2 ; C=0 if successful ; Characters in ring ; Output interrupts enabled ; C=1 if no room in output ring ; All but the last character may be lost without warning ;- ECHO0C: CALL ECHOR0 ;First echo ^ [R0] .BR ECHO ............ .SBTTL ECHO - Print 1 Or 2 Constant Characters ;+ ; ECHO - Print one or two constant characters ; ; JSR R5,ECHO ; .BYTE char1,char2 (if char2 = 0, only one character is printed) ; ; R2 = undefined ; R4 = char2 ; C=0 if successful ; Characters in ring ; Output interrupts enabled ; C=1 if no room in output ring ; All but the last character may be lost without warning ;- ECHO:: MOVB (R5)+,R4 ;Get first character CALL TTOPT4 ;Print it MOVB (R5)+,R4 ;Get second character BEQ 50$ ;Ignore nulls CALL TTOPT4 ;Print second character 50$: RTS R5 ............ .SBTTL EOLTST - Test For End Of Line ;+ ; EOLTST - Test for end of line ; ; R4 = input character ; ; CALL EOLTST ; ; Z=1 if end of line ; Z=0 if NOT end of line ;- EOLTST: CMPB #,R4 ;Is it a LINE FEED? BEQ 60$ ;Yes, return with Z-bit set CMPB #,R4 ;No, is it a CTRL/Z? BEQ 60$ ;Return Z=1 if so CMPB #,R4 ;Is it ^C? set Z-bit 60$: RETURN ............ .IF NE VENU$X .SBTTL TTOPT5 - Print A Character For Specified User (programmed req. only) ;+ ; TTOPT5 ; ; This is a copy of TTOPT2 that is only for programmed requests, i.e., ; requests that come in at priority 0. This prevents the output ; buffer pointers from possibly being messed up if an interrupt comes ; in in TTOPT2 when the buffer pointer is being pushed back to the ; beginning. ;- TTOPT5::ADD #,R2 ;Point to output count in impure area .IF NE SYT$K TSTB XFLAG ;^X sequence in progress? BNE 70$ ;Yes, always send the character .ENDC ;NE SYT$K TST @R2 ;Is CTRL/O in effect? BMI 110$ ;If so, act like success 70$: .IF NE VENU$C BIT #,@#$JSW ;"PASSALL"? BNE 80$ ;Yes .ENDC ;NE VENU$C BICB #,R4 ;Remove parity bit .IF NE VENU$C 80$: .ENDC ;NE VENU$C SPL 5 ;Raise priority so we can't be interrupted CMPB #,@R2 ;; Will this fit in the output ring? BLO 100$ ;; No, return C=1 for failure CMP I.OTOP-I.OCTR(R2),-(R2) ;; Time to wrap buffer? BHI 90$ ;; No SUB #,@R2 ;; Point back to beginning of ring buffer 90$: MOVB R4,@(R2)+ ;; Insert character in ring INC -(R2) ;; Bump 'PUT' pointer INC I.OCTR-I.OPUT(R2) ;; Bump count (after pointer to miss race!) SPL 0 ;; Return priority to what it was CALLR TTOENB ;Enable output interrupts ............ 100$: SPL 0 ;; Return priority to what it was SEC ;Set carry for error 110$: RETURN ;RETURN ............ .DSABL LSB .ENDC ;NE VENU$X .SBTTL TTOINT - TTY Output Interrupt .ENABL LSB 10$: DEC NFILLS ;Count down number of fills left .BR NULHOK ............ ;+ ; NULHOK (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; CALL NULHK ; ; NULHK sends a null to the video output on the PRO300 series processor ;- NULHOK:: ;(*** PRO300 HOOK***) CLR @TTPB ;Put out a null .ASSUME <.-NULHOK> EQ 4 CALLR @$XTTPB ;Get char from TTPB ............ TTOINT::JSR R5,$INTEN ;;; Do usual interrupt entry .WORD < ^c & PR7 > ; (at PR4) .IF NE VENU$C BITB #,@TTPS ;Do we have input or output ?? BEQ 20$ ;BR if this is output CALLR TTIINT ;Not output, get the input ............ 20$: .ENDC ;NE VENU$C TST (PC)+ ;Doing null filling now? NFILLS: .WORD 0 ;Number of fills left to do BNE 10$ ;Yes, send another null .IF NE VENU$C TSTB XEDOFF ;XOFF given? BPL 30$ ;No, continue CALLR HKPC12 ;Yes, stop output (turn off transmtr) ............ .IFF ;NE VENU$C TSTB (PC)+ ;XOFF given? XEDOFF: .WORD 0 ;XON/XOFF flag BMI 170$ ;Yes, stop output .ENDC ;NE VENU$C 30$: .ADDR #,R4 ;Point to filler for TAB, FF, or CR/LF at EOL ;>>>$REL INCB @R4 ;Another filler? BMI 160$ ;Still filling, put it out CLRB (R4)+ ;Fix fill counter, pop R4 .IF EQ SB MOV TTOID,R5 ;Printing an ID? BEQ 60$ ;No 40$: MOVB (R5)+,(R4)+ ;Yes, set up character of ID BNE 50$ ;Got one CLR R5 ;No more, end of ID 50$: MOV R5,TTOID ;Save new TTOID BNE 160$ ;Put out character DEC R4 ;Fix next character pointer .ENDC ;EQ SB 60$: MOV TTOUSR,R5 ;Point to impure area of output user .IF NE SYT$K TSTB XFLAG ;^X sequence in progress? BNE TTONXT ;Yes, don't change ownership, put next char .ENDC ;NE SYT$K TSTB I.OCTR(R5) ;Is there anything to output? BNE 70$ ;Yes, output ring not empty JSR R4,UNBLOK ;Unblock job if waiting for output buff. empty .WORD TTOEM$ 70$: .IF EQ SB CMPB @R4,# ;Time to arbitrate? BNE 100$ ;No MOV IMPLOC,R4 ;Yes, point to job tables 80$: MOV -(R4),R5 ;Get an impure area pointer BEQ 80$ ;No job here CMP #<-1>,R5 ;End of table? .IF NE SYT$K BEQ 23$ ;Yes, nobody wants to talk (HKPC12 is too far) .IFF ;NE SYT$K BEQ HKPC12 ;Yes, nobody wants to talk .ENDC ;NE SYT$K BIT #,I.BLOK(R5) ;Job already dead? BNE 80$ ;Yes, he can't output CMP (PC)+,R5 ;Is he using the TT: for output? (imp ptrs =) TTHOUS: .WORD 0 ;-> impure area of TT handler output user BEQ 90$ ;Yes, ergo he can speak TSTB I.OCTR(R5) ;Does this job have output? BEQ 80$ ;No, try another 90$: .ADDR #,R4 ;Restore output character pointer ;>>>$REL CMP TTOUSR,R5 ;Is output side's ownership changing? BEQ 100$ ;No, do not print ID MOV R5,TTOUSR ;Change output side user MOV I.TID(R5),R5 ;Get ID pointer BR 40$ ; and print the new user's ID ............ .IF NE SYT$K 22$: TSTB XFLAG ;^X ID need to be printed? 23$: BPL HKPC12 ;No, done ASLB XFLAG ;Yes, fix the flag so we don't print ID again MOV #,R5 ;Point to the prompt string to print ZZZZZZ ==: .-2 ;relocated by BSTRAP ;>>>$REL MOV R5,TTOID ;Set it BR 40$ ; and start printing it .ENDC ;NE SYT$K 100$: CMP TTHOUS,R5 ;Is this job using the TT: handler? .IFF ;EQ SB 100$: CMP (PC)+,R5 ;Is this job using the TT: handler? TTHOUS: .WORD 0 ;-> impure area of TT handler output user .ENDC ;EQ SB BEQ TTHOUT ;Do special stuff if so TTONXT: CMPB I.OCTR(R5),(PC)+ ;Should we unblock this job? ..TTON:: .WORD TTBF$O ;**PATCH** Terminal output wake-up threshold BNE 110$ ;No, not yet or not waiting JSR R4,UNBLOK ;Unblock job if waiting room in output buffer .WORD TTOWT$ 110$: ADD #,R5 ;Point to ring pointers CMP @R5,-(R5) ;Time to wrap? BNE 120$ ;No SUB #,@R5 ;Yes, wrap to start of ring 120$: TSTB -2(R5) ;Anything to print? .IF NE SYT$K BEQ 22$ ;No, check for ^X ID now that printer is quiet .IFF ;NE SYT$K BEQ HKPC12 ;No, go shut off the output side .ENDC ;NE SYT$K MOVB @(R5)+,@R4 ;Get a byte to print TTOPUT: .IF NE VENU$C BIT #,@#$JSW ;"PASSALL"? BEQ 130$ ;No TSTB (R4)+ ;Yes, just print it. Point R4 to correct place BR 150$ ; and away ............ 130$: .ENDC ;NE VENU$C BICB #,@R4 ;Make it 7 bit ASCII (mask off parity bit) CMPB (R4)+,# ;Is it printable? BLO 180$ ;Maybe not CMPB -1(R4),# ;RUBOUT character? BEQ 150$ ;Yes INCB @R4 ;Yes, bump line position BIT #,TTCNFG ;Does he want free CRLF's? BEQ 150$ ;No, just print it CMPB @R4,TTWIDTH ;Is the carriage past the right margin? BLOS 150$ ;Not yet CLRB @R4 ;Yes, clear line position DEC R4 ;Back off pointer MOV (PC)+,-(R4) ;Set to do 1 fill of LF at next interrupt .BYTE ,<-2> BR 160$ ;Don't touch the ring, but go print a ............ 140$: CMPB (R4)+,# ;Is special a CR? BNE 150$ ;No CLRB @R4 ;Yes, clear line position 150$: INC -(R5) ;Bump output ring pointer DEC -(R5) ;Count down characters ;+ ; PC1HOK (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; CALL PCHHK1 ; ; PCHHK1 sends the character at -(R4) to the PRO300 series video ;- PC1HOK:: ;(*** PRO300 HOOK ***) 160$: MOVB -(R4),@TTPB ;Print the character .ASSUME <.-PC1HOK> EQ 4 CALL @$XTTPB ;Get char from TTPB CMPB @R4,@#$TTFIL ;Does it need fillers? BNE 170$ ;No MOVB @#$TTNFI,NFILLS ;Yes, set them up for next time 170$: RETURN ;Return from interrupt ............ TTHOCM: CALL TTCMPL ;Call completion function for TT: output JMP 30$ ;Try the interrupt again ............ 180$: CMPB -(R4),# ;Are we printing a TAB? BEQ 190$ ;Yes, do TAB expansion if necessary CMPB (R4)+,# ;A BACKSPACE? BEQ 220$ ;Yes, decrease position if scope CMPB -(R4),# ;Is it a FORM FEED? BNE 140$ ;No, go check for CR BIT #,TTCNFG ;Does he have hardware FORM FEEDS? BNE 210$ ;Yes, do not simulate MOV (PC)+,-(R4) ;Simulate eight LINE FEEDS .BYTE ,<-8.> BR 210$ ;Go send it ............ 190$: BIT #,TTCNFG ;Hardware TABS? BNE 200$ ;Yes, simply adjust the position MOV @R4,-(R4) ;Move current LINPOS to FILLCTR CLRB @R4 ;Clear byte for 'BIS' BIS (PC)+,@R4 ;Set to fill with blanks .BYTE ,<-8.> 200$: ADD #<8.*400>, ;Fix up line position ... BIC #<7*400>, ; ... by rounding to next TAB stop 210$: INC R4 ;Bump pointer BR 150$ ;Put it out ............ 220$: TST TTCNFG ;Is scope mode on? BPL 150$ ;No, is not special DECB @R4 ;Yes, back up the line position ... BR 150$ ; ... and send the ............ ;+ ; HKPC12 (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; CALL PIHK12 ; ; PIHK12 turns off video output interrupts on the PRO300 series processor ;- HKPC12:: ;(*** PRO300 HOOK ***) .IF EQ VENU$C .IF EQ PDT$OP BIC #,@TTPS ;No output, turn off TTY .IFF ;EQ PDT$OP CLR @TTPS ;No output, turn off TTY NOP .ENDC ;EQ PDT$OP .ASSUME <.-HKPC12> EQ 6 .IFF ;EQ VENU$C MOVB @TTKCR,-(SP) ;Read command register data BICB #,@SP ;Clear Transmit Enable bit, (i.e., disable it) MOVB (SP)+,@TTPCR ;Write data to command register .ENDC ;EQ VENU$C CALLR @$XTTPS ;TTPS may have been changed .DSABL LSB .SBTTL TTHOUT - Resident TT: Output Interrupts .ENABL LSB TTHOUT: TST I.OCTR(R5) ;If he hit ^O BMI TTHOCM ; complete very quickly BEQ 10$ ;Output ring empty, so start write request BIT #,I.TERM(R5) ;Were characters there before .WRITE? BEQ TTONXT ;Yes, let them be printed 10$: BIS #,I.TERM(R5) ;.WRITE is starting, make .TTYOUT's wait MOV TTCQE,R5 ;Point to queue element ADD #,R5 ;Point to byte count 20$: TST (R5)+ ;Output complete? BEQ TTHOCM ;Yes, finish up with queue element .IF NE MMG$T MOV @#KISAR1,-(SP) ;Save PAR1 mapping BIT #,@R5 ;Overlapped PAR1 bound? BEQ 30$ ;No SUB #,@R5 ;Yes, adjust buffer ADD #,Q.PAR-Q.WCNT(R5) ; and PAR1 value 30$: MOV Q.PAR-Q.WCNT(R5),@#KISAR1 ;Map to user buffer .ENDC ;NE MMG$T MOVB @(R5)+,@R4 ;Get a byte into OUTCHR .IF NE MMG$T MOV (SP)+,@#KISAR1 ;Restore mapping TST @R4 ;Was character null? .ENDC ;NE MMG$T BNE TTOPUT ;Print non nulls INC -(R5) ;Bump byte pointer to skip null DEC -(R5) ;Decrement character counter BR 20$ ;Loop ............ .DSABL LSB .IF NE HSR$B .SBTTL TTIINT - High Speed Ring Buffer For Terminal Input .ENABL LSB TTIINT::MOV R0,-(SP) ;;; Save registers PHSRRT ==: < . + 2 > ;**BOOT** Relocate address of HSRB pointers table MOV #,R0 ;;; R0 -> high speed ring pointers ;>>>$Rel .-2 HSRB RMON ;CT++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ MOVB @TTKB,@(R0)+ ;;; Store character in buffer ;CT-------------------------------------------------------------------- INC -(R0) ;;; Increment buffer pointer CMP (R0)+,(R0)+ ;;; At end of buffer? BLO 10$ ;;; No MOV @R0,HSRB ;;; Reset buffer pointer 10$: MOV (SP)+,R0 ;;; Restore other register INC HSRBCC ;;; Increment character count BEQ 20$ ;;; First in buffer, start working on it RTI ;;; Let us get out of here ASAP ............ 20$: JSR R5,$INTEN ;;; Notify monitor of interrupt .WORD < ^c & PR7 > ; (resume at PR4) JSR R5,$FORK ;Drop to FORK level .WORD PHSRRB ==: < . + 2 > ;**BOOT** Relocate address of HSRB pointers table 30$: MOV #,R5 ;R5 -> high speed ring buffer ;>>>$Rel .-2 HSRBGP RMON MOVB @(R5)+,R4 ;Get next character from high speed ring INC -(R5) ;Increment character pointer CMP @R5,HSRBEP ;End of buffer? BLO 40$ ;No MOV HSRBRP,@R5 ;Yes, reset buffer pointer 40$: CALL TTISTF ;Call terminal service DEC HSRBCC ;Decrement character counter BPL 30$ ;More in high speed ring buffer, go do it RETURN ;Bye ............ ;+ ; High Speed Ring Buffer Table ;- HSRB:: .WORD HSRBUF ;-> Input side of ring buffer (PUT pointer) ;>>>$Rel .-2 HSRBUF RMON HSRBEP::.WORD HSRBUE ;-> End of ring buffer ;>>>$Rel .-2 HSRBUE RMON HSRBRP::.WORD HSRBUF ;-> Beginning of ring buffer ;>>>$Rel .-2 HSRBUF RMON HSRBCC::.WORD -1 ;Character count HSRBGP::.WORD HSRBUF ;-> Output side of ring buffer (GET pointer) ;>>>$Rel .-2 HSRBUF RMON HSRBUF::.BLKB HSRBSZ ;High speed ring buffer HSRBUE:: ;End of high speed ring TIFBLK::BSS < F.BSIZ / 2 > ;FORK block .DSABL LSB .ENDC ;NE HSR$B .ENDC ;EQ MTT$Y ;From many pages back at IGET .SBTTL .SPFUN - Special I/O Function EMT ;+ ; Special function calls look like READ EMT's, but the 3rd ; word of the arg list is in the form .BYTE 377,CODE ; where code is the function to be done. Word 4 contains the actual ; completion function ;- .ENABL LSB S$PFUN: MOV @R3,R2 ;Get CSW status word BPL 80$ ;Channel is closed BIC #^c,R2 ;Isolate device index ADD PC,R2 ;Pic code is fun BIT $STAT-.(R2),# ;Is this a special device? ;>>>$REL BEQ RWXT ;Yup, ignore the strange call TST (R1) ;Did he ship us a positive code? BPL RWXTE0 ;Yup, ship him back an error 0 ; BISB #<3>,(R1) ;Make sure the A.FUNC/A.SRTN ; indicator is on BR SPREAD ;Branch to common code ............ .IF EQ SB .SBTTL .RCVD - Receive Data EMT ;+ ; RCVD points R3 to the pseudo message channel in the impure area, ; and falls into the normal READ code. If the other job isn't present, ; ERROR 0 is generated as if from a READ request. If the request is issued ; from other than the foreground or background, ERROR 0 is generated. ;- R$CVD: CALL MSGSET ;Do common set up BCS RWXTE0 ;Error, no other job .BR R$EAD ;Fall into READ code ............ .ENDC ;EQ SB .SBTTL .READx - Read From Device EMT (.READ/C/W) ;+ ; "I'm quite illiterate, but I read a lot." ; - J.D. Salinger, "The Catcher in the Rye" ; ; Notes: ; R3 -> Channel status word of channel definition block ; ;- R$EAD: SPREAD: JSR R4,TSWCNT ;Do some checking NOP ;Non-file or directory, ignore fact NOP ;Ignore if read was shortened ...... MOV R4,@SP ;Set word count for R0 10$: TST -(R1) ;Fix pointer to arg list .Assume C.CSW EQ 0 BIT #,@R3 ;Hard error or end of file? BNE 50$ ;Yes, report it MOV R1,R5 ;Point R5 to arg list .Assume C.CSW EQ 0 MOV @R3,R2 ;Isolate entry value of handler BIC #^c,R2 ADD PC,R2 ;In a pic manner, MOV <$ENTRY-.>(R2),R2 ;Point to entry point ;>>>$REL BEQ 20$ ;No handler! Zounds, man! ADD C.SBLK(R3),R0 ;Make block absolute MOV C.DEVQ(R3),R1 ;Unit number to R1 CALL QMANGR ;Queue the request .Assume C.CSW EQ 0 BIT #,@R3 ;Hard error or end of file? BNE 50$ ;Yes, report it .IF NE SB R$CVD: S$DAT: .ENDC ;NE SB RWXT: MOV #<3>,R2 ;3 arguments to clean up CALLR EMTDON ............ 20$: MONERR NODV ;No device handler BR RWXT ............ 30$: TST (SP)+ ;Purge stack CLR @SP ;Zero word count on error 40$: .Assume C.CSW EQ 0 BIC #,@R3 ;Clear eof bit RWXTE0: EMTER0 BR 90$ ............ .Assume C.CSW EQ 0 50$: BIT #,@R3 ;Hard error? BEQ 40$ ;No, must have been end of file .Assume C.CSW EQ 0 BIC #,@R3 ;Clear error bit 60$: EMTER1 BR RWXT ............ 70$: TST (SP)+ 80$: EMTER2 90$: CLR @SP ;Clear word count BR RWXT ............ .IF EQ SB .SBTTL MSGSET - .SDAT/.RCVD Common Set Up ;+ ; MSGSET - .SDAT/.RCVD Common set up ; ; MSGSET checks to see of the other job is running. If not, or if ; we aren't either the foreground or background job, ERROR 0 is generated ; ; R5 -> our impure area ; ; CALL MSGSET ; ; R2 = undefined ; R3 -> our message channel ; C=1 if no other job or illegal job ;- MSGSET: CALL OTHRJB ;Does other job exist and is it running? BCS 100$ ;No, give ERROR 0 MOV R5,R3 ;Copy impure pointer to R3 ADD #,R3 ;R3 -> message channel in impure area 100$: RETURN ............ .SBTTL .SDAT - Send Data EMT ;+ ; SDAT is similar to WRITE. R3 is pointed to the other job's ; channel and then a WRITE is executed on the message ; pseudo channel. If the other job is not in core, ; the error 0 return is taken. ;- S$DAT: CALL MSGSET ;Do common setup BCS RWXTE0 ;Error, no other job or illegal job .BR W$RITE ;Fall into WRITE code ............ .ENDC ;EQ SB .SBTTL .WRITx - Write To I/O Device EMT (.WRITE/C/W) ;+ ; "Their manner of writing is very peculiar, being neither from the ; left to the right, like the Europeans; nor from the right to the ; left, like the Arabians; from up to down, like the Chinese; nor ; from down to up, like the Cascagians" ; - J. Swift, "Gulliver's Travels" ;- W$RITE: JSR R4,TSWCNT BR NFWRIT ;Non file or directory operation ...... EMTER0 ;Give error if shortened, but do it .Assume C.CSW EQ 0 BIT #,@R3 ;Is file read-only? BNE 60$ ;Yes, then no WRITE, hard error instead CMP R5,C.USED(R3) ;Check for going over highest written BLOS NFWRIT ;>>>eliminate this test and always update c.used? .Assume C.CSW EQ 0 .Assume DWRIT$ EQ 200 TSTB @R3 ;Entered? BPL NFWRIT ;No MOV R5,C.USED(R3) NFWRIT: MOV R4,@SP ;Word count for R0 NEG R4 ;Make it a write BR 10$ ;Do common stuff ............ .SBTTL TSWCNT - READ/WRITE Common Routine ;+ ; "'So it does!' said Pooh. 'It goes in!' ; 'So it does!' said Piglet. 'And it comes out!' ; 'Doesn't it?' said Eeyore. ; -A.A. Milne, "Winnie the Pooh" ; ; ; TSWCNT - Do validity checking for .READ and .WRITE ; ; R0 = block number (usually set by EMT dispatcher) ; R1 -> argument list: address, word count ; R2 = completion function (0=wait, 1=no-wait, other=compltn-routine) ; R3 -> I/O channel at CSW ; ; JSR R4,TSWCNT ; Return if NFS device (or NFS operation) or directory I/O ; Return if word count was shortened because of EOF ; Successful Return ; ; R1 -> word count in argument list ; R2 = random ; R4 = word count (shortened so as not to READ/WRITE past EOF) ; R5 = highest block written (+1) (not set if NFS return taken) ; EOF$ turned off in channel if file structured ; ; Checks: ; Operation entirely within user memory (MONERR addr if not) ; Completion routine, if given, is within user memory ; Channel is open (ERROR 2 if not) ; Transfer starts before EOF (ERROR 0 if not, WC to user is 0, EOF$ off) ;- TSWCNT:: ;I&D+ MOV @R1,@SP ;Virtual buffer address to old R4 .IF NE SUP$Y CLR -(SP) ;Make room for mode/space argument .ENDC ;NE SUP$Y MOV (R1)+,-(SP) ;Copy virtual buffer address ;I&D- MOV (R1)+,-(SP) ;Stack the word count BEQ 110$ ; and don't mess up SEEK DEC @SP ;Minus 1 for last word of transfer ASL @SP ;Doubled to make word count into byte count 110$: ADD (SP)+,@SP ;Compute address of last word read or written ;I&D+ MOV R1,R2 ;R2 -> A.SPFU special flag code CALL IOTYPE ;Get mapping bits and whether it's special .IF EQ SUP$Y BCS 130$ ;Check start address only .IFF ;EQ SUP$Y MOV @SP,4(SP) ;*C* Copy mode/space argument for start addr BCC 120$ ;Branch if not special function or directory BIT (SP)+,(SP)+ ;Dump end address and mode/space argument BR 140$ ;Check start address only ............ .ENDC ;EQ SUP$Y 120$: JSR R5,CHKSP1 ;Check validity of virtual end address BR TSERR1 ;Quit now if invalid ...... 130$: TST (SP)+ ;Dump virtual end address 140$: JSR R5,CHKSP1 ;Check validity of virtual start address BR TSERR ;Quit now if invalid ...... ;TSWSPC: ;I&D- CMP R2,#<..ISIO> ;Doing completion I/O? BLOS 150$ ;No, no address to check MOV R2,@SP ;Yes, stack the completion routine address JSR R5,CHKSPI ; and check it out BR TSERR ;Quit if bad address ...... 150$: MOV -(R1),R5 ;Word count to R5 MOV R5,@SP ;Return word count in R4 MOV @R3,R2 ;Get device index in R2 BPL 70$ ;If channel closed, give ERROR 2 right now BIC #^c,R2 ;Isolate device index ADD PC,R2 ;Picly, TST <$STAT-.>(R2) ; see if file structured device ;>>>$REL BPL TSWOUT ;No, let transfer go and take first return BIC #,@R3 ;Clear EOF bit for file structured device TST C.SBLK(R3) ;Start block 0? BEQ TSWOUT ;Yes, probable directory operation, 1st exit .BR 160$ ;Fall through ............ 160$: CMP (R4)+,(R4)+ ;Bump to successful return address MOV C.LENG(R3),R2 ;Get number of blocks allocated to file CMP R0,R2 ;Does transfer start before end of file? BHIS 30$ ;No, give EOF error right now ADD #,R5 ;Round up word count to blocks CLRB R5 ;Clear out low bits SWAB R5 ;Compute number of blocks affected ADD R0,R5 ;Compute highest block number (+1) SUB R5,R2 ;Sets Carry if passes EOF BHIS TSWOUT ;Success if transfer all within file ADD R2,R5 ;R5 = last block in file (+1) MOV R5,@SP ;Compute actual number words to transfer SUB R0,@SP ; " SWAB @SP ; " TST -(R4) ;Back off to shortened return TSWOUT: RTS R4 ............ ;I&D+ TSERR1: .IF NE SUP$Y CMP (SP)+,(SP)+ ;Purge address and space/mode argument .IFF ;NE SUP$Y TST (SP)+ ;Purge address .ENDC ;NE SUP$Y ;I&D- TSERR: TST (SP)+ ;Purge address MONERR ADDR ;Give error BR RWXT ;And abort operation ............ .DSABL LSB .SBTTL .REOPEN - Reopen Channel After SAVESTATUS EMT .ENABL LSB R$OPEN: TST @R3 ;Channel can't be in use BMI E5ER0 ;Amazing! REOPEN is inverse of SAVE! .IF NE MMG$T MOV #,R1 ;R1 = number of bytes in channel BIT #,@#PS ;Skip address chk and map for krnl address BEQ 10$ ; CALL ACHBKM ;Point R0 to save area BCS ADERR ;BR on error 10$: .ENDC ;NE MMG$T .REPT MOV (R0)+,(R3)+ ;Replace the words .ENDR BR XCLOSE ............ .DSABL LSB .SBTTL .SAVES - SAVE STATUS OF OPEN CHANNEL EMT .ENABL LSB S$AVST: MOV @R3,R4 ;Is the channel active? BPL 10$ ;No, save inactive status MOVB R4,R1 ;Get index BPL 10$ ;'ENTER' was not done (means it was a LOOKUP) ;+ ; Allow SPECIAL/WRITEONLY devices to succeed SAVESTATUS. ;- BIC #^c,R1 ;Isolate device index ADD PC,R1 ;PIC IT MOV $STAT-.(R1),R1 ;Get entry for the device ;>>>$REL COM R1 ;Reverse bits to check special bits BIC #^c,R1 ;Device both special and write only? BNE E5ER1 ;No, invalid operation 10$: .IF NE MMG$T MOV #,R1 ;R1 = number of bytes in channel BIT #,@#PS ;Skip address chk and map for krnl address BEQ 20$ ; CALL ACHBKM ;Address check and map block BCS ADERR ;Branch on error 20$: .ENDC ;NE MMG$T MOV R4,(R0)+ ;Channel status word CLR (R3)+ ;Deactivate channel .REPT -1 ;Fill in remaining data MOV (R3)+,(R0)+ .ENDR TST R4 ;Was channel open? BMI XCLOSE ;Yes, we're done E5ER0: EMTER0 BR XCLOSE ............ ADERR:: MONERR ADDR ;Address error BR XCLOSE ;Then exit ............ .DSABL LSB .IF EQ SB ;If not SB/XB (For next page) .SBTTL .MWAIT - Wait For Message Traffic Complete EMT ;+ ; EMT12 - WAIT on I/O. This EMT returns an error if the ; channel is not active, giving a way to check to see if ; a channel is currently in use ;- M$WAIT: MOV R5,R3 ;Point to message channel ADD #,R3 .BR W$AIT ;Fall into ordinary WAIT code ............ .ENDC ;EQ SB .SBTTL .WAIT - Wait For I/O On Channel To Complete EMT W$AIT: TST @R3 ;Channel active? BPL E5ER0 ;No, error 0 CALL CHWAIT ;Yes, swap out & wait BIT #,@R3 ;Was there an error? BEQ XCLOSE ;No, return to user DEC @R3 ;Yes, clear hard error bit .ASSUME HDERR$ EQ 1 E5ER1: EMTER1 .IF NE SB M$WAIT: .ENDC ;NE SB XCLOSE: CALLR EMTRTI ............ .SBTTL .GTJB - Get Job Parameters EMT ;+ ; G$TJB - Get job parameter information ; ; R0 -> output area for parameters ; R1 -> JOBBLK argument ; -3 => return 8 words of info about this job ; -1 => return 12 words of info about this job ; 0 <= JOBBLK <= 16 and even => job number - ; return 12 words of info about specified job ; > 16, even => address of 3 words of ASCII logical job name ; return 12 words of info about specified job ; R4 = channel number, if 0 assume old style regardless of JOBBLK ; R5 -> impure area of our job ;- .ENABL LSB xJUNKx= 135353 ;junked register value for CK.XX CK.R5=I.STAT CK.R0=J.BNUM G$TJB:: NEG R4 ;Set C=1 if new style GTJB MOV #,R4 ;*C*Assume 8 word parameter block CK.R4=J.BLGH CK.R4A=J.BLGH BCC 40$ ;Always give 8 words if V3B SYSMAC CMP @R1,#<..GTV3> ;Old style (V3) GTJB? BEQ 40$ ;Yes, give him old style info ADD #,R4 ;New block is 8+4=12 words long CK.R4 ,+ CMP @R1,#<..GTME> ;New style specifying this job? BEQ 40$ ;Yes, give him information MOV R0,R3 ;Save -> to output area in R3 CK.R3=CK.R0 BIT #<1>,@R1 ;Is supplied address or job no. even? BNE E5ER0 ;No, give error 0, no such job CMP @R1,# ;Is it a job number? .IF NE SYT$K BLOS 20$ ;Yes MOV @R1,R0 ;R0 -> 3 wds of ASCII logical job name CK.R0=xJUNKx .IF NE MMG$T CALL ACHJBM ;Address check, map to logical job name .ENDC ;NE MMG$T CALL FNDJB2 ;Find impure pointer: R5 -> impure pointer CK.R5=I.STAT BNE 30$ ;Good, job exists BR E5ER0 ;Else give ERROR 0, no such job ............ 20$: .IFF ;NE SYT$K BHI E5ER0 ;no, can't do names. (no system job support) .ENDC ;NE SYT$K .IF EQ SB MOV @R1,R5 ;R5 = job number .ADDR #<$IMPUR>,R5,ADD ;R5 -> impure pointer ;>>>$REL 30$: MOV @R5,R5 ;R5 -> impure area CK.R5=I.STAT BEQ E5ER0 ;Oops, no such job .IFF ;EQ SB TST @R1 ;New style, is job number 0? BNE E5ER0 ;No such job, quit .ENDC ;EQ SB MOV R3,R0 ;Restore R0 -> output area for params Ck.R0=Ck.R3 .BR 40$ ;Fall through 40$: .IF NE MMG$T MOV R4,R1 ;R1 = number bytes to check CALL ACHBKM ;Address check, map to it BCS ADERR ;Address error .ENDC ;NE MMG$T CK.R0 J.BNUM ADD R0,R4 ;R4 -> after end of param block CK.R4 ,+J.BNUM CK.R4A ,+J.BNUM .IF EQ SB CK.R5 I.STAT MOV I.JNUM(R5),R1 ;Get job number CK.R0 J.BNUM,+2 MOV R1,(R0)+ ;Give it to him ASL R1 ;Double for table reference .ADDR #<$JBLIM>,R1,ADD ;Point to limit table ;>>>$REL .IFF ;EQ SB CK.R0 J.BNUM,+2 CLR (R0)+ ;Give him job number (always 0) .ENDC ;EQ SB .IF NE MMG$T ;+ ; (*** DBGEXE *** Following section modified for DBGEXE support.) ;- .ASSUME I.STAT EQ 0 CK.R5 I.STAT BIT #,@R5 ;Is this a completely virtual job? CK.R0A=CK.R0 BEQ 50$ ;Branch if not CK.R0 J.BHLM,+2 CK.R5 I.STAT MOV I.VSTP(R5),(R0)+ ;Get completely virtual job's high limit .IF EQ SB TST (R1)+ ;Move to next word. .ENDC ;EQ SB BR 60$ ;Merge below. ............ CK.R0A J.BHLM,+2 .IFF ;NE MMG$T CK.R0 J.BHLM,+2 .ENDC ;NE MMG$T .IF EQ SB 50$: MOV (R1)+,@R0 ;Load high limit ... .IFF ;EQ SB 50$: MOV $JBLIM,@R0 ;Load high limit ... .IFTF ;EQ SB SUB #2,(R0)+ ;Change first unusable to last available .IF NE MMG$T CK.R0 CK.R0A .ENDC ;NE MMG$T CK.R0 J.BLLM,+2 .IFT ;EQ SB 60$: MOV (R1)+,(R0)+ ; ... and low limit .IFF ;EQ SB 60$: CLR (R0)+ ; ... and low limit (=0 always for SB/XB) .ENDC ;EQ SB CK.R0 J.BCHN,+2 CK.R5 I.STAT MOV I.CSW(R5),(R0)+ ;Start of channel area CK.R0 J.BIMP,+2 MOV R5,(R0)+ ;Start of impure area CK.R0 J.BLUN,+2 .IF NE MTT$Y CK.R5 I.STAT MOV I.CLUN(R5),(R0)+ ;Unit number of job's console .IFF ;NE MTT$Y CLR (R0)+ ;Console is zero if no multiterminal .ENDC ;NE MTT$Y .IF NE MMG$T CK.R5 I.STAT CK.R0 J.BVHI,+2 MOV I.VHI(R5),(R0)+ ;Virtual high limit of job .IFF ;NE MMG$T CK.R0 J.BVHI,+2 CLR (R0)+ ;No virtual high limit .ENDC ;NE MMG$T CK.R0 ,+2+2 CMP (R0)+,(R0)+ ;Point R0 at 10th word of block .Assume CK.R4 GT CK.R0 .Assume CK.R4A LE CK.R0 CMP R0,R4 ;Only want old style block? BHI XCLOSE ;Yes, leave now .IF NE SYT$K CK.R5 I.STAT ADD #,R5 ;R5 -> logical job name CK.R5 ,+I.LNAM CK.R5 I.LNAM TST I.JNUM-I.LNAM(R5) ;Is this background job? CALL JOBKM1 ;Is BG running KMON CK.R0A=CK.R0 BPL 70$ ;Branch if not .IFTF ;NE SYT$K CK.R0 J.BLNM,+2 CLR (R0)+ ;Clear logical job name field ... CK.R0 J.BLNM+2,+2 CLR (R0)+ ; ... to indicate ... CK.R0 J.BLNM+4,+2 CLR (R0)+ ; ... KMON is running .IFT ;NE SYT$K BR XCLOSE .............. CK.R5 I.LNAM,+2 CK.R0A J.BLNM,+2 70$: MOV (R5)+,(R0)+ ;Move in jobname ... CK.R5 I.LNAM+2,+2 CK.R0A J.BLNM+2,+2 MOV (R5)+,(R0)+ ; ... 2nd word ... CK.R5 I.LNAM+4,+2 CK.R0A J.BLNM+4,+2 MOV (R5)+,(R0)+ ; ... 3rd word .ENDC ;NE SYT$K BR XCLOSE .............. .DSABL LSB .SBTTL JOBKMN, JOBKM1 - Determine if job is KMON ;+ ; JOBKMN, JOBKM1 - Return job context in condition codes ; ; N=1 => KMON ; Z=1 => Background Job ; Z=0 => Foreground or System Job ; ; JOBKMN tests JOBNUM and KMONIN ; ; JOBKM1 assumes Z condition code already correctly set (see above) ; ; All registers preserved ;- .ENABL LSB JOBKMN:: .IF EQ SB TST JOBNUM ;Is it the background job? JOBKM1::BGT 10$ ;Not B/G (can't be KMON then) .ENDC ;EQ SB TST KMONIN ;Is it KMON? 10$: RETURN ;If KMON, N is set here ............ .DSABL LSB .SBTTL .CSTAT - Get Status Of Channel EMT ;+ ; Channel Status: Return CSW, start block of file, length, ; highest block written, unit number, RAD50 of associated device ;- .ENABL LSB C$STAT: MOV @R3,R4 ;Get device index BIC #^c,R4 .IF NE MMG$T MOV #,R1 ;R1 = number of bytes in buffer CALL ACHBKM ;R0 -> user buffer 10$: BCS ADERR ;Error if bad address .ENDC ;NE MMG$T MOV (R3)+,(R0)+ ;CSW 20$: BPL E5ER0 ;Error, channel inactive MOV (R3)+,(R0)+ ;Copy the MOV (R3)+,(R0)+ ; rest of MOV (R3)+,(R0)+ ; the channel MOV @R3,@R0 ;Unit number CLRB @R0 ;Remove I/O count .IF EQ UNI$64 SWAB (R0)+ ;Put unit in low byte ... SPEW ==: .+2 ;remove this when $Rel is done MOV $PNAME(R4),@R0 ; ... and return it ;>>>$Rel .-2 $PNAME RMON .IFF ;EQ UNI$64 SPEW ==: .+2 ;remove this when $Rel is done MOV $PNAME(R4),R2 ;Get the XX_ name version ;>>>$Rel .-2 $PNAME RMON SWAB @R0 ;Put unit in low byte CMP (R0)+,#<7> ;Is it unit 10--77? BLOS 30$ ;No, return the PNAME (XX_ version) KECK ==: .+2 ;remove this when $Rel is done MOV $PNAM2(R4),R2 ;Get the X__ version ;>>>$Rel .-2 $PNAM2 RMON 30$: MOV R2,@R0 ;Return the device name .ENDC ;EQ UNI$64 40$: BR XCLOSE ............ .IF NE SPC$PS .SBTTL .SPCPS - Save/Set Main-line PC/PS S$PCPS: .IF NE MMG$T MOV #<3*2>,R1 ;Check out a 3 word block CALL ACHBKM ; and map it BCS 10$ ;Addressing error .ENDC ;NE MMG$T TST @R5 ;Are we at completion level? BPL 20$ ;No, can't issue this from main-line TST I.SPCP(R5) ;Is one already pending? BNE 50$ ;Yes, can't nest CMP (R0)+,(R0)+ ;Point to third word of area MOV R0,I.SPCP(R5) ; and save user area pointer .IF NE MMG$T MOV @#KISAR1,I.SPC1(R5) ;Save PAR1 bias, too .ENDC ;NE MMG$T BR 40$ ;Done ............ 50$: EMTER1 ;Error BR 40$ ;Done ............ .ENDC ;NE SPC$PS .DSABL LSB .SBTTL CHKSP - Check User Address For Bounds And Evenness ;+ ; CHKSP - Check user virtual address for validity ; ; @SP = address to check ; ; JSR R5,CHKSP ; Error return taken if address out of bounds or odd ; Normal return ; ; NOTE: Address of 0 is always valid ; No check is done if caller is USR, CSI, or BATCH ;- .ENABL LSB .IF EQ MMG$T CHKSP:: CHKSPD:: CHKSPI:: CHKSPU:: CHKSP1:: .IF EQ SB MOV R2,-(SP) ;Preserve R2 MOV 4(SP),-(SP) ;Put argument closer .IFF ;EQ SB MOV 2(SP),-(SP) ;Put argument closer .ENDC ;EQ SB BEQ 20$ ;Let address 0 alone .ASSUME I.STAT EQ 0 BIT #,@CNTXT ;Is USR running? BNE 20$ ;Yes BIT #,@SP ;Is it odd? BNE 30$ ;Yes, take error return .IF EQ SB MOV JOBNUM,R2 ;Check it against limits CALL JOBKM1 ;Is KMON doing it? .IFF ;EQ SB TST KMONIN ;Is KMON doing it? .ENDC ;EQ SB BMI 20$ ;Yes, assume KMON's smarter than we are 10$: .IF EQ SB ASL R2 ;$JBLIM is 2 words/entry .ADDR #<$JBLIM>,R2,ADD ;R2 -> to limits ;>>>$REL CMP @SP,(R2)+ ;Above upper limit? BHIS 30$ CMP @SP,@R2 ;Below low limit? .IFF ;EQ SB CMP @SP,$JBLIM ;Above upper limit? BHIS 30$ CMP @SP,$JBLIM+2 ;Below low limit? .ENDC ;EQ SB BLO 30$ 20$: TST (R5)+ ;Advance to non-error return 30$: TST (SP)+ ;Remove stack thing .IF EQ SB MOV (SP)+,R2 ;Restore R2 .ENDC ;EQ SB RTS R5 .......... .IFF ;EQ MMG$T ;I&D+ .IF NE SUP$Y CHKSP:: MOV #<<..CURR!..DSPA>/4>,-(SP) ;Use "current mode" D-else-I space BR 50$ ;Join common code ........... CHKSPU:: .ASSUME ..USER!..DSPA EQ 0*4 CLR -(SP) ;Assume user mode D-space BR 50$ ........... CHKSPD:: .ASSUME ..USER!..DSPA EQ 0*4 CLR -(SP) ;Assume user mode D-space BR 40$ ........... CHKSPI::MOV #<<..USER!..ISPA>/4>,-(SP) ;Assume user mode I-space .BR 40$ ........... 40$: MOV 4(SP),-(SP) ;Copy address to check ASR @SP ;Get user/supy bit to carry .ASSUME ..SUPY-..USER EQ 1*4 ADC 2(SP) ;If C set, then supy mode ASL @SP ;Adjust address to good even one BR 60$ ;Join common code ........... CHKSP1::MOV @SP,-(SP) ;Reverse order of saved R5 MOV 4(SP),2(SP) ; and mode/space MOV (SP)+,2(SP) ; argument 50$: MOV 4(SP),-(SP) ;Copy address to check .BR 60$ ;Check the address 60$: .IFF ;NE SUP$Y CHKSP:: CHKSPD:: CHKSPI:: CHKSPU:: CHKSP1:: .ENDC ;NE SUP$Y ;I&D- MOV R2,-(SP) ;Preserve R2 MOV R1,-(SP) ;And R1 MOV R0,-(SP) ;And R0 .IF NE SUP$Y MOV 6(SP),R0 ;Get address to check .IFF ;NE SUP$Y MOV 10(SP),R0 ;Get address to check .ENDC ;NE SUP$Y BEQ 30$ ;Leave address 0 alone .ASSUME I.STAT EQ 0 BIT #,@CNTXT ;Is USR running? BNE 30$ ;Yes BIT #,R0 ;Odd address? BNE 70$ ;Yes, that's illegal .ASSUME I.STAT EQ 0 BIT #,@CNTXT ;Is it a privileged job? BNE 20$ ;No, virtual job ;+ ; Job is a privileged job. Determine if virtual address is in lower ; 28k and check job limits if so. Else check windows, if any. ;- .IF EQ SUP$Y CALL $USRPH ;Convert virtual address to physical .IFF ;EQ SUP$Y MOV 10(SP),R1 ;Get mode/space argument CALL $VIRPH ;Convert virtual address to physical .ENDC ;EQ SUP$Y BCS 20$ ;Branch if address above 28KW boundary MOV R2,R0 ;Get low 16 bits of address .IF EQ SB MOV JOBNUM,R2 ;Check it against limits CALL JOBKM1 ;Is KMON doing it? .IFF ;EQ SB TST KMONIN ;Is KMON doing it? .ENDC ;EQ SB BMI 30$ ;Yes, assume KMON's smarter than us 10$: .IF EQ SB ASL R2 ;$JBLIM is 2 words/entry .ADDR #<$JBLIM>,R2,ADD ;Point to limit words ;>>>$REL CMP R0,(R2)+ ;Above upper limit? BHIS 70$ ;Yes, bad address CMP R0,@R2 ;Below low limit? .IFF ;EQ SB CMP R0,$JBLIM ;Above upper limit? BHIS 70$ ;Yes, bad address CMP R0,$JBLIM+2 ;Below low limit? .ENDC ;EQ SB BHIS 30$ ;No, address is in range BR 70$ ;Illegal address ........... 20$: MOV #<2>,R1 ;Check one word (2 bytes) .IF NE SUP$Y MOV 10(SP),R2 ;Get mode/space argument CALL ACHBK1 ;Is address mapped? .IFF ;NE SUP$Y CALL ACHBK ;Is address mapped? .ENDC ;NE SUP$Y BCS 70$ ;No, illegal address 30$: TST (R5)+ ;Advance to non-error return 70$: MOV (SP)+,R0 ;Restore registers MOV (SP)+,R1 ; MOV (SP)+,R2 ;Restore R2 .IF NE SUP$Y BIT (SP)+,(SP)+ ;Purge mode/space and extra address argument .ENDC ;NE SUP$Y RTS R5 .......... .ENDC ;EQ MMG$T .DSABL LSB .SBTTL OTHRJB - Get Pointer To Other Job's Impure Area ;+ ; OTHRJB - Get pointer to other job's impure area ; ; CALL OTHRJB ; ; R2 -> other job's impure area ; C = 1 if no other job or illegal reference (only valid from FG and BG) ;- .ENABL LSB .IF EQ SB OTHRJB::MOV JOBNUM,R2 ;Get current job number, are we BG? .IF NE SYT$K BEQ 10$ ;Yes, ok CMP R2,# ;Are we FG? BNE 20$ ;*C* No, system job, error, C=1 10$: .ENDC ;NE SYT$K NEG R2 ;Other job is max job number - this job number ADD PC,R2 ;Get impure pointer MOV $IMPUR+FJOBNM-.(R2),R2 ;R2 -> impure area of job ;>>>$REL BEQ 20$ ;No such job, return C set BIT #,I.BLOK(R2) ;Is job running? BEQ 30$ ;Yes, return C bit cleared .ENDC ;EQ SB ERRRTN::NOP ;PDP-11 entry for $GTVEC NOP ;PDP-11 entry for $GTCSR 20$: SEC ;PDP-11 entry for $GTSLT RETURN ...... OKRTN: NOP ;Entry for GETUMR NOP ;Entry for ALLUMR 30$: CLC ;Entry for RLSUMR RETURN ...... .DSABL LSB .SBTTL SAVE30 - Save Registers 3-0 ;+ ; SAVE30 - Save registers 3-0 on the stack ; ; SP -> return address ; ; JSR R3,SAVE30 ; ; R3 -> just after the JSR R3,SAVE30 ; SP -> return to SAVE30, old R0, R1, R2, R3, return from SAVE30 caller ; ; NOTE: SAVE30 Coroutine calls back ; to restore registers and RETURN, just RETURN back to SAVE30 ;- SAVE30::MOV R2,-(SP) ;Save regs 3 - 0. Called by JSR R3,SAVE30 MOV R1,-(SP) MOV R0,-(SP) CALL @R3 ;Call caller MOV (SP)+,R0 ;Restore regs MOV (SP)+,R1 MOV (SP)+,R2 MOV (SP)+,R3 RETURN ...... .IF NE SYT$K ;If system jobs (For next page) .SBTTL FNDJOB - Convert Taskname To Pointer To Impure Pointer ;+ ; FNDJOB - Convert taskname to pointer to impure pointer ; ; R0 -> 3 words of ASCII taskname ; ; CALL FNDJOB ; ; R2 -> impure area of job ; R5 -> impure pointer ; Z bit set if job not found ;- .ENABL LSB FNDJOB:: ;; MOV IMPLOC,R5 ;R5 -> after impure table ;; MOV #,R2 ;Set up loop count ;; MOV R0,-(SP) ;Save pointer to start of buffer ;;10$: CMPB @R0,#<'a> ;Less than lowercase a? ;; BLT 20$ ;Branch if yes - no conversion ;; CMPB @R0,#<'z> ;Greater than lowercase z? ;; BGT 20$ ;Branch if yes - no conversion ;; BICB #,@R0 ;Convert lowercase alpha to uppercase ;;20$: TSTB (R0)+ ;Pop pointer to next character ;; DEC R2 ;Decrement loop count ;; BNE 10$ ;Continue looping if not done ;; MOV (SP)+,R0 ;Point back from whence we came back to .BR FNDJB2 FNDJB2: MOV IMPLOC,R5 ;R5 -> after impure table CMP #<'F>,@R0 ;Looking for FG job? BEQ 5$ CMP #<'f>,@R0 ;Looking for f job? BNE 10$ ;No, not so easy 5$: MOV -(R5),R2 ;Point to FCNTXT:, set Z bit if not there BR 80$ ;Return 10$: TST -(SP) ;Allocate counter/flagger MOV R1,-(SP) ;Save some registers MOV R0,-(SP) 20$: MOV @SP,R0 ;Reget string pointer MOV #<5>,4(SP) ;Set counter to 6 (5 because BGE used) CMP #<-1>,-(R5) ;End of table? BNE 30$ ;No TST (R5)+ ;R5 -> BCNTXT: MOV @R5,R2 ;R2 -> Background Impure Area CMP #<'B>,@R0 ;Looking for BG job? BEQ 50$ ;Flag is non-zero count - a match CMP #<'b>,@R0 ;Looking for b job? BEQ 50$ ;Flag is non-zero count - a match CLR 4(SP) ;Job not found - make flag zero (Z=1) BR 50$ ;No match - return 30$: MOV @R5,R2 ;Get pointer from table BEQ 20$ ;No job here ADD #,R2 ;Point to logical job name MOV R0,R1 40$: MOVB (R1)+,R0 ;Get user-supplied character CALL UCASE ;Make it UPPER case CMPB R0,(R2)+ ;A match? BNE 20$ ;Next job entry if not DEC 4(SP) ;Count down characters BGE 40$ ;Loop for six characters MOV @R5,R2 ;R2 -> impure area of job we matched TST I.JNUM(R2) ;Did it match background job? CALL JOBKM1 ;Is KMON running? BMI 20$ ;If so, this is not a match .ASSUME I.LNAM NE CLR+26 50$: MOV (SP)+,R0 ;Restore registers MOV (SP)+,R1 ; TST (SP)+ ;Set/clear Z based on stack flag 80$: RETURN ...... .DSABL LSB .ENDC ;NE SYT$K .IF NE MQ$RES & ^c ;If MQ is resident in RMON (and not SB/XB) .SBTTL MQ - Message Handler ;+ ; The message handler is set up to look like a device handler. ; On entry, if there is no matching operation waiting for this entry, ; the current op is stored in the internal queue of waiting requests. ; If a matching operation is found, the message is copied ; and the queue elements used are freed for reuse. ; ; Completely rewritten for V4 ;- .ENABL LSB .WORD MQABRT+2-. ;Offset to MQINT .WORD 0 ;Handler hold word MQLQE:: .WORD 0 ;Last entry in queue MQCQE:: .WORD 0 ;Current queue entry ......... TST -(R1) ;Point R1 to MQCQE: (R1 -> this instruction on ; entry from QMANGR, COMPLT) MOV R1,-(SP) ;Save for later MOV @R1,R3 ;R3 -> CQE .IF NE UNI$64 BICB #,Q$2UNI(R3) ;Clear out high order unit # bits .ENDC ;NE UNI$64 MOVB Q$FUNC(R3),R4 ;R4 = SPFUN code BNE MQUSR ;Process USR request MOVB Q$JNUM(R3),R0 ;R0 = job, unit number ASR R0 ;Isolate job number ASR R0 ; ASR R0 ; BIC #^c,R0 ;Zero extraneous bits MOVB R0,Q$FUNC(R3) ;Save in SPFUN slot so MQABORT can find ; owner easily MOV Q$CSW(R3),R2 ;R2 -> CSW CLR R1 ;To avoid the auto sign extend of MOVB BISB C.UNIT(R2),R1 ;R1 = target job number ;+ ; Note that the BG job will always pass the following test. That's OK ; because the FG job must start first, and this allows you time to ; start the BG job. ;- MOV R1,R2 ;Get target job number BIC #^c<16>,R2 ADD PC,R2 ;R2 -> target job's impure area ;>>>$REL MOV $IMPUR-.(R2),R2 ; (PIC, of course) BEQ 5$ ;BR if job does not exist, error BIT #,I.BLOK(R2) ;Is job running? BNE 5$ ;BR if not - don't queue to inactive job TST Q$WCNT(R3) ;Assume a READ. What is it really? BEQ MQFIN ;A SEEK, all this is for nothing; .DRFIN BPL 20$ ;Process READ MOV R1,R2 ;R2 = job number (change queues on a WRITE) CMP R2,#<200> ;Is it "any job"? BNE 10$ ;Not 'any job', so ok 5$: .ASSUME Q$CSW EQ -2 BIS #,@-(R3) ;Set hard error BR MQFIN ; and return ............. 10$: MOV R0,R1 ;Issuing job number to R1 BIS #<100000>,R1 ;Set hi bit to flag a WRITE MOV R2,R0 ;Request goes on target job's queue 20$: MOV R1,@R3 ;Store in Q.BLKN for easy access .ADDR #,R0,ADD ;R0 -> internal list header + 4 ;>>>$REL 30$: MOV R0,R4 ;R4 -> Q.BLKN (next) 40$: CMP -(R4),-(R4) ;Bump back to link word MOV @R4,R0 ;R0 -> waiting element BEQ 110$ ;Nothing there, store this one CMPB @R3,@R0 ;Do job numbers match? BEQ 50$ ;Yes TSTB @R0 ;Is waiting element a 'match any job'? BMI 60$ ;Yes, and waiting element must be a read TSTB @R3 ;Is new element a 'match any job'? BPL 30$ ;No, on to next element 50$: TST @R0 ;Is waiting element a READ? BPL 60$ ;Yes, need a WRITE to match TST @R3 ;A WRITE. Got a READ to match? BPL 70$ ;Yes, go transfer message BR 30$ ;On to next element ........... 60$: TST @R3 ;Need a WRITE to complete. Is this a WRITE? BMI 80$ ;Yes, go transfer message BR 30$ ;On to next element ........... 70$: MOV R3,R0 ;Swap queue element pointers MOV @R4,R3 ; (@R4 -> waiting element from before) ;+ ; R0 -> Read Qelement at Q.BLKN ; R3 -> Write Qelement at Q.BLKN ; @R4 -> Waiting Qelement at Q.BLKN ;- 80$: CMP (R3)+,(R3)+ ;R3 -> Write Qelement at Q.BUFF CMP (R0)+,(R0)+ ;R0 -> Read Qelement at Q.BUFF MOV (R3)+,R1 ;R1 -> Source buffer ; (R3 -> Write Qelement at Q.WCNT) MOV (R0)+,R2 ;R2 -> Destination buffer ; (R0 -> Read Qelement at Q.WCNT) ;+ ; Now we map the buffers ;- .IF NE MMG$T MOV #,R5 ;R5 -> Kernel I-space PAR1 .IF EQ MQH$P2 MOV @R5,-(SP) ;Save kernel PAR1 MOV Q.PAR-Q.WCNT(R3),@R5 ;Map the source buffer MOV @#UISAR1,-(SP) ;Save user PAR1 ... MOV @#UISDR1,-(SP) ; ... and PDR1 MOV Q.PAR-Q.WCNT(R0),@#UISAR1 ;Map the destination buffer ... MOV #,@#UISDR1 ; ... via User I-space PAR1 .IFF ;EQ MQH$P2 MOV (R5)+,-(SP) ;Save kernel PAR1 ... MOV @R5,-(SP) ; ... and PAR2 MOV Q.PAR-Q.WCNT(R3),-2(R5) ;Map the source buffer using PAR1 ... MOV Q.PAR-Q.WCNT(R0),@R5 ; ... and the destination using PAR2 ADD #,R2 ;Adjust destination references to PAR2 .ENDC ;EQ MQH$P2 .ENDC ;NE MMG$T ;+ ; Now, in order to avoid reading beyond the end of the source buffer, ; which may not be mapped, we use the minimum of the write and read ; transfer counts as the actual transfer count. ;- MOV @R3,-(SP) ;Get the write transfer count MOV @R0,R0 ;Get the read transfer count ADD R0,(SP)+ ;Write more than read? BMI 90$ ;Yes, use read count MOV @R3,R0 ;No, use write count NEG R0 90$: .IF EQ MQH$P2 PUT R0,(R2)+,I ;Return transfer count to receiver .IFF ;EQ MQH$P2 MOV R0,(R2)+ ;Return transfer count to receiver .ENDC ;EQ MQH$P2 ;+ ; Now we do the actual transfer ;- 100$: .IF EQ MQH$P2 PUT (R1)+,(R2)+,I ;Transfer a word .IFF ;EQ MQH$P2 MOV (R1)+,(R2)+ ;Transfer a word .ENDC ;EQ MQH$P2 SOB R0,100$ ;Loop until transfer has completed ;+ ; Now we restore the PAR context we saved ;- .IF NE MMG$T .IF EQ MQH$P2 MOV (SP)+,@#UISDR1 ;Restore user PDR1 ... MOV (SP)+,@#UISAR1 ; ... and PAR1 MOV (SP)+,@R5 ;As well as kernel PAR1 .IFF ;EQ MQH$P2 MOV (SP)+,@R5 ;Restore kernel PAR2 ... MOV (SP)+,-(R5) ; ... and PAR1 .ENDC ;EQ MQH$P2 .ENDC ;NE MMG$T ;+ ; Free up saved and current queue elements, return to monitor ;- MOV @R4,R0 ;Link wait queue forward (R0 -> freed element) MOV Q$LINK(R0),@R4 ;+ ; Fake out COMPLT by making waiting element look like CQE ;- CLR Q$LINK(R0) ;Clear link in waiting element so monitor ; won't link queue forward MOV @SP,R4 ;R4 -> MQCQE: MOV @R4,R3 ;Save pointer to real CQE in R3 MOV R0,@R4 ;Make waiting queue element into CQE CLRB Q$FUNC(R0) ;Clear SPFUN slot so SPSIZE: not clobbered CALL COMPLT ;Complete the element MOV R3,@(SP) ;Restore real CQE to MQCQE: CLRB Q$FUNC(R3) ;Clear SPFUN slot so SPSIZE: not clobbered MQFIN: MOV (SP)+,R4 ;Repoint R4 to MQCQE: CALLR COMPLT ;Complete real CQE, return .............. ;+ ; At this point request is on hold, waiting for a matching READ or WRITE. ; Since request is processed in System State, nothing else has been linked on, ; so we clear MQCQE, MQLQE to make sure this element is really gone. ;- 110$: MOV R3,@R4 ;Store the element here CLR -4(R3) ;Clear it's link word, it's the last element MOV (SP)+,R0 ;R0 -> MQCQE CLR @R0 ;Clear MQCQE, CLR -(R0) ; and MQLQE, too RETURN ;Return without completing ...... .DSABL LSB .SBTTL MQUSR - Handle USR Operations For Message Handler ;+ ; MQUSR - Does USR operations on message channels ; ; R3 -> Q.BLKN of CQE ; R4 = SPFUN code ; ; BR MQUSR ;- .ENABL LSB MQUSR:: CMP R4,# ;LOOKUP, ENTER? (3,4 - only valid codes) BLT MQFIN ;CLOSE or DELETE do nothing (SPESHL will close ; channel for us) CMP R4,# ;If greater than 4, BGT MQFIN ; must be RENAME, do nothing here .IF NE SYT$K .IF NE MMG$T MOV @#KISAR1,-(SP) ;Save PAR1 MOV Q$PAR(R3),@#KISAR1 ;Map to user logical job name block .ENDC ;NE MMG$T MOV Q$BUFF(R3),R0 ;R0 -> logical job name MOV @R0,R5 ;Job name given? BEQ 10$ ;No, this means any job CALL FNDJOB ;Yes, find pointer to other job's impure area BNE 20$ ;Job exists .ENDC ;NE SYT$K MQER1: MOV #,SPUSR ;Error 1 (Hard Error), no such job .IF NE SYT$K BR MQUNM ;Unmap, leave ............. 10$: CMP R4,# ;Is this an ENTER? BEQ MQER1 ;*C Yes, null job name is an error RORB R5 ;*C Make target job number a 200 for 'any' job BR 30$ ........... 20$: BIT #,I.BLOK(R2) ;Is it running? BNE MQER1 ;No, give an error MOVB I.JNUM(R2),R5 ;R5 = target job number 30$: MOV -(R3),R3 ;R3 -> CSW MOVB R5,C.UNIT(R3) ;Store target job number in channel MQUNM: .IF NE MMG$T MOV (SP)+,@#KISAR1 ;Restore PAR1 .ENDC ;NE MMG$T .ENDC ;NE SYT$K BR MQFIN ;Exit request ............. .DSABL LSB .SBTTL MQABRT - Flush Message Queue On Abort ;+ ; MQABRT - Remove all messages sent from aborting job or aborting ; channel for job issuing .ABTIO to any other job ; ; Job is running. ; ; The monitor's interface to MQABRT is the same as for ; any other handler. The 1st word of the handler points ; to a fake MQINT entry. The MQABRT entry is one word ; before that. ; ; R4 = Aborting job ; R5 = 0 if abort by job ; = Pointer to aborting channel if abort by channel ; ;- .ENABL LSB MQABRT::MOV R0,-(SP) ;Save R0-R2 MOV R1,-(SP) MOV R2,-(SP) JSR R3,30$ ;Save R3, point to MSGQ MSGQ:: .REPT < FJOBS + 1 > .WORD 0 .ENDR .WORD -1 ;Stopper 10$: MOV R2,R1 ;Check next element 20$: MOV @R1,R2 ;R2 -> next element, R1 -> previous BNE 40$ ;Not end of queue, do another element 30$: MOV R3,R1 ;R1 -> last link MOV (R3)+,R2 ;R2 -> first element BEQ 30$ ;Continue if it doesn't exist CMP R2,#<-1> ;End of table? BEQ 80$ ;Yes, done 40$: CMP -(R2),-(R2) ;Point to link word ;+ ; Check to see if we should abort the queue element pointed to by R2 ; We will abort it only if: ; ; It belongs to the channel being aborted via .ABTIO (R5 <> 0) ; It belongs to the job being aborted (R5 = 0) ;- CMP R5,Q.CSW(R2) ;Do channel pointers match? BEQ 50$ ;Branch if yes -- abort this element TST R5 ;Is it a job abort? BNE 10$ ;Branch if not -- don't abort this element MOVB Q.JNUM(R2),-(SP) ;Get job number ASR @SP ASR @SP ASR @SP BIC #^c<16>,@SP CMPB (SP)+,R4 ;Originated by aborted job? BNE 10$ ;No, go check next 50$: MOV @R2,@R1 ;And link around it CLR (R2)+ ;Clear link in aborted element TST (R2)+ ;Point to Q.BLKN MOV MQLQE,R0 ;Is anything on MQCQE/MQLQE queue? BNE 60$ ;Branch if not -- enqueue to empty queue MOV R2,MQCQE ;MQCQE -> QEL BR 70$ ;Join up with queue not empty enqueue 60$: MOV R2,Q.LINK-Q.BLKN(R0) ;Old last -> QEL 70$: MOV R2,MQLQE ;MQLQE -> QEL BR 20$ ;Do next element, or next job if end of queue ;+ ; Come here to exit MQABRT ;- 80$: MOV (SP)+,R3 ;We're done with all jobs MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 .ADDR #,R4 ;Set up R4 for COMPLT ;>>>$REL TST @R4 BEQ RET0 ;No queue elements to return JMP COMPLT .DSABL LSB .ENDC ;NE MQ$RES & ^c .SBTTL $SYS - System I/O Handler ;+ ; $SYS - Do I/O on the system channel ; ; R0 = block number on channel to READ/WRITE ; R5 -> arguments (IOB): buffer address, word count (<0 if WRITE), 0 ; ; CALL $SYS ; ; C=1 if error on channel ;- $SYSSW: MOV $SWPBL,R0 ;Enter here to do I/O to SWAP blocks $SYS:: JSR R3,SAVE30 ;Save registers 3-0 .IF EQ SB MOV CNTXT,R3 ;R3 -> impure area of running job MOV I.SCHP(R3),R3 ;R3 -> job's system channel .IFF ;EQ SB MOV I.SCHP+BKGND,R3 ;R3 -> job's system channel .ENDC ;EQ SB MOV R4,-(SP) ;Save R4 ... MOV R5,-(SP) ; ... and R5 MOV SYUNIT,R1 ;Unit number of system volume MOV (PC)+,R2 ;Get last queue entry for system volume SYENTR:: .WORD 0 ;**BOOT** Last queue entry for system volume MOV IO.WCN(R5),R4 ;Word count in R4 .IF NE MMG$T CALL KPSAVE ;Save PAR 1/3 and set default .ENDC ;NE MMG$T CALL QMANGR ;Queue a request .IF NE MMG$T CALL KPREST ;Restore Kernel PAR 1 and 3 .ENDC ;NE MMG$T MOV (SP)+,R5 ;Restore R5 MOV (SP)+,R4 ; and R4 MOV @R3,-(SP) ;See if error is on BIC #,@R3 ;Clear it for next time ROR (SP)+ ;C=1 if err (keep $SYSCH open for KMON RWSYS) .ASSUME HDERR$ EQ 1 RET0: RETURN ............ ;I&D+ IOTYPE: .IF NE SUP$Y MOV @SP,-(SP) ;Make room for mapping return argument MOV #<<..CURR!..DSPA>/4>,2(SP) ;Default is "current" D-space .ENDC ;NE SUP$Y MOV R2,-(SP) ;Save pointer to A.SPFU (or A.CRTN) MOV @R2,R2 ;Get A.SPFU and A.FUNC ASRB R2 ;Check if A.SPFU is odd BCC 20$ ;Branch if not, it's A.CRTN BEQ 20$ ;Branch if A.SPFU=1, it's non-wait A.CRTN ADD #2,@SP ;Bump @SP to point to A.SRTN .IF NE SUP$Y ASRB R2 ;If A.SPFU<0, then non-mapped SPFUN BMI 10$ ;Branch if non-mapped (old style) .SPFUN ; BICB #^C<7>,R2 ;Parameter bits are shifted into position ; already. No need to clear extraneous bits ; as processing routines do this for us MOVB R2,4(SP) ;Store mapping parameter bits for stack return .ENDC ;NE SUP$Y 10$: SWAB R2 ;Get A.FUNC to low byte BNE 30$ ;If non-zero, set carry to signal no end-of- ; buffer address check 20$: TST (PC)+ ;Clear carry to signal that end of buffer ; should be address checked 30$: SEC MOV @(SP)+,R2 ;*C* R2 = A.CRTN or A.SRTN (whichever exists) RETURN ;I&D- .SBTTL QMANGR - Queue Manager ;+ ; QMANGR - Put an I/O request on a driver's queue ; ; R0 = block number to READ/WRITE ; R1 = unit number in low bits of odd byte ; R2 -> 4th word of handler (standard entry point) ; R3 -> channel @ C.CSW ; R4 = word count (<0 => WRITE) ; R5 -> arguments: buffer address, word count (<0 if WRITE), 0 ; ; CALL QMANGR ; ; R0 = random ; R1 -> job's impure area ; R2 = random ;- .ENABL LSB QMANGR::MOV R4,-(SP) ;Save regs MOV R1,-(SP) MOV CNTXT,R1 ;Point to impure area TST (R1)+ ;R1 -> head of avail queue QGTELT: SPL 7 ;Get queue element at Priority 7 MOV @R1,R4 ;;; Point to an element BNE 20$ ;;; Branch if an element is available 10$: CALLR QFULL ;;; Else, no elements or queue is full ............ 20$: CMPB #<255.>,C.DEVQ(R3) ;;; Room for another element? BEQ 10$ ;;; No, 255. is maximum MOV @R4,@R1 ;;; Advance queue SPL 0 ;;; And reenable interrupts CLR (R4)+ ;Clear link word MOV R3,(R4)+ ;Fill in pointer to CSW INCB C.DEVQ(R3) ;Bump channel request counter MOV R0,(R4)+ ;Block number .IF NE UNI$64 MOV @SP,@R4 ;@R4 (Hi nibble) = Unit # (6 bits from C.UNIT) BIC #^c,@R4 ;Q.UNIT will be LOW three bits of unit only ASL @SP ;Move HIGH three bits of unit number to <6:4> SWAB @SP ;Move to low byte BIC #^c,@SP ;Leave only HIGH three bits of unit number .IF NE SB BIS (SP)+,(R4)+ ;@R4 = low unit in Q.UNIT + high in Q.FUNC .IFF ;NE SB BIS (SP)+,@R4 ;@R4 = low unit in Q.UNIT + high in Q.FUNC .ENDC ;NE SB .IFF ;NE UNI$64 ;>>> Move CLRB before conditionals (do CLRB @SP and conditional auto-inc MOV ) .IF NE SB CLRB @SP ;Clean out low byte MOV (SP)+,(R4)+ ;Unit number .IFF ;NE SB MOV (SP)+,@R4 ;Unit number CLRB @R4 ;Clean out low byte .ENDC ;NE SB .ENDC ;NE UNI$64 .IF EQ SB MOV JOBNUM,R0 ;Get job number SWAB R0 ;Put it in the right bits ASL R0 ASL R0 ASL R0 BIS R0,(R4)+ ;OR in the job number .ENDC ;EQ SB .IF EQ MMG$T MOV (R5)+,(R4)+ ;Buffer address .IFF ;EQ MMG$T MOV R0,-(SP) ;Save regs MOV R1,-(SP) MOV R2,-(SP) MOV (R5)+,R0 ;R0 = user buffer virtual addr ;I&D+ .IF NE SUP$Y MOV R5,R2 ;R2 -> A.WCNT .ASSUME A.SPFU EQ A.WCNT+2 TST (R2)+ ;R2 -> A.SPFU special flag code CALL IOTYPE ;Get mapping bits on stack MOV (SP)+,R1 ;R1 = mapping bits .IFTF ;NE SUP$Y BIT #,@#PS ;Request from Kernel? BNE 30$ ;BR if not CALL $RELOK ;Yes, use Kernel mapping BR 40$ ............ 30$: .IFT ;NE SUP$Y CALL $RELXX ;Relocate R0 using mode/space in R1 .IFF ;NE SUP$Y CALL $RELOC ;Convert to bias & displacement .ENDC ;NE SUP$Y ;I&D- 40$: MOV R2,(R4)+ ;Displacement to Q.BUFF MOV R1,Q.PAR-Q.WCNT(R4) ;Par1 bias to Q.PAR MOV R1,Q.MEM-Q.WCNT(R4) ;Par1 bias to Q.MEM MOV (SP)+,R2 ;Restore regs MOV (SP)+,R1 MOV (SP)+,R0 .ENDC ;EQ MMG$T MOV (SP)+,(R4)+ ;Word count TST (R5)+ ;(Skip R5 over word count) MOV (R5)+,@R4 ;Get completion code MOV R2,-(SP) ;Save used register ;I&D+ MOVB @R4,R2 ;R2 = A.SPFU ASRB R2 ;Does request have A.SRTN instead of A.CRTN? BCC 70$ ;Branch if not BEQ 70$ ;Branch if not ;I&D- .IF NE UNI$64 MOVB A.FUNC-A.SPFU(R4),-(SP) ;Is function code negative? BPL 50$ ;Branch if not COMB Q.FUNC-Q.COMP(R4) ;Compl. hi unit bits for compatibility 50$: .ASSUME C.CSW EQ 0 MOV @R3,R2 ;Get device index BIC #^c,R2 ADD PC,R2 ;Get PIC offset into device name tables ;>>>$REL CMP $PNAME-.(R2),$PNAM2-.(R2) ;Is this an extended unit handler? BEQ 60$ BICB #^c,Q.FUNC-Q.COMP(R4) ;Leave only high unit bits BICB #,@SP ;Rsrv room for 3 hi bits of unit # BISB Q.FUNC-Q.COMP(R4),@SP ;Merge high unit bits with func code 60$: MOVB (SP)+,Q.FUNC-Q.COMP(R4) ;Store rest of func. byte .IFF ;NE UNI$64 MOVB A.FUNC-A.SPFU(R4),Q.FUNC-Q.COMP(R4) ;SPFUN, store func. byte .ENDC ;NE UNI$64 MOV (R5)+,@R4 ;Put in real completion function 70$: ADD #,R4 ;Fix R4 to point to proper word MOV (SP)+,R2 ;Restore used register MOV R3,-(SP) ;Save CSW pointer ENSYS 160$ ;Enter System State MOV R0,-(SP) ;Save used register CALL CHKNOQ ;Non-quiescable? BEQ 80$ ;Yes, skip increment of I.IOCT INC I.IOCT-I.QHDR(R1) ;; Increment number of requests 80$: MOV (SP)+,R0 ;Restore R0 .IF NE MMG$T REQUE2: CALL KPSAVE ;; Save PAR 1/3 and set default .ENDC ;NE MMG$T REQUE: ;+ ; Hooks for entry to CA and UB follow. Q2CAHK is pointed to by ; $QHOOK in the RMON fixed area. CA and UB handler load code ; replace the hooks with calls to their respective handler ; resident routines. At entry, a pointer to Q-Element offset Q.BLKN ; is on the stack. The handler routines must preserve R0 and R2. ;- MOV R4,-(SP) ;; Stack the Q-Element pointer Q2CAHK::BR 90$ ;; Cache hook .WORD ;; -> Next cache hook ;>>>$Rel .-2 C2CAHK+FH.CBR RMON BR 110$ ;; Bypass handler call, CA cleaned stack ............ 90$: .IF NE MMG$T BR 100$ ;; UB hook, clean up stack .WORD ;; -> Next UB hook ;>>>$Rel .-2 C2CAHK+FH.UBR RMON ............ 100$: .ENDC ;NE MMG$T MOV (SP)+,R4 ;; Restore the Q-Element pointer REQUE1: MOV R2,R1 ;; Copy handler pointer SPL 7 ;; Raise priority .IF NE SB MOV (R2)+,R5 ;;; Is LQE = 0? .IFF ;NE SB TST (R2)+ ;;; Is LQE = 0? .ENDC ;NE SB BNE 120$ ;;; No, the handler is active MOV R4,(R1)+ ;;; Set LQE MOV R4,(R1)+ ;;; Set CQE SPL 0 ;;; Lower priority CALL @R1 ;; Start the handler 110$: .IF EQ MMG$T RETURN ;; Return ............ .IFF ;EQ MMG$T BR 170$ ;; Restore mapping and return ............ .ENDC ;EQ MMG$T BR REQUE ;; **Must be 2nd word after handler call ............ .IF NE MMG$T BR REQUE1 ;; **Must be 3rd word after handler call ............ .ENDC ;NE MMG$T .ASSUME H1.HLD EQ H1.LQE-2 120$: BIS #,-(R1) ;;; Hold the handler SPL 0 ;;; Lower priority .IF NE SB MOV R4,Q$LINK(R5) ;; Link new element to end of queue ... MOV R4,-(R2) ;; ... and set last queue element to it. .IFF ;NE SB MOV @R2,R5 ;; R5 -> next element 130$: MOV R5,R2 ;; Copy pointer CMP -(R2),-(R2) ;; Back up R2 to link word MOV @R2,R5 ;; R5 -> next element BEQ 140$ ;; End of queue, put it here CMP Q$FUNC(R5),R0 ;; Element job number : this job number BHIS 130$ ;; Element >= this, keep chaining 140$: MOV R5,Q$LINK(R4) ;; Link word to this element MOV R4,@R2 ;; Link prev element to this one TST R5 ;Adding to end of queue? BNE 150$ ;No, go unhold MOV R4,2(R1) ;Yes, set XXLQE .ENDC ;NE SB 150$: CALL UNHOLD ;; Did handler complete while held? BCS 170$ ;; Branch if top QElement didn't complete ;>>> Make the following 2 instructions CALLR for MMG$T=0!! CALL CMPLT2 ;; Enter completion BR 170$ ;; Restore mapping and return. ............ 160$: MOV (SP)+,R3 ;Back in User State. Retrieve CSW pointer TST -(R5) ;Wait for completion? BNE 180$ ;No, return .BR CHWAIT ............ ;+ ; Wait for a queue element to become available. ;- CHWAIT:: .IF EQ SB MOV CNTXT,R1 ;We must wait. Point to impure area MOV R3,I.CHWT(R1) ;Save pointer to channel being awaited .IFF ;EQ SB MOV R3,I.CHWT+BKGND ;Save pointer to channel being awaited .ENDC ;EQ SB JSR R4,$SYSWT ;Wait for I/O on a channel to complete .WORD CHNWT$ MOVB C.DEVQ(R3),R2 ;; Get channel's pending I/O request count NEGB R2 ;; Set Carry if <>0, else clear it ;>>> CALLR @(SP)+ Conditionalize for next 2 instructions. CALL @(SP)+ ;; Coroutine return for blocking check .IF EQ MMG$T 170$: ;; 170$ entry for SB/FB .ENDC ;EQ MMG$T 180$: RETURN ;; Return (perhaps to user state at 160$) ............ ;+ ; No queue elements or queue is full. ;- QFULL: SPL 0 ;;; No room, back to level 0 USWAPO: ENSYS QGTELT ;Enter System State for waiting QWAIT:: .IF EQ SB MOV JOBNUM,R5 ;; Get guy's job number (note R5 scr) BEQ 190$ ;; There is no job number -2 TST -(R5) ;; Start scheduling below him! .IFF ;EQ SB CLR R5 ;; Job#=0, start sched'lng there (note R5 scr) .ENDC ;EQ SB 190$: CALLR $RQSIG ;; Enter schedule request at sig-event, it ... ............ ;; ... will return to level 0 int. exit for us ;+ ; Restore mapping and return ;- .IF NE MMG$T ;>>> Combine this section with the code at the end of Q2CAHK 170$: CALL KPREST ;; Restore mapping. RETURN ;; Exit system state to 160$ ............ .ENDC ;NE MMG$T .DSABL LSB .SBTTL UNHOLD - Unhold a Handler ;+ ; UNHOLD: Routine to unhold a handler ; ; Called by: All routines that unhold a handler ; Currently: IOQABT, QMANGR ; ; Entry: R1 -> handler hold word (word 3) ; ; Exit: If C = 0 then ; o Top queue element completed caller should ; call CMPLT2 to finish it off. ; o R1 -> XXCQE (word 5) ; o handler is unheld ; If C = 1 then ; o R1 -> handler hold word ; o handler is unheld ;- .ENABL LSB UNHOLD: .IF EQ RTE$M GETPSW ;Save PSW value .ENDC ;NE RTE$M .IF NE MMG$T U2UBHK::BR 5$ ;UB hook .WORD A2UBHK+AH.UBR ;Pointer to next UB hook ;>>>$REL .-2 A2UBHK+AH.UBR RMON ............ 5$: .ENDC ;NE MMG$T ASL @R1 ;Test completion & reset hold maybe BMI 10$ ;Branch if completion occurred .IF EQ RTE$M PUTPSW ;Restore PSW .ENDC ;EQ RTE$M BR 20$ ;Go exit with C=1 ............ 10$: CLR (R1)+ ;Clear hold TST (R1)+ ;Advance to xxCQE .IF EQ RTE$M PUTPSW ;Restore PSW .ENDC ;EQ RTE$M TST (PC)+ ;Clear C and skip next instruction 20$: SEC ;Set C RETURN ;Return to caller ............ .DSABL LSB .SBTTL COMPLT - Queue Completion ;+ ; When a device transfer completes, the handler transfers to COMPLT, ; to start a new request ; If a completion routine is associated with the request, it is placed ; on the user's completion queue and, if he is currently at ; non-completion level, a task switch for him is requested. ; The I/O count for the channel is decremented, and if the user is ; waiting for that channel, he is unblocked from the wait. ; Enter with R5 and R4 on stack. R4 points to the location in the ; handler which points to the current queue entry being processed. ;- .ENABL LSB COMPLT::ASR H1.HLD-H1.CQE(R4) ;Is handler being held? BMI 110$ ;Yes, flag is on, just return JSR R3,SAVE30 ;No, save regs 3-0 MOV R4,R1 ;R1 -> handler CQE CMPLT2: ;+ ; Hooks for CA and UB follow. CA and UB handler load code ; replace the hooks with calls to their respective handler ; resident routines. At entry, R1 -> fifth word of handler. ; The routines must preserve R1. ;- C2CAHK::BR 10$ ;Cache hook .WORD 0 ;End of CA hooks ............ 10$: .IF NE MMG$T BR 20$ ;UB hook .WORD U2UBHK+UH.UBR ;Pointer to next UB hook ;>>>$Rel .-2 U2UBHK+UH.UBR RMON ............ 20$: .ENDC ;NE MMG$T MOV @R1,R4 ;R4 -> Queue element MOV -(R4),R3 ;R3 -> channel .IF EQ UNI$64 TSTB Q.FUNC-Q.CSW(R4) ;Was this Special LOOKUP/ENTER? .IFF ;EQ UNI$64 BITB #<217>,Q.FUNC-Q.CSW(R4) ;Was this SPECIAL LOOKUP/ENTER? .ENDC ;EQ UNI$64 BLE 30$ ;No MOV Q.WCNT-Q.CSW(R4),SPSIZE ;Else save file size in Q.WCNT 30$: .IF EQ SB MOVB Q.JNUM-Q.CSW(R4),R5 ;Get job number of owner ASR R5 ;Extract job number ASR R5 ASR R5 BIC #^c<16>,R5 ADD PC,R5 ;R5 -> his impure area .IFF ;EQ SB MOV PC,R5 ;R5 -> his impure area .ENDC ;EQ SB MOV $IMPUR-.(R5),R5 ; (pic, of course) ;>>>$REL DECB C.DEVQ(R3) ;Decrease pending requests on channel BNE 40$ ;Is channel free? CMP R3,I.CHWT(R5) ;Is he waiting for this one? BNE 40$ ;No JSR R4,UNBLOK ;Yes, unblock job if waiting channel I/O done .WORD CHNWT$ 40$: MOV R0,-(SP) ;Save used register CALL CHKNOQ ;Non-quiescable I/O? BEQ 50$ ;Branch if yes DEC I.IOCT(R5) ;Decrease number of outstanding requests BNE 50$ ;Not 0 JSR R4,UNBLOK ;No I/O, unblock job if waiting all I/O done .WORD EXIT$ 50$: MOV (SP)+,R0 ;Restore R0 MOV -(R4),(R1)+ ;Link device queue forward (note: not running) BEQ 60$ ;Nothing left on device MOV R1,-(SP) ;Set address to call handler BR 70$ ;Merge ............ 60$: MOV -(R1),-(R1) ;Clear out LQE flag 70$: CMP Q.COMP(R4),#<..ISIO> ;Completion? BLOS AQLINK ;No, go link into avail queue .ASSUME I.STAT EQ 0 BIT #,@R5 ;Is job in abort context? BNE AQLINK ;Yes, don't run completion .BR 80$ ............ 80$: MOV @R3,QC.CSW(R4) ;Save channel status word SUB I.CSW(R5),R3 ;Make R3 a channel offset MOV R3,QC.OFS(R4) ;Save channel offset TST (R5)+ ;Advance pointer MOV R5,R2 ;Save R5 .IF EQ SB MOV I.JNUM-2(R5),R5 ;Get job number .IFF ;EQ SB CLR R5 ;Only job # 0 .ENDC ;EQ SB CALL $RQTSW ;Ask that he be eligible MOV R2,R5 ;Restore R5 BIS #,-(R2) ;Indicate completion pending CQLINK::TST (R5)+ ;Advance R5 to completion last element CLR @R4 ;Clear link word in element GETPSW ;Stack the PS SPL 7 ;Up ... MOV (R5)+,R0 ;;; R0 -> last element in completion queue BNE 90$ ;;; (If there is one) MOV R5,R0 ;;; Set R0 to plug CQE = LQE 90$: MOV R4,@R0 ;;; Point last element at this one 100$: MOV R4,-(R5) ;;; Make this the last element PUTPSW ;;; Back to Priority n 110$: RETURN ;Return from interrupt, maybe to handler ............ AQLINK::TST (R5)+ ;Bump R5 to AVAIL queue GETPSW ;Stack the PS SPL 7 ;Uppppp MOV (R5)+,@R4 ;;; This element's link -> former AVAIL BR 100$ ;;; Go point AVAIL to us ............ $SYNCH::TST QS.CMP(R4) ;Is this node in use? BNE 120$ ;Yes, error him CMP (R5)+,(SP)+ ;Pop to good return, prune stack MOV R5,QS.CMP(R4) ;Save SYNCH address in node MOV #,QS.SYN(R4) ;= -1 to avoid linking to AVAIL que later MOV QS.JOB(R4),R5 ;Get job number in R5 to check validity .IF EQ SB BIT #^c,R5 ;Is it a valid job number? .ENDC ;EQ SB BNE 110$ ;Not a valid job number, just exit quietly CALL $RQTSW ;Yes, request a task switch for the job .IF EQ SB ADD PC,R5 ;In a pic-y way MOV $IMPUR-.(R5),R5 ;Point to new impure area ;>>>$REL .IFF ;EQ SB MOV CNTXT,R5 ;Point to new impure area .ENDC ;EQ SB BEQ 110$ ;No such job, boot .ASSUME I.STAT EQ 0 BIT #,@R5 ;Is job dead? BNE 110$ ;Yes, bad .IF EQ SB BIT #,I.BLOK(R5) ;Is job dead? BNE 110$ ;Yes, bad .ENDC ;EQ SB .ASSUME I.STAT EQ 0 BIS #,@R5 ;No, a completion routine is here ADD #,R5 ;Point to head of queue GETPSW ;Stack the PS SPL 7 ;Upwards MOV (R5)+,@R4 ;;; Put top C element in this link BNE 100$ ;;; Top element exists, make this the top MOV R4,-(R5) ;;; Completion queue empty, make this the ... BR 100$ ;;; ... top and go make it the LQE, too ............ 120$: RTS R5 ;Return if SYNCH node in use ............ .DSABL LSB .SBTTL .GTIM - Get Time Of Day EMT ;+ ; "Perfection in a clock does not consist in being fast, ; but in being on time." - Vauvenargues, "Reflexions" ;- .ENABL LSB G$TIM:: .IF NE MMG$T CALL ACHBK2 ;Check time block and map BCC 10$ ;BR on good buffer CALLR ADERR ;Give MONERR addr ............ 10$: .ENDC ;NE MMG$T .IF EQ TIME$R .ADDR #<$TIME>,R1 ;R1 -> time words ;>>>$REL SPL 7 ;Keep out clock interrupt MOV (R1)+,(R0)+ ;;; Move in high order time MOV @R1,@R0 ;;; and low order time BR SPLDON ;;; Get out ............ .IFF ;EQ TIME$R ENSYS EMTRTI ;+ ; GTIHOK (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; CALL $GTTI ; RETURN ; ; The $GTTI routine is located in the RTEM-11 linkage ; routines. This hook allows RTEM-11 to correctly ; obtain the time in the emulated environment, as the ; clock never ticks under RTEM-11. ;- GTIHOK:: ;; (*** RTEM-11 HOOK ***) 20$: .ADDR #<$TIME+TIM.LO>,R1 ;; R1 -> time additive ;>>>$REL MOV PSCLKH,(R0)+ ;; Move in high pseudo time MOV PSCLOK,@R0 ;; Move in low order time ADD @R1,@R0 ;; Add in thing to make it time of day ADC -(R0) ;; Propagate Carry ADD -(R1),@R0 ;; And so on ... CMP (R0)+,(PC)+ ;; Check for midnight turnover GTM.HI:: .WORD TIMHI ;; High order number of ticks/day BLO 50$ ;; Not yet BHI 30$ ;; Egad, 2 days gone by CMP @R0,GTM.LO ;; Midnight yet? BLO 50$ ;; No 30$: SUB GTM.HI,(R1)+ ;; Adjust time words SUB (PC)+,@R1 ;; GTM.LO:: .WORD TIMLO ;; Low order number of ticks/day SBC -(R1) ;; TST -(R0) ;; Fix his area pointer .IF EQ ROL$OV ADD #<40>,DATES ;; Fix today BR 20$ ;; Go set his time right for the new day ............ ;+ ; "You cannot waste tomorrow; it is kept for you." ; - Arnold Bennett ;- .IFF ;EQ ROL$OV ;+ ; "Take no thought for the morrow; that's your privilege. ; But don't complain if when it gets here you're off guard." ; - John Brunner, "The Shockwave Rider" ;- ; ** DONE ** Add code to detect leap years into the next century ; ** REPLY ** All years divisible by 4 across the total RT range ; will be leap years. ROLOVR::MOV DATES,R1 ;R1 is free at this point BEQ 20$ ;Do nothing if date was not set MOV R1,-(SP) ;Put date on stack MOV R1,-(SP) ;Move in value for later day calculations ASR R1 ;Shift right twice... ASR R1 ; ...to set up for month SWAB R1 ;Put month in low byte BIC #^c<17>,R1 ;Clear to a four bit field ADD PC,R1 ;PIC address addition MOVB DAYTBL-.-1(R1),R1 ;Get number of days in this month ;>>>$REL CMPB R1,#<28.> ;Is it February? BNE NOLEAP ;No, no leap changes BIT #<3>,@SP ;Divisible by 4? BNE NOLEAP ;No, not a leap year INCB R1 ;One more day in February this year NOLEAP: ASL @SP ;Shift left three ... ASL @SP ; ... times to set ... ASL @SP ; ... up for day SWAB @SP ;Put day in low byte BICB #^c<37>,@SP ;Clear to a five bit field CMPB (SP)+,R1 ;Current day vs. number of days in month BHIS LSTDAY ;The last day of the month ADD #<40>,@SP ;Do the usual thing BR 40$ ............ .LB DA.DAY, DA..DA .LB DA.MON, DA..MO .LB DA.YR, DA..YR .LB DA.AGE, DA..AG LSTDAY: BIC #,@SP ;Clear the day field ADD #<1*DA..DA>+<1*DA..MO>,@SP ;Set day to 1, bump month by 1 MOV @SP,-(SP) ;Stack the date BIC #^C,@SP ; and discard all but the month CMP (SP)+,#<12.*DA..MO> ;Have we survived another year? BLOS 40$ ;Not yet... BIC #DA.MON,@SP ;Clear the month field ADD #,@SP ; and set the month to 1 MOV @SP,-(SP) ;Stack the current date INC @SP ; and bump it BIC #^C,@SP ; then discard all but the year BIC #DA.YR,2(SP) ;Discard the year in the final copy BIS @SP,2(SP) ; and replace with updated year TST (SP)+ ;Have we survived another RT epoch? BNE 40$ ;Not yet... ;;; MOV @SP,-(SP) ;Stack the current date ;;; BIC #^C,@SP ; and discard all but epoch field ;;; ADD #,(SP)+ ;Bumping epoch past max? ;;; BCS 40$ ;Yes, don't do it... ;;; ADD #,@SP ;No, we can do it safely ADD #,@SP ;Yes, bump it 40$: MOV (SP)+,DATES ;Clean up stack BR 20$ ;Go set his time right for the new day ........... DAYTBL: .BYTE 31., 28., 31., 30., 31., 30. ;Table of days in each month .BYTE 31., 31., 30., 31., 30., 31. .ENDC ;EQ ROL$OV .ENDC ;EQ TIME$R .IF NE TIME$R .SBTTL .CMKT - Cancel Mark Time EMT ;+ ; Cancel Mark Time: takes an identifying number and cancels ; the first mark time element for that job which has that number. ; If a two word area is also given, the amount of time remaining ; is returned in that area ;- C$MKT: ENSYS EMTRTI ;Do it in Sys State to stop clock .IF EQ SB MOV JOBNUM,R2 ;; R2 = job number .ENDC ;EQ SB MOV @R1,R5 ;; R5 = return address for time MOV #,R1 ;; Set system ID limit CALL CMARKT ;; Cancel the element BCC 50$ ;; Ah, found it .ENDC ;NE TIME$R SYSER0: ;; .IF EQ MMG$T MOV TASKSP,R0 ;; No, we couldn't find one with that ID INC >(R0) ;; C=1 at User PS offset + fake interrupt sz .IFF ;EQ MMG$T BIS #,>(SP) ;; C=1 @ User PS ofset + fake int sz .ENDC ;EQ MMG$T 50$: RETURN ;; Back! ............ .IF NE TIME$R .SBTTL CMARKT - Cancel One Or All Timer Requests For A Job ;+ ; CMARKT - Cancel one or all timer requests belonging to a job ; ; ; R0 = ID of element to cancel (0 => cancel all) ; R1 = system ID limit (177377 if called by user, 177777 if by system) ; R2 = job number (FB/XM ONLY, NOT SB/XB) ; R5 -> area to return unexpired time (0 => no time return wanted) ; ; CALL CMARKT ; ; Unexpired time returned, if requested ; ; R0 = random (SB/XB only) ; R2 = random ; R3 = random ; R4 = random ; R5 = random ; C=1 if element was not found in clock queue, (i.e., already expired) ;- CMARKT::.ADDR #,R4 ;Point to queue header ;>>>$REL .IF EQ SB MOV R2,-(SP) ;Save job number .ENDC ;EQ SB 60$: MOV R4,R3 ;R3 -> prev link word + 2 70$: MOV -(R3),R4 ;R4 -> next element BEQ 120$ ;End of queue ADD #,R4 ;Point to job number word .IF EQ SB CMP @SP,@R4 ;Is element for this job? BNE 60$ ;No, skip it .ENDC ;EQ SB TST R0 ;Are we canceling everything? BNE 80$ ;No CMP C.SEQ-C.JNUM(R4),# ;Is this one cancelable? BLOS 90$ ;Yes CMP R1,# ;Maybe, is limit 177777 ? BNE 60$ ;No, can't cancel... loop CMP C.SEQ-C.JNUM(R4),# ;Is ID GE 177700 ? BHIS 90$ ;Yes, ok to cancel ;+ ;NOTE: Since R0 = 0, CMP below fails and branch goes to 60$ ;- 80$: CMP R0,C.SEQ-C.JNUM(R4) ;No, is this the right identifier? BNE 60$ ;No, try again 90$: MOV -(R4),(R3)+ ;Put our link into previous link word MOV -(R4),R2 ;R2 = low order expiration time TST -(R4) ;Point to high order tox TST R0 ;Canceling all? ;+ ; CMTHOK (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; CALL $CMKT ; ; The $CMKT routine is located in the RTEM-11 linkage ; routines. This hook allows RTEM-11 to correctly ; cancel outstanding RSX-11 marktimes. ;- CMTHOK:: ;(*** RTEM HOOK ***) BEQ 100$ ;Yes, no return stuff TST R5 ;Return unexpired time? BEQ 100$ ;No, just exit SUB PSCLOK,R2 ;Convert tix to time remaining .IF EQ MMG$T MOV @R4,@R5 ;Move in high order time remaining SBC (R5)+ MOV R2,@R5 ;Move in low order .IFF ;EQ MMG$T MOV @R4,-(SP) ;Get hi order time remaining SBC @SP ;Subtract Carry bit PUT (SP)+,(R5)+ ;Move to user buffer PUT R2,@R5 ;Move lo order time to user buffer .ENDC ;EQ MMG$T 100$: CMP #,C.SYS(R4) ;Is it a system element? BEQ 110$ ;Yes, don't link it to AVAIL MOV CNTXT,R5 ;Point to impure area CALL AQLINK ;Place element on his AVAIL queue 110$: TST R0 ;Canceling all? BEQ 70$ ;Yes, keep trucking .IF EQ SB TST (SP)+ ;Purge job number .ENDC ;EQ SB RETURN ;No, we succeeded ............ 120$: .IF EQ SB MOV R0,@SP ;Ran off end. Clobber job number with ID NEG (SP)+ ;Dump stack, set C if not cancelling all .IFF ;EQ SB NEG R0 ;Set C if not cancelling all .ENDC ;EQ SB RETURN ;Return ............ .ENDC ;NE TIME$R .DSABL LSB .SBTTL .SDTTM - Set Date And/Or Time .ENABL LSB S$DTTM:: .IF NE MMG$T MOV #,R1 ;Check out three user words CALL ACHBKM ;Are they all ok? BCS SYSER0 ;No, address error .ENDC ;NE MMG$T .IF NE TIME$R ENSYS EMTRTI ;Enter System State to change things .ENDC ;NE TIME$R MOV (R0)+,R1 ;; Get user's new date value CMP R1,#-1 ;; If it is specifically -1, BEQ 10$ ;; don't change the date, otherwise ;; it's okay (allow the negative ;; date values due to RT epoch bits) MOV R1,DATES ;; Set the new date 10$: MOV (R0)+,R1 ;; Get user's new high order time value CMP R1,#-1 ;; If it is specifically -1, BEQ 20$ ;; then don't change the time .IF NE TIME$R MOV @R0,R0 ;; Get low order time, too SUB PSCLOK,R0 ;; Convert to pseudo time ... SBC R1 ;; ... double precision by ... SUB PSCLKH,R1 ;; ... computing time change MOV R0,$TIME+TIM.LO ;; Update time low MOV R1,$TIME+TIM.HI ;; Update high time, too 20$: RETURN ;; Done ............ .IFF ;NE TIME$R SPL 7 ;Keep out clock interrupt MOV @R0,$TIME+TIM.LO ;;; Set new low order time MOV R1,$TIME+TIM.HI ;;; Update high time, too SPLDON: SPL 0 ;;; Back down 20$: BR EMTRTL ;Done ............ .ENDC ;NE TIME$R .DSABL LSB .SBTTL .SFDATe - Set file date .ENABL LSB ;+ ; Operation byte values ;- ..GETF ==: 0 ;Return value only ..BICF ==: 1 ;Bit clear using mask value ..BISF ==: 2 ;Bit set using mask value ..MOVF ==: 3 ;Move (replace) operation MAX.F ==: ..MOVF ;Maximum valid value ;+ ; Entry for .SFDATe ; ; "Every day, in every way, I'm getting better and better." ; - Emile Coue ; ; "Seize the day, put no trust in the morrow." ; - Horace, "Odes" ;- S$FDAT: CALL ENQUSR ;Serialize, using USR .ADDR #,R2 ;R2 -> substitute argument block ;>>>$Rel MOV (R1)+,(R2)+ ;Copy date BNE 10$ ;Date specified ;>>>???roll date??? MOV DATES,-2(R2) ;Use current date 10$: MOV (PC)+,(R2)+ ;Force MOV operation on date word .BYTE ..MOVF,E.DATE BR 20$ ;Join common code ............ .SBTTL .FPROT - Set/clear file protection bit ;+ ; Entry for .FPROT ; ; "Shoot first, make inquiries later, and if you make ; mistakes, I will protect you." ; - H. Goering, "Instruction to the Prussian Police". ;- F$PROT: MOV (R1)+,-(SP) ;Get byte value BIC #^c<377>,@SP ;Clear high byte junk CMP #<..FPRO>,@SP ;Must be 0 (unprotect) or 1 (protect)? BLO 30$ ;Branch if out of range CALL ENQUSR ;Serialize, using USR .ADDR #,R2 ;Point to substitute arg block ;>>>$Rel MOV #,(R2)+ ;Bit to manipulate MOV (PC)+,@R2 ;Assume setting protection .BYTE ..BICF,E.STAT .Assume ..BICF+1 EQ ..BISF ADD (SP)+,(R2)+ ;BIC for 0, BIS for 1 20$: MOV @R1,@R2 ;Copy flag word .ADDR #,R1 ;Point to substitute arguments ;>>>$Rel MOV #<100000>,R2 ;Restore EMT index BR 40$ ;Join common code ............ 30$: TST (SP)+ ;Align stack EMTER3 ;Error 3 EMTRTL: CALLR EMTRTI ;Return from EMT ............ .SBTTL .GFDATe - Get file date .SBTTL .SFSTAt - Set file status .SBTTL .GFSTAt - Get file status .SBTTL .SFINFo - Set file information .SBTTL .GFINFo - Get file information ;+ ; Entry for .GFDATe, .SFSTAt, .GFSTAt, .SFINFo, .GFINFo ; ; L'homme absurde est celui qui ne change jamais. ; [The absurd man is he who never changes.] ; - Auguste Marseille Barthelemy ;- F$INFO: CALL ENQUSR ;Serialize, using USR 40$: CALLR FSINFO ;Go to the USR ............ INTBLK: .BLKW 3. ;Temp arg area (serialized on USR) .DSABL LSB .IF EQ SB ;If not SB/XB (For next page) .SBTTL .PROTE - Protect Or Unprotect Vector EMT .ENABL LSB P$ROTE: CMP #,R0 ;Address must be <500 and =0 mod 4 BLOS EMT1ER ;No, give error 1 ASR R0 ;Get word pair index BCS EMT1ER ;Address not =0 mod 4 ASR R0 BCS EMT1ER ;Address not =0 mod 4 MOV R0,R1 ;Get shift count BIC #^c<3>,R1 ;0-3 ADD PC,R1 ;In a pic way, ... MOVB 40$-.(R1),R2 ; ... get a mask for a vector ;>>>$REL ASR R0 ;Convert to byte number ASR R0 ADD R0,R5 ;Offset the impure pointer MOV R5,R3 ;Copy pointer and ... ADD #,R3 ; ... offset it to user bit map .ADDR #,R0,ADD ;Point to perm map byte ;>>>$REL ENSYS EMTRTI TST R4 ;; Protect or Unprotect? BEQ 20$ ;; Go do protect CALL JOBKMN ;; Is this KMON in the background? BMI 10$ ;; Yes, unconditionally unprotect it BITB R2,@R3 ;; Previously protected by user? BEQ 30$ ;; No, ignore request 10$: BICB R2,@R0 ;; Clear RMON map BICB R2,@R3 ;; Clear USER map BR 30$ ;; Return ............ 20$: BITB R2,@R0 ;; Are those locations already protected? BNE 90$ ;; Yes, give error 0 BISB R2,@R0 ;; No, protect them CALL JOBKMN ;; Is this KMON in the background? BMI 30$ ;; Yes, make it permanent protect BISB R2,@R3 ;; Set bit in user temporary bit map 30$: RETURN ;; Get out of System State ............ .ENDC ;EQ SB EMT1ER: EMTER1 ;Give error 1 .IF NE SB P$ROTE: C$PYCH: .ENDC ;NE SB CALLR EMTRTI ;Get out of EMT ............ .IF EQ SB ;>>>MOVE THIS LINE ABOVE EMT1ER IF BRANCHES FIT 40$: .BYTE ^b<11000000>,^b<00110000>,^b<00001100>,^b<00000011> .SBTTL .CHCOP - Copy Other Job's Channel EMT ;+ ; C$PYCH - Copy another job's channel ; ; R0 = number of channel to be copied ; R1 -> logical job name pointer (system tasking only) ; -> 0 (non-system tasking) ; R3 -> this job's channel ;- C$PYCH::TST @R3 ;This job's channel active? BMI EMT1ER ;Yes, error 1 MOV R0,R4 ;Save other job's channel number .IF NE SYT$K MOV @R1,R0 ;R0 -> logical job name BEQ 50$ ;Zero means compatibility mode (FG,BG only) .IF NE MMG$T CALL ACHJBM ;Address check, map to logical job name ; gives MONERR if illegal address .ENDC ;NE MMG$T CALL FNDJOB ;Find that job, R2 -> impure area BEQ 60$ ;Job doesn't exist, give ERROR 0 BR 70$ ;Got it, go do the copy ............ .ENDC ;NE SYT$K 50$: CALL OTHRJB ;Get impure pointer of other job BCC 70$ ;Request is legal 60$: CALLR ER0EMT ;Give no such job error ............ 70$: ENSYS EMTRTI ;Stop activity on channel while we copy BIC #^c<377>,R4 ;; Isolate other guy's channel number CMPB I.CNUM(R2),R4 ;; Does other job have enough channels? BLOS 90$ ;; Nay .ASSUME C.SIZ EQ 10. MOV R4,R1 ;; ASL R4 ;; Channel * 2 ASL R4 ;; * 4 ADD R1,R4 ;; * 5 ASL R4 ;; * 10. ADD I.CSW(R2),R4 ;; Point to the channel MOV (R4)+,R1 ;; Save first word BPL 90$ ;; Error, channel not active MOV R1,@R3 ;; Copy CSW BIC #,(R3)+ ;; We no gotta rewrite on CLOSE MOV (R4)+,(R3)+ ;; Start block MOV (R4)+,(R3)+ ;; Hole size MOV (R4)+,(R3)+ ;; Data size TSTB R1 ;; Was this file entered? BPL 80$ ;; No, it was looked up MOV -(R3),-(R3) ;; Change hole size to max size used BIC (R3)+,(R3)+ ;; Fix R3, and it's like a LOOKUP! 80$: MOV (R4)+,@R3 ;; Unit number CLRB @R3 ;; Clear I/O count byte RETURN ;; ............ 90$: CALLR SYSER0 ;; ............ .DSABL LSB .ENDC ;EQ SB .IF NE FPU$11 .SBTTL FPPINT - Floating Point Interrupt Handler .ENABL LSB FPPINT::MOV #<100000>,(PC)+ ;;; Set flag saying interrupt FPPFLG:: .WORD 0 ;;; FPP interrupt flag (Hi bit=1 => interrupt) CMPB 2(SP),# ;;; Did we interrupt the system? BLO 10$ ;;; BR if not RTI ;;; Yes, out fast ............ 10$: MOVB 2(SP),20$ ;;; No, go down appropriately COMB 20$ JSR R5,$INTEN ;;; Enter System State (and drop priority) 20$: .WORD 0 RETURN ;; And process error later ............ .DSABL LSB .ENDC ;NE FPU$11 .SBTTL LKINT - Clock Interrupt Handler ;+ ; "The time is out of joint; o cursed spite, ; That ever i was born to set it right." - Shakespeare ; "Hamlet" ; ; "Tempora labuntur" - Ovid ;- .ENABL LSB .IF EQ TIME$R LKINT:: ADC $TIME+TIM.LO ;;; Bump low order time ADC $TIME+TIM.HI ;;; Carry into high order time EXINT: RTI ;;; Quick exit ............ .IFF ;EQ TIME$R .IF EQ VENU$C EXINT: RTI ;;; Quick exit ............ .ENDC ;EQ VENU$C LKINT:: ;;; .IF NE VENU$C .SBTTL TOYINT - VENUS Console TOY Clock Interrupt Service ;+ ; This is the interrupt code that gets control when the TOY clock gives it's ; 1 msec interrupt. It checks the TSEL bit in the TURN register for an update ; request from the CPU. After updating the TOY chip and BTOY we clear TSEL ; and exit. ; ; If TSEL isn't set on entry, the code checks if 10 msec have elapsed since ; the last update to BTOY. If not, the code exits. Else, we set the UPEND ; bit in CMISC to take control of the UTOY register. The contents of BTOY ; are moved to UTOY and TSEL is set so the CPU reads UTOY instead of BTOY on ; an MFPR request. Then the BTOY is updated from the TOY chip. Finally, ; TSEL and UPEND are cleared. ; ; It then counts two 10 msec ticks and updates RT-11's time by providing ; a 50HZ interrupt rate. (viva la France) ;- .ASSUME TOYINT EQ LKINT TOYINT::MOVB #,@#MCSR3 ;;; Acknowledge (dismiss) TOY interrupt MOV R5,-(SP) ;;; Save a work register MOV #,R5 ;;; Point to useful register ;+ ; Here begins TSEL processing ; ; NOTE: Interrupt latency and 1 msec interrupt rate should be added to ; timing estimate for period of TSEL ON to TSEL CLEARED. ;- 10$: BITB #,@#MCSR2 ;;; Is electrical power available yet? BNE 40$ ;;; No, don't read UTOY BITB #,@#TURN ;;; Update request? BEQ 40$ ;;; No, continue BITB #,@#MCSR2 ;;; Is power going away? BNE 30$ ;;; Yep, leave clock alone ;+ ; We will move UTOY to TOY now ;- MOVB #,@R5 ;;; Stop counters 3 and 4 MOVB #,@R5 ;;; Select the G3 LOAD register MOV @#UTOY,-(SP) ;;; Copy G3 COUNT to stack MOVB @SP,@#TWDR ;;; Copy to clock (byte at a time to avoid ... MOVB 1(SP),@#TWDR+1 ;;; ... timing problems in 9513 chip) MOVB #,@R5 ;;; Select the G4 LOAD register MOV @#UTOY+2,-(SP) ;;; Copy G4 COUNT to stack MOVB @SP,@#TWDR ;;; Copy to clock (byte at a time to avoid ... MOVB 1(SP),@#TWDR+1 ;;; ... timing problems in 9513 chip) MOVB #,@R5 ;;; Transfer LOAD regs to COUNT regs BIS (SP)+,(SP)+ ;;; Pop 32 bits from stack BEQ 20$ ;;; All zeros, leave clock frozen MOVB #,@R5 ;;; Select counter 3 CLRB @#TWDR ;;; Clear it (byte at a time to avoid ... CLRB @#TWDR+1 ;;; ... timing problems in 9513 chip) MOVB #,@R5 ;;; Select counter 4 CLRB @#TWDR ;;; Clear it (byte at a time to avoid ... CLRB @#TWDR+1 ;;; ... timing problems in 9513 chip) MOVB #,@R5 ;;; Arm the clock 20$: MOV @#UTOY,@#BTOY ;;; Update BTOY MOV @#UTOY+2,@#BTOY+2 ;;; Update BTOY+2 BICB #,@#TURN ;;; Acknowledge the MTPR operation 30$: DEC TOY10 ;;; 10mSecs up? BNE 70$ ;;; Not up, done for now MOV #<10.>,TOY10 ;;; Set up for next pass BR 60$ ;;; Done with VENUS stuff ............ ;+ ; Here ends TSEL processing ; ; Check for time to update the BTOY register (once each 10 msec). ;- 40$: DEC (PC)+ ;;; 10mSecs up? TOY10: .WORD < 10. + .-. > ;;; Counter (modified ...) BNE 70$ ;;; Not up, done for now MOV #<10.>,TOY10 ;;; Set up for next pass BITB #,@#MCSR2 ;;; Is power going away? BNE 60$ ;;; Yep, leave clock alone MOVB #,@#CMISC ;;; Request to use the UTOY register NOP ;;; Pause for slow machines BITB #,@#TURN ;;; Has CPU stomped on our request? BEQ 50$ ;;; No, we own UTOY now INC TOY10 ;;; Minor adjustment before we loop back CLRB @#CMISC ;;; Clear only writeable bit in CMISC BR 10$ ;;; Abort: go service the MTPR request ............ 50$: MOV @#BTOY,@#UTOY ;;; Copy BTOY data to UTOY MOV @#BTOY+2,@#UTOY+2 ;;; Copy BTOY+2 data to UTOY+2 BISB #,@#TURN ;;; Set bit to redirect source of MFPR MOVB #,@R5 ;;; Save the time MOVB #,@R5 ;;; Get low word MOVB @#TRDR,@#BTOY ;;; Low 16 for BTOY (byte at a time to ... MOVB @#TRDR+1,@#BTOY+1 ;;; ... avoid timing problems in 9513 chip) MOVB #,@R5 ;;; Get high word MOVB @#TRDR,@#BTOY+2 ;;; High 16 for BTOY (byte at a time to ... MOVB @#TRDR+1,@#BTOY+3 ;;; ... avoid timing problems in 9513 chip) BICB #,@#TURN ;;; Release control of BTOY CLRB @#CMISC ;;; Clear only writable bit in CMISC 60$: COM #< 0 + .-. > ;;; 20msec up? (Flip/Flop) BNE 80$ ;;; Yes, bump RT-11's clock 70$: MOV (SP)+,R5 ;;; Restore work register .BR EXINT ;;; And just dismiss interrupt ............ EXINT: RTI ;;; Quick exit ............ 80$: MOV (SP)+,R5 ;;; Restore work register .ENDC ;NE VENU$C INC (PC)+ ;;; Bump tick counter TIKCTR:: .WORD 0 TST INTLVL ;;; Did we interrupt system? BPL EXINT ;;; Yes, get out quick JSR R5,$INTEN ;;; No, declare an interrupt .WORD < ^c & PR7 > ;;; Priority = 6 RETURN ;; Just return, int exit code handle it ............ ;+ ; Process pending clock ticks ;- TIMER:: CLR TIKCTR ;;; We have the count in R5 SPL 0 ;;; Down to zero ADD R5,(PC)+ ;Update system pseudo-clock PSCLOK:: .WORD 0 ;System pseudo-clock 90$: MOV (PC)+,R4 ;Point to clock queue LKQUE:: .WORD 0 ;-> clock queue BCS 120$ ;Different routine if PSCLOCK overflow BEQ EXUSER ;Out if queue empty TST (R4)+ ;Is high order expiration time = 0? BNE EXUSER ;No, it cannot expire CMP PSCLOK,(R4)+ ;Is pseudo clock < expiration time? BLO EXUSER ;No, not expired 100$: ROR -(SP) ;Save carry MOV (R4)+,LKQUE ;Link queue forward MOV @R4,R5 ;R5 = job number CALL $RQTSW ;Ask for a switch for him .IF EQ SB ADD PC,R5 ;>>>$REL MOV $IMPUR-.(R5),R5 ;Point to his impure area .IFF ;EQ SB MOV CNTXT,R5 ;Point to his impure area .ENDC ;EQ SB BIS #,(R5)+ ;Set completion pending SUB #,R4 ;Point to beginning of element MOV R0,-(SP) ;Save R0 CALL CQLINK ;Link it onto completion queue MOV (SP)+,R0 ROL (SP)+ ;Restore Carry BR 90$ ;Start with top of queue again ............ 110$: SUB #<1>,(R4)+ ;Normalize queue element, set C if expired BIT (R4)+,R0 ;Advance pointer over low time BCS 100$ ;If Carry on, expired. Go dispatch MOV @R4,R4 ;Else link to next element 120$: BNE 110$ ; if any INC (PC)+ ;Bump high order pseudo clock PSCLKH:: .WORD 0 ;High order pseudo clock CLC ;Done normalizing queue BR 90$ ;Look for expired elements ............ .ENDC ;EQ TIME$R .DSABL LSB .SBTTL $INTEN/$ENSYS - Common Interrupt Entry And Exit ;+ ; "Life is made up of interruptions." - W.S. Gilbert, "Patience" ; "For sleep, health, and wealth to be truly enjoyed, they must ; be interrupted." - J.P. Richter, "Flower, Fruit, and Thorn Pieces" ; ; Every handler and every interrupt-level routine must call the ; common entry code at $INTEN. ; If a handler asks for a task switch, this switch will be deferred ; until we are about to return to the user. This keeps the stack from ; getting messed up. Furthermore, all interrupt level code runs ; on the system stack. ; The call is of the form: ; MOV @#$SYPTR,-(SP) ; JSR R5,@(SP)+ (or JSR R5,$INTEN internally) ; (Handlers are given a pointer to $INTEN when FETCHed) ; .WORD < ^c & 340 > ;- ;+ ; The monitor calls $ENSYS to enter System State to manipulate ; the timer queue or to change context, etc. ; System State inhibits task switching so that we can be ; assured of completing the modification of a job's data base ; without the spurious injection of a context switch. ; The call is: ; JSR R5,$ENSYS ; .WORD
-. ; .WORD PR7 ; The routine following the call is executed in System State. ; It MUST return via a RETURN (i.e., RTS PC). ;- .ENABL LSB $ENSYS::MOV R5,-(SP) ;Save user return address ADD (R5)+,@SP ;Fudge it to return where he wants ;+ ; ENSHOK (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; CALLR $GETEN ; ; The $GETEN routine is located in the RTEM-11 linkage ; routines. This hook allows RTEM-11 to correctly ; handle a switch into System State, by disabling ; RSX-11 AST's. ;- ENSHOK:: ;(*** RTEM-11 HOOK ***) MOV 2(SP),-(SP) ;Save real R5 .IF EQ MMG$T GETPSW ;Stack the PS MOV (SP)+,4(SP) ;Save PS in place .IFF ;EQ MMG$T MOV @#PS,4(SP) ;Get the PS directly .ENDC ;EQ MMG$T SPL 7 ;Enter here to switch into System State $INTEN::MOV R4,-(SP) ;;; Save R4 INC (PC)+ ;;; Bump level pointer INTLVL:: .WORD -1 ;;; Interrupt level .IF EQ MMG$T BGT 10$ ;;; Go if already switched stacks MOV SP,(PC)+ ;;; Save user's stack pointer TASKSP:: .WORD 0 ;;; User's stack pointer MOV (PC)+,SP ;;; Switch to system stack RMONSP:: .WORD RMSTAK ;System stack pointer storage ;>>>$Rel .-2 RMSTAK RMON 10$: MOV R4,-(SP) ;;; Preserve R4 .ENDC ;EQ MMG$T ;+ ; The following two instructions are modified by the BOOT if the ; processor is found to be an LSI11. The instruction sequence becomes: ; ; MFPS R4 ; BIC (R5)+,R4 ; MTPS R4 ; ;*************************************************************** ;- ;+ ; RMONPS (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; CALL $SPL0 ; TST (R5)+ ; ; The $SPL0 routine is located in the RTEM-11 linkage ; routines. This hook allows RTEM-11 to correctly ; lower its effective priority by enabling RSX-11 ; AST's. ;- RMONPS:: ;;; (*** RTEM-11 HOOK ***) MOV #,R4 ;;; R4 -> PS BIC (R5)+,@R4 ;;; Down to handler priority ;*************************************************************** .IF EQ MMG$T MOV (SP)+,R4 ;; Restore R4 (for $ENSYS entry) CALL @R5 ;; Call handler back (it will RETURN back) .IFF ;EQ MMG$T MOV @SP,R4 ;; Restore R4 (for $ENSYS entry) MOV R5,-(SP) ;; Push call address on stack MOV 4(SP),R5 ;; Restore R5 (for $ENSYS entry in XM) CALL @(SP)+ ;; Call handler back (it will RETURN back) .ENDC ;EQ MMG$T ;+ ; "Allow time and moderate delay; haste manages all things badly." ; - Statius ; ; Process a return from interrupt level. ;- SPL 7 ;Prevent interrupts TST INTLVL ;;; To where are we about to return? BEQ EXUSER ;;; BR if exiting to user DEC INTLVL ;;; Decrement interrupt level BR RTICMN ;;; And exit this interrupt ............ ;+ ; Dispatch all FORK requests. ;- FRK:: SPL 0 ;;; Allow interrupts MOV R3,-(SP) ;Save regs 3-0 MOV R2,-(SP) ; MOV R1,-(SP) ; MOV R0,-(SP) ; .IF NE MMG$T CALL KPSAVE ;Make sure PAR 1 mapped to default .ENDC ;NE MMG$T SPL 7 ;Prevent interrupts MOV @R4,FRKCQE ;;; Remove an entry from queue BNE 20$ ;;; BR if more entries in queue CLR FRKLQE ;;; Clear last entry pointer 20$: CLR (R4)+ ;;; Clear link SPL 0 ;;; Allow interrupts TST @R4 ;Was this element aborted? BEQ 30$ ;Yes, just ignore it MOV (R4)+,-(SP) ;Save FORK address for a moment MOV (R4)+,R5 ;Restore handler's R5,r4 MOV (R4)+,R4 CALL @(SP)+ ;Call handler 30$: .IF NE MMG$T CALL KPREST ;Restore PAR 1 mapping .ENDC ;NE MMG$T MOV (SP)+,R0 ;Restore regs MOV (SP)+,R1 MOV (SP)+,R2 MOV (SP)+,R3 .BR EXUSER ............ EXUSER:: .IF NE FPU$11 ASL FPPFLG ;Hath he a pendant FPP interrupt? BCS 50$ ;Yes, force to him an interrupt .ENDC ;NE FPU$11 40$: SPL 7 ;To the user! MOV FRKCQE,R4 ;;; Anything on FORK queue? BNE FRK ;;; Yes, go do it .IF NE TIME$R MOV TIKCTR,R5 ;;; Any clock ticks to handle? BNE TIMER ;;; Yes, count them off .ENDC ;NE TIME$R MOV (PC)+,R4 ;;; Is there any action to do? INTACT:: .WORD 0 BNE EXSWAP ;;; Yes, go do it DEC INTLVL ;;; Decrement interrupt level .IF EQ MMG$T MOV TASKSP,SP ;;; Switch to user stack .ENDC ;EQ MMG$T .BR RTICMN ;;; Take common RTI ............ ;+ ; RTICMN (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; CALLR $RTIC ; ; The $RTCI routine is located in the RTEM-11 linkage ; routines. This hook allows RTEM-11 to correctly ; enable AST recognition before returning using the ; RTI instruction. ;- RTICMN:: ;;; (*** RTEM-11 HOOK ***) MOV (SP)+,R4 ;;; Restore regs MOV (SP)+,R5 ;;; RTI ;;; And return to him ............ .IF NE FPU$11 50$: .IF EQ MMG$T MOV TASKSP,R4 ;Put an FPP interrupt on his stack MOV (R4)+,-(SP) ;Save his old R4/R5 MOV (R4)+,-(SP) BIT #,CONFIG ;Does the hardware have an FPU? ;+ ; FPSHOK (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; CALL $FPST ; ; The $FPST routine is located in the RTEM-11 linkage ; routines. This hook allows RTEM-11 to correctly ; save the FPU status in the emulated environment. ;- FPSHOK:: ;(*** RTEM-11 HOOK ***) BEQ 60$ ;No STST -(R4) ;Yes, save status 60$: CLR -(R4) ;Fake PS .IF EQ SB MOV CNTXT,R5 ;Point to user's impure MOV I.FPP(R5),-(R4) ;Set to return to his FPU routine .IFF ;EQ SB MOV I.FPP+BKGND,-(R4) ;Set to return to his FPU routine .ENDC ;EQ SB CMP #<1>,@R4 ;Got he any? BLO 70$ ;Branch if so .ADDR #,@R4 ;No, use ours ;>>>$REL 70$: .IF EQ SB MOV #,I.FPP(R5) ;Avoid recursion .IFF ;EQ SB MOV #,I.FPP+BKGND ;Avoid recursion .ENDC ;EQ SB MOV (SP)+,-(R4) ;Restore his R4/R5 MOV (SP)+,-(R4) MOV R4,TASKSP ;Reset SP BR 40$ ........... .IFF ;EQ MMG$T GET SP,R4 ;Get previous mode SP into R4 MOV CNTXT,R5 ;Point R5 to user mode ADD #,R5 ; FPP routine .IF NE SUP$Y BIT #<20000>,@#PS ;Was trap from supervisor mode? BNE 80$ ;Branch if trap was from user mode ADD #,R5 ;R5 -> supervisor mode FPP exception addr 80$: .ENDC ;NE SUP$Y CMP #,@R5 ;Reentering FPP routine? BLO 90$ ;No, dispatch to him .ADDR #,R5 ;Kludge interrupt on stack to point to ;>>>$REL MOV R5,4(SP) ; our FPP routine MOV @#PS,6(SP) ;Go there in Kernel mode BIC #^c,6(SP) ; preserving previous mode BR 100$ ;Merge with common code ............ 90$: PUT 6(SP),-(R4) ;Push interrupted PS on user stack PUT 4(SP),-(R4) ;Push interrupted PC on user stack MOV @R5,4(SP) ;Put FPP routine address in RTI frame MOV #,@R5 ;Prevent reentrancy 100$: BIT #,CONFIG ;Do we have an FPU? BEQ 110$ ;No, no FEA or FEC STST -(SP) ;Push FEA, FEC on stack PUT 2(SP),-(R4) ;Push FEA on user stack PUT (SP)+,-(R4) ; and FEC, too TST (SP)+ ;Pop off original FEA that STST pushed on 110$: PUT R4,SP ;Reset his stack pointer BR 40$ ;Try to exit ............ .ENDC ;EQ MMG$T .ENDC ;NE FPU$11 .DSABL LSB .SBTTL EXSWAP - Exit To User ;+ ; "It is always those who are ready who suffer in delays." ; - Dante, "The Divine Comedy" ; ; Here we are about to exit to the user. ; We must see if a task switch has been requested, or if an abort ; is in progress. ;- .ENABL LSB EXSWAP::BMI ABTENT ;;; Do an abort CLR INTACT ;;; Do a task switch. Clear action flag .IF EQ SB INC R4 ;;; Add 2 to start search ASLB R4 ;;; Make it a true job number MOV R4,JOBNUM ;;; Keep it .ENDC ;EQ SB SPL 0 ;;; Any new requests are caught later ;+ ; NOTE: a race condition cannot develop here, since an asynchronous ; request for a switch to job 'jobnum' or higher will be honored, ; and any asynchronous request for jobnum-2 or lower need not be ; formally honored, since we will examine that job in the loop now. ; we keep jobnum as high as possible at all times so that spurious ; requests for a switch to a low priority job will not cause a pass ; through the scheduling loop. ; ; "It is not enough to be busy; so are the ants. The question is, ; what are we busy about?" ; - H. D. Thoreau ;- .IF EQ SB .ADDR #<$IMPUR>,R4,ADD ;Point to $IMPUR table entry ;>>>$REL SCHDLR:: 10$: SUB #<2>,JOBNUM ;We are about to examine the next job BMI 30$ ;Nothing runnable! MOV -(R4),R5 ;Get pointer to impure area BEQ 10$ ;Job does not exist .IFF ;EQ SB MOV CNTXT,R5 ;Get pointer to impure area .ENDC ;EQ SB TST I.BLOK(R5) ;Any blocking bits on? BEQ 20$ ;No! we can go to him! .ASSUME I.STAT EQ 0 BIT #,@R5 ;Blocked in cmpl, or cmpl pending? .IF EQ SB BLE 10$ ;If in cmpl or nothing pending, skip BIT #,I.BLOK(R5) ;Is he R E A L L Y suspended? BNE 10$ ;Yes, even completion cannot run .IFF ;EQ SB BLE 30$ ;If in cmpl or nothing pending, not runnable .ENDC ;EQ SB 20$: CALL CNTXSW ;No, do the context switch! EXUSLK: BR EXUSER ;And try to exit again ............ ;+ ; "A source of innocent merriment!" ; - W.S. Gilbert, "Mikado" ; "Did nothing in particular, and did it very well" ; - W.S. Gilbert, "Iolanthe" ; "To be idle is the ultimate purpose of the busy" ; - Samuel Johnson, "The Idler" ; "I got plenty of nothin', and nothin's plenty fo' me!" ; - George and Ira Gershwin, "Porgy and Bess" ;- 30$: .IF NE LIGH$T DEC (PC)+ ;The RT-11 lights routine! LITECT: .WORD 1 BNE ..NULJ ;Not too often ADD #<512.>,LITECT ;Reset count, clear carry 40$: ROL 70$ ;Juggle the lights BNE 50$ ;Not clear yet COM 70$ ;Turn on lights, set Carry 50$: BCC 60$ ;Nothing fell off, keep moving ADD #<100>,40$ ;Reverse direction BIC #<200>,40$ ;ROL/ROR flip 60$: BIT #,CONFG2 ;Does CPU have a light register? BEQ ..NULJ ;No MOV (PC)+,@(PC)+ ;Put in lights (for 11/45) 70$: .WORD 0, SR .ENDC ;NE LIGH$T ..NULJ:: .IF EQ RTE$M ;;; WAIT ;Nothin' to do, so don't NOP ;Nothin' to do, so don't .IFF ;EQ RTE$M NOP ;Let the host do the waiting .ENDC ;EQ RTE$M NOP ;Second pad instruction .BR SCNALL ;Drop into ready job scan loop setup ............ ;+ ; SCNALL (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; MOVB #,-(SP) ; Job number on top of stack ; CALLR $IDLP ; Enter the RTEM idle loop ; ; The $IDLP routine is located in the RTEM-11 linkage ; routines. This hook allows RTEM-11 to correctly ; become idle, by waiting on the idle loop event flag. ;- SCNALL:: ;(*** RTEM-11 HOOK ***) MOVB #,INTACT ;Do a complete scan BR EXUSLK ;Back into LOOKFOR loop ............ .DSABL LSB .SBTTL UABORT - Abort Users ;+ ; "Behold the lord high executioner! ; A personage of noble rank and title - ; A dignified and potent officer, ; Whose functions are particularly vital." ; - W.S. Gilbert, "The Mikado" ; ; The following entry point is used to abort a running job. ; It switches to System State, sets the abort bit for the user, ; and falls into the abort code. ;- UABORT::ENSYS . ;Get into System State BIS #,@CNTXT ;; And request the abort .IF NE MMG$T BIS #<100000>,INTACT ;; Set 'abort pending' flag RETURN ;; Go thru interrupt exit code ............ .ENDC ;NE MMG$T ;+ ; This routine aborts all user tasks which are waiting to be aborted. ; It purges all I/O, stops any running I/O, cleans up the impure ; area so that the guy is runnable, and forces him to return to ; $EXIT. ;- .ENABL LSB ABTENT::SPL 0 ;;; Down to Priority 0 10$: CALL SWAPME ;We must consider current user later CLRB INTACT+1 ;Turn off 'abort req' flag .IF EQ SB MOV IMPLOC,R4 ;Point to table of impure pointers 20$: MOV -(R4),R5 ;Get an impure pointer BEQ 20$ ;Job not extant CMP R5,#<-1> ;End of table? BEQ EXUSLK ;Yes, done with abort .ASSUME I.STAT EQ 0 BIT #,@R5 ;Is it he? BEQ 20$ ;No BIT #,I.BLOK(R5) ;Is job dead? BNE 20$ ;Yes, bad TSTB DFLG ;Is job doing directory operation? BEQ 30$ ;No CMPB USROWN,I.JNUM(R5) ;If so, is this the job? BEQ 20$ ;Yes, catch him later .IFF ;EQ SB BIT #,@CNTXT ;Is it he? BEQ EXUSLK ;No, done with abort TSTB DFLG ;Is job doing directory operation? BEQ 30$ ;No TSTB USROWN ;If so, is this the job? BEQ EXUSLK ;Yes, catch him later .ENDC ;EQ SB 30$: CALL CNTXSW ;Switch to abort context .IF EQ MMG$T CALL IORSET ;Reset any active I/O MOV TASKSP,R5 ;Point to task's stack .IFF ;EQ MMG$T CALL KPSAVE ;Switch to handler mapping. CALL IORSET ;Reset any active I/O. CALL KPREST ;Back to old Kernel mapping. MOV SP,R5 ;We're using the Kernel stack. .ENDC ;EQ MMG$T CMP (R5)+,(R5)+ ;Skip over saved regs MOV PC,@R5 ;Put address of GOEXIT on stack ADD #,(R5)+ ;>>>$REL? .IF NE MMG$T BIC #,@R5 ;Set Kernel mode .ENDC ;NE MMG$T .IF EQ SB MOV CNTXT,R5 ;Clean up impure area: .ASSUME I.STAT EQ 0 MOV #,@R5 ;Wipe out special job status CLR I.BLOK(R5) ;Clear blocking bits CLR I.TTLC(R5) ;No type-ahead CLR I.SCTR(R5) ;Clear suspend count MOV I.IPUT(R5),I.IGET(R5) ;Equalize input buffer pointers CLR I.ICTR(R5) ;No input waits .IFF ;EQ SB .ASSUME I.STAT EQ 0 MOV #,@CNTXT ;Wipe out special job status CLR I.BLOK+BKGND ;Clear blocking bits CLR I.TTLC+BKGND ;No type-ahead CLR I.SCTR+BKGND ;Clear suspend count MOV I.IPUT+BKGND,I.IGET+BKGND ;Equalize input buffer pointers CLR I.ICTR+BKGND ;No input waits .ENDC ;EQ SB .IF EQ MMG$T BIC #,@#$JSW ;Clean up special status .IFF ;EQ MMG$T BIS #,@#PS ;Make sure previous mode is User GET @#$JSW,-(SP) ;Get user $JSW BIC #,@SP ;Clear special status PUT (SP)+,@#$JSW ;Set in user virtual .ENDC ;EQ MMG$T MOV SP,R0 ;Do not HARD-RESET him in KMON BR 10$ ;Consider aborted guy in SWAP ............ .DSABL LSB .SBTTL $FORK - FORK Request Processor ;+ ; $FORK - Add a FORK block to the FORK queue ; ; State = Interrupt level (after INTEN call) ; ; JSR R5,$FORK ; .WORD FRKBLK-. ; ; R0-R3 = undefined ; ; Returns to routine after all interrupts have been serviced but ; before returning to interrupted user program ; ; Handlers call $FORK at interrupt level to submit a FORK request. ; No context switch is done. The FORK queue is first in/first out (FIFO). ;- .ENABL LSB $FORK:: MOV R4,-(SP) ;Save R4 temporarily MOV R5,R4 ;R4 -> offset to FORK block ADD (R5)+,R4 ;Relocate R4 so R4 -> block ADD #,R4 ;R4 -> past end of block MOV (SP)+,-(R4) ;Save R4 in FORK block MOV (SP)+,-(R4) ;And R5 MOV R5,-(R4) ;Put FORK PC in block CLR -(R4) ;Clear link .ADDR #,R5 ;Point to FORK queue ;>>>$REL SPL 7 ;No interrupts .IF NE MMG$T CALL KPSAVE ;;; Map in PAR 1. .ENDC ;NE MMG$T TST (R5)+ ;;; Anything in queue? BNE 10$ ;;; Yes, add this to it MOV R4,@R5 ;;; Make this the last element BR 20$ ;;; Also make it first element ............ 10$: MOV R4,@(R5)+ ;;; Point last element to this one 20$: MOV R4,-(R5) ;;; Make this one the last (first) element .IF NE MMG$T CALL KPREST ;;; Restore PAR 1 mapping .ENDC ;NE MMG$T RETURN ;;; Return ............ .DSABL LSB .ASSUME FRKLQE EQ FRKCQE+2 .SBTTL CNTXSW - Change Current Context ;+ ; "It is best not to swap horses while crossing the river." ; - A. Lincoln ; ; This routine is entered at System State level 0 to change the ; context of the user level routine. When entered, system stack is in use ; and R4 and R5 are saved on user stack. ; ; It cleverly avoids work if we are asked to switch to the current job. ; It will also kludge up the stack for completion routines if there ; are any pending ; ; Entry: R5 -> impure area of new job ; Exit: R4 = TASKSP ;- .ENABL LSB CNTXSW:: .IF EQ MMG$T MOV TASKSP,R4 ;Point to current task's stack .ENDC ;EQ MMG$T .IF EQ SB CMP CNTXT,R5 ;Is it the same job? BNE 10$ ;BR if not, switch in new job CALLR 250$ ;Yes, skip all the saving stuff ............ 10$: ;Reference label .IF NE MMG$T MOV CNTXT,R4 ;Point to user impure area ADD #>,R4 ;R4 -> past reg save area ;+ ; Save general registers of current job, then TRAP vector and $SYCOM ; area. If XM monitor, also save BPT and IOT vectors. ;- .ENDC ;NE MMG$T MOV R3,-(R4) ;Save regs on his stack MOV R2,-(R4) MOV R1,-(R4) MOV R0,-(R4) .IF NE MMG$T MOV (SP)+,R1 ;R1 = return address MOV (SP)+,-(R4) ;Move R4 to save area MOV (SP)+,-(R4) ;Also R5 MOV (SP)+,-(R4) ;Also PC MOV (SP)+,-(R4) ;And PS MOV @#KISAR1,-(R4) ;Save Kernel PAR1 MOV @#V.MMU,-(R4) ;And Memory Management MOV @#V.MMU+2,-(R4) ;Fault trap vector .ENDC ;NE MMG$T MOV #,R0 ;R0 -> BPT trap MOV (R0)+,-(R4) ;Save BPT PC MOV (R0)+,-(R4) ; and BPT PS .ASSUME V.IOT EQ V.BPT+4 MOV (R0)+,-(R4) ;Save IOT PC MOV (R0)+,-(R4) ; and IOT PS .ASSUME V.POWR EQ V.IOT+4 ADD #,R0 ;Advance R0 to TRAP vector .BR 20$ ........... 20$: MOV (R0)+,-(R4) ;Save TRAP vector CMP R0,#<$SYPTR> ; up to BLO 20$ ; $SYCOM area .IF NE MTT$Y MOV @#$TTFIL,-(R4) ;Save fill char & count .ENDC ;NE MTT$Y MOV CNTXT,R2 ;Get old context .IF NE FPU$11 ADD #,R2 ;Point to special swap list TST (R2)+ ;Wanna swap FPU? BEQ 30$ ;No BIT #,CONFIG ;Got FPU to swap? BEQ 30$ ;BR if no ;+ ; Save FPU registers if they exist and are being used by current job ;- .IF NE MMG$T MOV -(R4),R4 ;R4 -> FPU save area ADD #<<<6*4>+1>*2>,R4 ;Point past end .ENDC ;NE MMG$T STFPS -(R4) ;Store all FPU gorp SETD STD R0,-(R4) STD R1,-(R4) STD R2,-(R4) STD R3,-(R4) LDD R4,R0 STD R0,-(R4) LDD R5,R0 STD R0,-(R4) .IFF ;NE FPU$11 .IF NE MMG$T ADD #,R2 ;R2 -> bottom of saved SP data .IFF ;NE MMG$T ADD #,R2 ;R2 -> extra swap stuff .ENDC ;NE MMG$T .ENDC ;NE FPU$11 ;+ ; Save contents of locations specified in special swap list ; supplied by .CNTXSW EMT on user stack ;- 30$: .IF NE MMG$T BIS #,@#PS ;Make sure previous mode is user GET SP,R4 ;Get user SP into R4 .ADDR #,R3 ;R3 -> end of Kernel stack ;>>>$REL MOV R4,(R2)+ ;Remember user SP before we push things 40$: CMP SP,R3 ;Anything more to pop from Kernel stack? BEQ 50$ ;No PUT (SP)+,-(R4) ;Yes, move a word to user stack BR 40$ ;Try for another ............ 50$: .ENDC ;NE MMG$T MOV (R2)+,R3 ;Anything else to go? BEQ 70$ ;No 60$: PUT @(R3)+,-(R4) ;Move a word onto the user stack TST @R3 ;Until no more BNE 60$ 70$: MOV R3,(R2)+ ;Save top of extra stuff MOV R4,@R2 ;Save old stack pointer .IF NE MMG$T MOV R0,-(SP) ;Save MOV R1,-(SP) ; registers MOV @#KISAR1,-(SP) ;Save kernel PAR1 ;I&D+ MOV (R2),@#KISAR1 ;Map to job's MCA .IF NE SUP$Y MOV @#MMR3,R0 ;Get MMR3 context MOV R0,@# ;Save MMR3 context .IFTF ;NE SUP$Y MOV #,R1 ;U-I PDR0 MOV #,R3 ;U-I APR save area .IFF ;NE SUP$Y CALL CPYAPR ;Save U-I APRs only .IFT ;NE SUP$Y CALL CPYAPM ;Save user APRs BIC #<20000>,@#PS ;Set previous mode to supervisor mode BIT #,(R2) ;Job has supy context? BEQ 90$ ;Branch if supervisor mode not active MFPD SP ;Get supervisor SP (SSP) MOV (SP)+,(R2) ; and save it in impure area MOV #,R1 ;S-I PDR0 MOV #,R3 ;S-I APR save area CALL CPYAPM ;Save supervisor APRs 90$: .ENDC ;NE SUP$Y .ENDC ;NE MMG$T ;I&D- ;+ ; "A word too much always defeats its purpose." ; - Schopenhauer ; ; Done switching out old job. Now bring in the new one ;- MOV R5,CNTXT ;Save context of new job .IF NE MMG$T ;I&D+ MOV I.MPTR(R5),@#KISAR1 ;Map to job's MCA .IF NE SUP$Y MOV @#,R0 ;Get MMR3 context BIC #^C,R0 ;Only user/supy I&D separation ; and CSM matters BIC #,@#MMR3 ;Turn off user/supy I&D ; separation and CSM BIS R0,@#MMR3 ;Restore MMR3 context for new job .IFTF ;NE SUP$Y MOV #,R1 ;U-I APR save area MOV #,R3 ;U-I PDR0 .IFF ;NE SUP$Y CALL CPYAPR ;Restore U-I APRs only .IFT ;NE SUP$Y CALL CPYAPM ;Restore user APRs BIT #,I.CMAP(R5) ;Does job have supervisor context? BEQ 110$ ;Branch if supervisor mode not active MOV I.SSP(R5),-(SP) ;Get saved SSP from impure area MTPD SP ; and restore supervisor SP MOV #,R1 ;S-I APR save area MOV #,R3 ;S-I PDR0 CALL CPYAPM ;Restore supervisor APRs 110$: BIS #,@#PS ;Make sure previous mode is user .ENDC ;NE SUP$Y BIT #LOAD$,@R5 ;Are we doing our first context switch? BEQ 150$ ;Branch if not BIC #LOAD$,@R5 ;Do the setup of APRs this switch only! ;I&D- CALL MAPLO ;Map same as Kernel, assuming privileged job BIT #,@R5 ;Windowed (virtual) task? BEQ 130$ ;If privileged, unmapped PAR's keep Kernel map 120$: CALL CLRPDR ;Virtual, clear out user mapping to all aborts 130$: MOV #<8.>,R2 ;8 U-I windows to map MOV #,R4 ;R4 -> WCBs 140$: CALL MAPWN ;Map a window SOB R2,140$ ;Loop on windows 150$: MOV (SP)+,@#KISAR1 ;Restore kernel PAR1 MOV (SP)+,R1 ;Restore MOV (SP)+,R0 ; registers .ENDC ;NE MMG$T ADD #,R5 ;Point to saved user SP MOV @R5,R4 ;Get new user Stack Pointer MOV -(R5),R2 ;Get top of extra saved words TST -(R5) ;Is there a context switch list? BEQ 170$ ;No 160$: GET (R4)+,@-(R2) ;Yes, restore words from user stack CMP @R5,R2 ;End of list? BNE 160$ ;Not yet .BR 170$ ............ 170$: .IF NE MMG$T MOV -(R5),R2 ;R2 -> top of words to restore to Kernel stack 180$: CMP R4,R2 ;Done restoring? BEQ 190$ ;Yes GET (R4)+,-(SP) ;No, restore a word from user to Kernel stack BR 180$ ;Try again ............ 190$: PUT R4,SP ;Move user stack pointer into user SP .ENDC ;NE MMG$T .IF NE FPU$11 200$: TST -(R5) ;Does the job want the FPU swapped? BEQ 210$ ;No, don't BIT #,CONFIG ;Got an FPU here? BEQ 210$ ;No, can't swap it .IF NE MMG$T MOV I.FPSA-I.FPP(R5),R4 ;R4 -> FPU save area .ENDC ;NE MMG$T SETD ;Always swap FPU in double mode LDD (R4)+,R0 ;Load a word into F0 STD R0,R5 ; and copy to F5 LDD (R4)+,R0 ;Load another STD R0,R4 ; and copy to F4 LDD (R4)+,R3 ;Restore LDD (R4)+,R2 ; F3 through LDD (R4)+,R1 ; F0 registers LDD (R4)+,R0 ; from save area LDFPS (R4)+ ;Restore FPU status 210$: .ENDC ;NE FPU$11 .IF NE MMG$T MOV CNTXT,R4 ;R4 -> $SYCOM save area ADD #,R4 ; in impure area .ENDC ;NE MMG$T .IF NE MTT$Y MOV (R4)+,@#$TTFIL ;Restore fill char & count .ENDC ;NE MTT$Y 220$: MOV (R4)+,-(R0) ;Restore low memory (52-34) CMP R0,# BHI 220$ MOV #,R0 ;Point past IOT vector in Kernel low memory MOV (R4)+,-(R0) ;Restore IOT PS MOV (R4)+,-(R0) ; and IOT address MOV (R4)+,-(R0) ;Restore BPT PS MOV (R4)+,-(R0) ; and BPT address .IF NE MMG$T MOV (R4)+,@#V.MMU+2 ;Restore MMU FAULT PS MOV (R4)+,@#V.MMU ; and MMU address MOV (R4)+,@#KISAR1 ;Restore Kernel PAR1 contents .BR 230$ ............ 230$: MOV (R4)+,-(SP) ;Restore PS MOV (R4)+,-(SP) ; and PC MOV (R4)+,-(SP) ; and saved R5 MOV (R4)+,-(SP) ; and R4 onto Kernel stk MOV R1,-(SP) ;Restore return address to SP BIT #,@CNTXT ;Is it a virtual job? BEQ 240$ ;No BIT #,@CNTXT ;Is it VBGEXE in load phase? BNE 240$ ;Branch if so CALL FIXTRP ;Virtual job, set up Monitor TRAP address 240$: .ENDC ;NE MMG$T MOV (R4)+,R0 ;Restore registers MOV (R4)+,R1 MOV (R4)+,R2 MOV (R4)+,R3 .IF EQ MMG$T MOV R4,TASKSP ;Save pointer to user stack .ENDC ;EQ MMG$T 250$: MOV CNTXT,R5 ;Restore pointer to impure area MOV I.JNUM(R5),JOBNUM ;Set up job number .ENDC ;EQ SB BIT #,@R5 ;He's in. Is completion pending? BLE 260$ ;No, he's in it or nothing is pending .IF EQ MMG$T MOV (R4)+,-(SP) ;Yes, redirect him to completion dispatcher MOV (R4)+,-(SP) ;First, copy his R4/R5 to our stack .ENDC ;EQ MMG$T .IF EQ SB BIC #^c,I.BLOK(R5) ;Unblock him completely ; except for NORUN$ and KSPND$, which if ; set should remain set .IFF ;EQ SB CLR I.BLOK(R5) ;Unblock him completely .ENDC ;EQ SB BIC #,@R5 ;Completion no longer just pending BIS #,@R5 ;Say he is IN completion ADD #,R5 ;Skip over queue heads MOV (R5)+,(R5)+ ;Save channel being waited for by main line MOV @#$ERRBY,(R5)+ ;Save main line error byte .IF EQ MMG$T CLR -(R4) ;Set up a fake PS MOV (PC)+,-(R4) ;When job runs, it enters cmpl dispatcher .$CRTN:: .WORD $CRTNE ;Address of user completion routine exit code ;>>>$Rel .-2 $CRTNE RMON MOV (SP)+,-(R4) ;Restore his R4 & R5 MOV (SP)+,-(R4) MOV R4,TASKSP ;Save his new stack pointer .IFF ;EQ MMG$T MOV (SP)+,R5 ;Save return address in R5 MOV 2(SP),-(SP) ;Copy saved R5 on Kernel stack MOV 2(SP),-(SP) ;Copy saved R4 CLR 6(SP) ;Fake PS, stay in Kernel mode MOV .$CRTN,4(SP) ;Return completion queue dispatcher MOV R5,-(SP) ;Restore our return address .ENDC ;EQ MMG$T 260$: RETURN ;Done swapping context. R5 = TASKSP ............ .IF NE MMG$T .$CRTN:: .WORD $CRTNE ;Address of user completion routine exit code ;>>>$Rel .-2 $CRTNE RMON .ENDC ;NE MMG$T .DSABL LSB .IF EQ SB .IF NE MMG$T .IF NE SUP$Y .SBTTL CPYAPR - Copy (Save/Restore) Specified APRs ;+ ; CPYAPM Copy (Save/Restore) Specified APRs ; ; R0 odd means save I and D-space APRs ; R0 even means save I-space APRs only ; R1 -> APRs to save (source) ; R3 -> 32. word area to store APRs (destination) ; First 8. words are for I-PDRs, second 8. words are for D-PDRs, ; third 8. words are for I-PARs, and fourth 8. words are for D-PARs ; -- just like real APRs! ; ; CALL CPYAPR ; ; R0 = R0/2 (signed) ; R1 = original R1 plus 16(decimal). ; R3 = original R3 plus 16(decimal). ; R4 = 0 ;- .ENABL LSB CPYAPM: CALL CPYAPR ;Save I-space APRs .ASSUME MMR3.U EQ 1 .ASSUME MMR3.S EQ MMR3.U*2 ASR R0 ;Should we save data APRs? BCC 20$ ;Branch if no .ASSUME M.PDUD EQ M.PDUI+16. .ASSUME M.PDSD EQ M.PDSI+16. .BR CPYAPR ;Save D-space APRs .............. .ENDC ;NE SUP$Y .SBTTL CPYAPR - Copy (Save/Restore) Specified APRs ;+ ; CPYAPR Copy (Save/Restore) Specified APRs ; ; R1 -> APRs to save (source) ; R3 -> 24. word area to store APRs (destination) ; First 8. words are for PDRs, second 8. words are skipped, and ; third 8. words are for PARs -- just like real APRs! ; ; CALL CPYAPR ; ; R1 = original R1 plus 16(decimal). ; R3 = original R3 plus 16(decimal). ; R4 = 0 ;- CPYAPR: MOV #<8.>,R4 ;8 APRs to copy .ASSUME M.PAUI-M.PDUI EQ UISAR0-UISDR0 .IF NE SUP$Y .ASSUME M.PAUD-M.PDUD EQ UDSAR0-UDSDR0 .ASSUME M.PASI-M.PDSI EQ SISAR0-SISDR0 .ASSUME M.PASD-M.PDSD EQ SDSAR0-SDSDR0 .ASSUME UDSAR0-UDSDR0 EQ UISAR0-UISDR0 .ASSUME SISAR0-SISDR0 EQ UISAR0-UISDR0 .ASSUME SDSAR0-SDSDR0 EQ UISAR0-UISDR0 .ENDC ;NE SUP$Y 10$: MOV (R1),(R3) ;Save selected PAR MOV (R1)+,(R3)+ ;Save selected PDR SOB R4,10$ ;Do all 8 APRs 20$: RETURN .DSABL LSB .ENDC ;NE MMG$T .ENDC ;EQ SB .SBTTL .HRESET - Hard Reset EMT ;+ ; Stop any active I/O, then do a Soft Reset. ;- .ENABL LSB H$RSET: ENSYS HRSET1 ;Essentially soft reset when done IORSET::JSR R3,SAVE30 ;; Save regs 3-0 .IF NE MMG$T CALL KPSAVE ;; Map in PAR 1. .ENDC ;NE MMG$T CLR -(SP) ;; Count for unlinked queue elements .ADDR #<$ENTRY>,R2 ;; Point to handler entry table ;>>>$REL 10$: MOV (R2)+,R3 ;; Get handler address BEQ 10$ ;; Not resident CMP R3,#<-1> ;; End of table? BEQ 30$ ;; Yes MOV -(R2),R0 ;; Also point R0 at handler (note! Carry s TST (R3)+ ;; Advance to CQE pointer CALL IOQABT ;; Go abort the queue for this device BR 10$ ;; Try another device ............ 30$: .IF NE MTT$Y TST REVRT ;; Special revert loop? BNE 40$ ;; If NE yes CALL MTRSET ;; Detach any terminals .ENDC ;NE MTT$Y 40$: MOV CNTXT,R3 ;; Get impure pointer SUB (SP)+,I.IOCT(R3) ;; Adjust I/O count .IF NE MMG$T CALL KPREST ;; Restore PAR 1 mapping .ENDC ;NE MMG$T .IF NE TIME$R TST REVRT ;; Special revert loop? BNE SPLIT ;; If NE yes CMKALL::MOV #,R1 ;; Cancel all user Mark Times .IF EQ SB MOV JOBNUM,R2 ;; R2 = job number .ENDC ;EQ SB CLR R0 ;; Flag Cancel All CALLR CMARKT ;; ............ .ENDC ;NE TIME$R SPLIT: RETURN ;; Lets split his scene (back to REVERT) ............ .DSABL LSB .SBTTL IOQABT - Abort Handler I/O Queue ;+ ; Subroutine to abort the I/O queue associated with a specific handler ; and a specific job or channel. ; ; On entry: R2 -> Handler's $ENTRY entry. ; R0 -> LQE word in handler. ; R3 -> CQE word in handler. ; @SP must be initialized to an abort count of 0 OR 100000. ; If @SP = 100000, then called by .ABTIO with: ; 2(SP) = pointer to channel on which to abort I/O ; 4(SP) = tail of aborted queue element list (must be 0) ; 6(SP) = head of aborted queue element list (must be 0) ; ; Called with: CALL IOQABT ; ; Calls the handler at the abort entry point with: ; R4 = Job number of {aborted job | job issuing .ABTIO} ; R5 = 0 if abort by job ; R5 <> 0 if abort by channel (.ABTIO) ; value is address of CCB for channel for which ; I/O is to be aborted. ; ; On exit: @SP contains count of quiesce-type queue elements aborted ; in bits 0 to 14 (bit 15 remains unchanged) ; If bit 15 of @SP is set, then ; 2(SP) = pointer to channel on which I/O was aborted ; 4(SP) = tail of aborted queue element list ; 6(SP) = head of aborted queue element list ; ; ** Note ** ; While in this routine, stacked values mentioned above are one ; word deeper on stack due to return address. ; ;- .ENABL LSB IOQABT: SEC ;Set the carry for the rotate. ROR -(R0) ;Set the handler hold flag. BIT #,<$STAT-$ENTRY>(R2) ;Force abort entry?. BNE 10$ ;Yes, jump into entry code. .IF EQ SB JSR R1,60$ ;Get job number. Is it ours? .IFF ;EQ SB MOV @R3,R4 ;R4 -> next element. BEQ 80$ ;Done, go to next element. CMP -(R4),-(R4) ;Back up to link word. .ENDC ;EQ SB 10$: MOV -(R0),R1 ;Yes, R1 = offset to interrupt entry. ADD R0,R1 ;R1 -> interrupt entry. .IF EQ SB MOV JOBNUM,R4 ;Enter with R4 = job number. .IFF ;EQ SB CLR R4 ;Enter with R4 = job number. .ENDC ;EQ SB CLR R5 ;Assume abort by job TST 2(SP) ;Is it abort by channel (.ABTIO)? BPL 20$ ;Nope... Aborted elements not being kept MOV 4(SP),R5 ;Yes, pass handler pointer to CCB 20$: CALL -(R1) ;Call abort entry in handler. MOV @R3,R4 ;Restore R4 to point to element. BEQ 80$ ;Go on if no CQE exists. CMP -(R4),-(R4) ;Point to link word of first element. 30$: MOV R4,R3 ;R3 -> previous element. 40$: .IF EQ SB JSR R1,60$ ;Isolate job number. Is it ours?. .IFF ;EQ SB MOV @R3,R4 ;R4 -> next element. BEQ 80$ ;Done, go to next element. CMP -(R4),-(R4) ;Back up to link word. .ENDC ;EQ SB MOV @R4,@R3 ;Discard element (queue reset later). .IF NE MMG$T A2UBHK::BR 45$ ; UB hook. R4 -> Q.LINK field of QEL. .WORD REQUE2 ;Pointer to REQUE2 for UB ;(Also end of UB hooks) ;>>>$Rel .-2 REQUE2 RMON 45$: .ENDC ;NE MMG$T CALL ISNONQ ; "Quiesce" type handler? BNE 47$ ; Yes, count this QEL DEC 2(SP) ; No, test for aborted QELS being kept 47$: INC 2(SP) ;Bump the discard count. BPL 50$ ;Aborted elements not being kept MOV 10(SP),@R4 ;Link aborted element in front MOV R4,10(SP) ; of list of aborted elements TST 6(SP) ;Is this the first aborted element? BNE 50$ ;Branch if not MOV R4,6(SP) ; else, point tail pointer to it 50$: MOV 2(R4),R1 ;R1->Channel Control Block DECB C.DEVQ(R1) ;One less outstanding I/O BR 40$ ;Try again. ............ .IF EQ SB 60$: TST (SP)+ ;Throw away bad R1. MOV @R3,R4 ;R4 -> next element. BEQ 80$ ;Done, go to next element. CMP -(R4),-(R4) ;Back up to link word. MOVB Q.JNUM(R4),-(SP) ;Get job number. ASR @SP ;Isolate it. ASR @SP ASR @SP BIC #^c<16>,@SP CMP (SP)+,JOBNUM ;Is it ours? BNE 30$ ;If not, continue (enter) loop. TST 2(SP) ;Doing .ABTIO? BPL 70$ ;Branch if not CMP Q.CSW(R4),4(SP) ;Is queue element on this channel? BNE 30$ ;If not, continue (enter) loop. 70$: CALLR @R1 ;If so, process as head or otherwise. ............ .ENDC ;EQ SB 80$: MOV (R2)+,R1 ;R1 -> handler word 4 (LQE) TST -(R1) ;R1 -> handler word 3 (hold word) CALL UNHOLD ;Unhold handler & test completion BCS 110$ ;Branch if nothing completed MOV R1,R4 ;R4 -> handler CQE CALL COMPLT ;Complete top QEL .ADDR #,R0 ;R0 -> FORK queue. ;>>>$REL 90$: MOV R0,R1 ;R1 -> FORK queue current element. MOV @R1,R0 ;R0 -> next element. BEQ 110$ ;No next element, we're done. TST F.BADR(R0) ;Does this FORK element belong to ; the aborted handler? BNE 90$ ;No, check next element. SPL 7 ;Raise priority. MOV @R0,@R1 ;;; Link queue around element. BNE 100$ ;;; Not last element. MOV R1,FRKLQE ;;; Set new end of queue. 100$: SPL 0 ;;; Down again. BR 90$ ;Check next element. ............ .SBTTL ISNONQ - Check for non-quiescable handler ; Determine whether the handler whose offset from $ENTRY is in R2, ; is "quiescable". If not, Z is set (BEQ will branch). ISNONQ: MOV <$STAT-$ENTRY>(R2),-(SP) ; Push $STAT entry BR 105$ ;+ ; Check for non-quiescable handler - common code for QMANGR and COMPLT ; On entry, ; R3 contains channel status word address ; ; Return with EQ if handler is of non-quiescable type. ; R0 is squashed ;- CHKNOQ: .ASSUME C.CSW EQ 0 MOV @R3,R0 ;Get CSW, BIC #^c,R0 ;Isolate device offset .ADDR #<$STAT>,R0,ADD ;Point to STAT word ;>>>$REL MOV @R0,-(SP) ;Get $STAT entry 105$: BIC #^c,@SP ;Isolate bits CMP #,(SP)+ ;ABTIO$=0, HNDLR$=1 handler? 110$: RETURN ;Return to caller. ............ .DSABL LSB .SBTTL REVERT - Revert To Original Channels, QRESET & PURGE Handlers ;+ ; REVERT - Cancel Messages, Quiesce I/O, Revert Channels, etc. ; QRESET - Reset Suspension, Queue, Completion Queue, Purge Handlers ; ; State = User ; Context = User ; R5 -> job impure area (QRESET only) ; ; CALL REVERT or QRESET ; ; R0-R2 = random ; R3 -> job impure area ; R5 = random ; ; REVERT does the following (1-6): ; 1) Cancel any messages from this job to any other ; 2) Wait for all other I/O to stop ; 3) Reset channel area to standard 16. channels ; 4) Cancel outstanding MRKTS ; QRESET does ONLY the following: ; 5) Clear suspend counter, completion queue ; 6) Reset queue element queue to 1 standard element ; 7) Purge non-resident handlers (BG only) ;- .ENABL LSB REVRT2:: ;This is the entry for .CHAIN and .EXIT only BIT #,@R3 ;Are we .EXITing after an abort? BNE REVRT1 ;Branch if so -- we've already called IORSET BIT #,@#$JSW ;Are we processing a .CHAIN? BNE REVRT3 ;Branch if it's a .CHAIN to .ABTIO channels ;Fall through if it's a .EXIT REVERT:: ENSYS REVRT1 ;Enter system state for IORSET DEC (PC)+ ;Set flag for ABTIO$ loop REVRT:: .WORD 0 ; : Indicator word CALL IORSET ;Call any ABTIO handlers CLR REVRT ;Reset ABTIO flag RETURN ;+ ; Only .CHAIN processing uses REVRT3 code ;- REVRT3: MOV #<13*400>,R0 ;Set up .ABTIO #0 101$: EMT 374 ;Issue .ABTIO R0 INC R0 ;Increment channel CMPB R0,I.CNUM(R3) ;Any more channels exist BNE 101$ ;Branch if so REVRT1: CALL QUIESCE ;Wait for I/O to stop .ADDR #<$CSW>,R1 ;Point to BG'S channels ;>>>$REL .IF EQ SB TST JOBNUM ;Is this the BG? BEQ 20$ ;Yuppie MOV R3,R1 ;Nope, point to FG impure area ADD #,R1 ;Advance to channels .ENDC ;EQ SB 20$: MOV #,I.CNUM(R3) ;He now got only 16 channels MOV R1,I.CSW(R3) ;And they sittin' in the usual place .IF NE TIME$R CLR R5 ;Don't return un-expired time MOV R3,-(SP) ;Save R3 ENSYS 30$ ;Get into System State CALLR CMKALL ;; Cancel the liddle debbles ............ 30$: MOV (SP)+,R3 ;Restore R3 .ENDC ;NE TIME$R MOV R3,R5 ;QRESET wants impure pointer in R5 .BR QRESET ............ .DSABL LSB .ENABL LSB QRESET::CLR I.SCTR(R5) ;Reset suspension, too TST (R5)+ ;Advance to AVAIL header MOV R5,@R5 ;Reset to point to ADD #,@R5 ; the one element CLR @(R5)+ ;Whose link word we clear CLR (R5)+ ;Zap completion queue CLR (R5)+ .IF EQ SB TST JOBNUM ;If we are FG BNE 30$ ; we are done .ENDC ;EQ SB MOV R3,-(SP) .ADDR #<$ENTRY>,R3 ;Else PURGE non-resident handlers ;>>>$REL? MOV #<$SLOT>,R0 ;>>>$REL 10$: TST @R3 ;Is this handler in memory? BEQ 20$ ;Branch if not CMP @R3,SYSLOW ;Is this resident? BHIS 20$ ;Yes, leave it alone MOV #,R1 ;Indicate job abort MOV R0,-(SP) ;Save R0 (slot cntr) in case error in DRCALL CALL DRCALL ; ... and call the handler, if needed MOV (SP)+,R0 ;Restore R0 (slot counter) .IF NE MMG$T & XM$FET ;If .FETCH in XM MOV R3,R5 ;Set up for interrupt release. CALL INTRLS ;Release the handler. .IFF ;NE MMG$T & XM$FET CLR @R3 ;No interrupt fwding, simply remove. .ENDC ;NE MMG$T & XM$FET 20$: TST (R3)+ SOB R0,10$ ;Count down MOV (SP)+,R3 30$: .IF EQ MTT$Y ;+ ; HKPC06 (*** PRO300 HOOK ***) ; The BSTRAP installation of PI hooks this location as: ; ; CALL PIHK06 ; ; PIHK06 enables keyboard receiver interrupts for the PRO300 series ; processor's keyboard. ;- HKPC06:: ;(*** PRO300 HOOK ***) .IF NE VENU$C MOVB @TTKCR,-(SP) ;Read command register data BISB #,@SP ;Set Receive Enable and Error Reset bits MOVB (SP)+,@TTPCR ;Write data to command register .IFF ;NE VENU$C BIS #,@TTKS ;Make sure TTY is runnin' (NON-MTT only) .ASSUME .-HKPC06 EQ 6 .ENDC ;NE VENU$C .ENDC ;EQ MTT$Y RETURN ;Go back to caller ............ .DSABL LSB .SBTTL $CRTNE - Dequeue A Completion Routine; Exit From Completion Rtn ;+ ; "So she went into the garden to cut a cabbage leaf to make an apple ; pie; and, at the same time, a great she-bear coming up the street ; pops its head into the shop - "What! No soap!" so he died, ; and she very imprudently married the barber." ; - Samuel Foote ; ; The following code exits from a user's completion routine ; and enters another one, if pending. ; If nothing is pending, we return to main code ourselves ; ; We set up the default PAR1 mapping because .SYNCH elements can exist ; in default PAR1. We restore the PAR1 mapping when we are done with ; completion routines and are ready to go back to the main-line. ; .ENABL LSB .IF NE SPC$PS .IF EQ MMG$T SPC.OF=4. ;FB has no additional words on stack .IFF ;EQ MMG$T .IF EQ MQH$P2 SPC.OF=6. ;XM without MQ PAR2 has saved PAR1 value on stack .IFF ;EQ MQH$P2 SPC.OF=8. ;XM with MQ PAR2 has saved PAR1 & PAR2 values on stack .ENDC ;EQ MQH$P2 .ENDC ;EQ MMG$T SPS.OF = SPC.OF+2. .ENDC ;NE SPC$PS .ENABL LSB $CRTNE::MOV R1,-(SP) ;User comes here to start completion MOV R0,-(SP) ;Save regs .IF NE MMG$T CALL KPSAVE ;Save current mapping, get default .ENDC ;NE MMG$T $CRTR2:: 10$: MOV CNTXT,R1 ;Point to our impure area ADD #,R1 ;Point to stuff to restore MOV @R1,@#$ERRBY ;Restore error word MOV -(R1),-(R1) ;Restore channel wait SPL 7 ;Lock out others MOV -(R1),R0 ;;; Get a completion routine BNE 30$ ;;; Got another to run ;+ ; Done running completion routines for this job. Go back to main line ;- BIC #,I.STAT-I.CMPL(R1) ;;; Turn off flags .IF NE SPC$PS MOV I.SPCP-I.CMPL(R1),R0 ;;; Get .SPCPS area address BEQ 20$ ;;; None, easy BANE ==: .+4 ;begone when $Rel done!! CMP SPC.OF(SP),#$RMON ;;; Are we running in the RMON? ;>>>$Rel .-2 $RMON RMON BHIS 20$ ;;; Yes, defer until end of EMT TST I.ECTR-I.CMPL(R1) ;;; Maybe, is the EMT depth non-zero? BNE 20$ ;;; Yes, defer until end of EMT .IF NE MMG$T MOV I.SPC1-I.CMPL(R1),@#KISAR1 ;;; Map to user block .ENDC ;NE MMG$T MOV SPS.OF(SP),@R0 ;;; Save main-line PS MOV SPC.OF(SP),-(R0) ;;; and PC MOV -(R0),SPC.OF(SP) ;;; Reroute main-line PS CLR I.SPCP-I.CMPL(R1) ;;; Indicate done 20$: .ENDC ;NE SPC$PS .IF NE MMG$T CALL KPREST ;;; Restore mapping .ENDC ;NE MMG$T MOV (SP)+,R0 ;;; .BR CRRHOK ............ ;+ ; CRRHOK (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; CALLR $CRTI ; ; The $CRTI routine is located in the RTEM-11 linkage ; routines. This hook allows RTEM-11 to correctly ; exit a completion routine. ;- CRRHOK:: ;;;(*** RTEM-11 HOOK ***) MOV (SP)+,R1 ;;; Restore regs RTI ;;; Back to user's main routine ............ ;+ ; Remove next completion queue element from queue ;- 30$: MOV @R0,@R1 ;;; Link compl forward CMP -(R1),R0 ;;; End of queue? BNE 40$ ;;; No CLR @R1 ;;; Yep, clear LQE 40$: SPL 0 ;;; Don't spend too much time at 7 .IF NE MMG$T CLR -(SP) ;Kernel: returns to 0; user: fake PS holder CLR -(SP) ;Kernel: fake PS of 0; user: return address 0 BIC #,@#PS ;Assume kernel was previous mode .ENDC ;NE MMG$T ADD #,R0 ;Point to word count CMP (R0)+,#<-3> ;Is this a .TWAIT or .SYNCH element? BHIS 60$ ;Branch if yes -- kernel call if XM .IF NE MMG$T BIS #,@#PS ;Assume user mode dispatch .IF NE SUP$Y MOV #,2(SP) ;Make fake PS on stack go to user mode .ENDC ;NE SUP$Y ROR @R0 ;Get supy/user bit .IF NE SUP$Y BCC 444$ ;Branch if user mode BIC #,@#PS ;Supy mode dispatch BIC #<&120000>,2(SP) ;Make fake PS go to supy mode 444$: .ENDC ;NE SUP$Y ASL @R0 ;Make completion routine good and even GET SP,R1 ;Get user/supy stack pointer into R1 SUB #<2>,R1 ;Make room for user/supy return address PUT R1,SP ;Restore new stack with return address on it PUT (SP)+,@R1 ;User/supy return is to virtual 0 .IF EQ SUP$Y MOV #,@SP ;Make fake PS on stack go to user mode .ENDC ;EQ SUP$Y .ENDC ;NE MMG$T 60$: MOV @R0,-(SP) ;Save place to call CLR -(SP) ;Clear channel number MOV -(R0),R1 ;Get org channel offset (.TWAIT/.SYNCH flag) BLE 90$ ;If .TWAIT or .SYNCH, use 0 80$: INC @SP ;Accumulate channel number by repeated sub ; of channel size SUB #,@R0 ;Cheapo divide by 10. (= channel size) BGT 80$ 90$: MOV -(R0),-(SP) ;@SP = CSW or ID number ;+ ; Don't put SYNCH or system elements back into AVAIL queue ;- CLR Q.COMP-Q.BUFF(R0) ;This node is now free INC R1 ;Is this a .SYNCH element? BEQ 100$ ;Yes, don't return queue element ADD #,R0 ;R0 -> link field in queue element again MOV CNTXT,R1 ;Point to our impure area TST (R1)+ ;Point to avail queue SPL 7 ;Link into avail at priority 7 MOV @R1,@R0 ;;; Put avail pointer into element MOV R0,@R1 ;;; Point avail to this element SPL 0 ;;; Safe to come down now 100$: MOV (SP)+,R0 ;R0 = CSW or ID number MOV (SP)+,R1 ;R1 = channel number or 0 .IF EQ MMG$T CALL @(SP)+ ;Call the completion routine BR 10$ ; and look for more .IFF ;EQ MMG$T RTI ;Call the completion routine .ENDC ;EQ MMG$T .DSABL LSB .SBTTL $SYSWT - Block A Task ;+ ; "There's a long, long night of waiting ; Until my dreams all come true." ; - Stoddard King, "There's a Long, Long Trail" ; "Now the serpent was more subtil than any beast of the field" ; - Genesis 3:1 ; ; The following routine is used in the monitor EMT processor when ; a user has to wait for a specific condition. It sets the blocking ; bit for the condition, and switches the user out. ; When the user is again runnable, this routine is entered again ; and it determines whether the condition still warrants blocking ; (spurious unblocking can be caused by completion routines). ; If runnable, it returns to the caller (somewhere in the monitor). ; If not, it re-enables the blocking bit and goes away again. ; The calling sequence is: ; ; JSR R4,$SYSWT ; .WORD blockbit ; Routine to determine whether routine should stay blocked: ; Routine must Set Carry if BLOCKED, Clear Carry if RUNNABLE ; It may assume that it has registers R0-R3 unchanged ; CALL @(SP)+ ;Call to return condition to $SYSWT ; Return here in User State when finally UNBLOCKED ; ; Modified to remove SPL 7/SPL 0 around blocking test ;- .ENABL LSB $SYSWT::CALL 2(R4) ;Still blocked? (call in User mode) BCS 10$ ;Yes MOV (SP)+,R4 ;No! Get return address RTS R4 ;And return to unblocked code ............ 10$: TST (SP)+ ;Purge return address ENSYS $SYSWT .IF EQ SB MOV CNTXT,R5 ;; R5 -> impure area BIS (R4)+,I.BLOK(R5) ;; Turn on blocking bit .IFF ;EQ SB BIS (R4)+,I.BLOK+BKGND ;; Turn on blocking bit .ENDC ;EQ SB CALL @R4 ;; Now, see if he was unblocked a moment ago INC (SP)+ ;; We never want to return now! BCS SWAPME ;; If he was unblocked before that BIS .IF EQ SB BIC -(R4),I.BLOK(R5) ;; unblock him again .IFF ;EQ SB BIC -(R4),I.BLOK+BKGND ;; unblock him again .ENDC ;EQ SB RETINS::RETURN ;; And return from fake interrupt without ... ............ ;; ... requesting a task switch .DSABL LSB .SBTTL $RQTSW - Request Task Switch, Unblock A Task ;+ ; "If it be now, 'tis not to come; if it be not to come, it will ; be now; if it be not now, yet it will come; the readiness is all." ; - Shakespeare, "Hamlet" ;- .ENABL LSB .IF EQ SB ;+ ; DLYUSR - Block a task to wait for the USR ; ; State = System ; Context = Job ; ; CALL DLYUSR ; ; R5 = job number ; ; Note: Task gets unblocked when USR is free, and runs ENQUSR ;- DLYUSR::MOV CNTXT,R5 ;; R5 -> impure area BIS #,I.BLOK(R5) ;; Delay for USR. Set block bit .BR SWAPME ;; ............ .ENDC ;EQ SB ;+ ; SWAPME - Request job runnability scan starting with current job ; ; State = System ; Context = Job ; ; CALL SWAPME ; ; R5 = job number ; ; Note: SWAPME is used when there is a change in the runnability ; of the current job, either now runnable or now not runnable ;- SWAPME:: .IF EQ SB MOV CNTXT,R5 ;; Get current job number MOV I.JNUM(R5),R5 ;; .IFF ;EQ SB CLR R5 ;; Only background: job number 0 .ENDC ;EQ SB .BR $RQTSW ;; ............ ;+ ; $RQTSW - Request job runnability scan for selected job ; ; R5 = job number ; State = System ; Context = Job ; ; CALL $RQTSW ; ; Note: $RQTSW is used when there is a change in the runnability ; of the selected job, either now runnable or now not runnable ;- $RQTSW:: .IF EQ SB CMP R5,JOBNUM ;; Want lower priority than current job? BLO 20$ ;; Yes, that's pointless .ENDC ;EQ SB .BR $RQSIG ;; ............ ;+ ; $RQSIG - Request job runnability scan without blocking job ; ; R5 = job number - 2 of current job ; State = System ; Context = Job ; ; CALL $RQSIG ; ; Note: $RQSIG is used when the current job is runnable but wishes to ; give up control until the next significant event for it. ; E.G. when it is waiting for a free queue element ;- ;+ ; $RQSIG (*** RTEM-11 HOOK ***) ; The RTEM-11 bootstrap hooks this location as: ; ; CALLR $RQSG ; ; The $RQSG routine is located in the RTEM-11 linkage ; routines. This hook allows RTEM-11 to correctly ; handle job runnability, by terminating the RTEM-11 ; idle loop. ;- $RQSIG:: ;(*** RTEM-11 HOOK ***) SEC ;; Turn on strange bit ... RORB R5 ;; ... in INTACT .IF EQ SB GETPSW ;; Save Prio to come down to SPL 7 ;; Compare and set must be together CMPB R5,INTACT ;;; Higher than latest request? BLOS 10$ ;;; No .ENDC ;EQ SB $RQSG1::MOVB R5,INTACT ;;; Yes, set it .IF EQ SB 10$: PUTPSW ;;; Down to proper level .ENDC ;EQ SB ASLB R5 ;; Fix R5 20$: RETURN ;; ............ .DSABL LSB ;+ ; UNBLOK - Unblock a job from a condition and schedule if necessary ; ; R5 -> job impure area ; State = System ; ; JSR R4,UNBLOK ; .WORD blockbit ;- .ENABL LSB UNBLOK::BIT (R4)+,I.BLOK(R5) ;; Is blocking bit on? BEQ 10$ ;; No, nothing to do, not blocked for this BIC -2(R4),I.BLOK(R5) ;; Yes, unblock the task MOV R5,-(SP) ;; Save impure pointer .IF EQ SB MOV I.JNUM(R5),R5 ;; Get job number CALL $RQTSW ;; Time for a change .IFF ;EQ SB CALL SWAPME ;; (== CLR R5 ;Job number=0; CALL $RQTSW) .ENDC ;EQ SB MOV (SP)+,R5 ;; Repoint to impure area 10$: RTS R4 ;; Back to him ............ .DSABL LSB .SBTTL UCASE - Uppercasing routine ;+ ; UCASE Uppercasing routine ; ; R0 Char to uppercase ; CALL UCASE ; R0 Char in UPPERCASE (if alphabetic) ;- .ENABL LSB UCASE:: CMPB R0,#<'a> ;Lower case? BLT 1$ ;No CMPB R0,#<'z> ;Maybe? BGT 1$ ;Not lower case BICB #<40>,R0 ;Do conversion to upper case 1$: RETURN .DSABL LSB .SBTTL RMSTAK - System Stack .PSECT STACK$ ;+ ; System Stack Pointer Space Allocation ;- ;+ ; KMON Transitional Stack ; ; Used by EXIT when transferring to KMON and by RDOVLY and ; ENTRPG when KMON starts a background program ;- .REPT 50. + + .WORD 152525 ;Transitional Stack Empty Pattern .ENDR SPTR:: ;+ ; RMON Stack ;- .REPT STAC$K + <50.*MMG$T> + <40.*MTT$Y> + <36.*ERL$G> .WORD 52525 ;Stack Empty Pattern .ENDR RMSTAK:: ;+ ; Patch Space For Resident Monitor ;- .PSECT PATCH$ .BLKW PATC$H ;Guarantee minimum space for patches. $RMEND:: ;Effective end of RMON for boot calculations. ;+ ; Now comes the KMON Overlays ;- .PSECT OVLY0 $RTEND:: ;KMON overlays start here (defined in EDTGBL). .END