Consolidate license copies

[its.git] / system / its.1622

;-*-MIDAS-*-
;;; Copyright (c) 1999 Massachusetts Institute of Technology
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.


.SYMTAB 12003.,5500.
TITLE ITS

SUBTTL DEFINITIONS

.NSTGWD         .SEE PATB       ;NO STORAGE WORDS ALLOWED UNTIL PATB

IF1 [ PRINTX \MACHINE NAME = \
;WELL-KNOWN MACHINE NAMES ARE:
;       AIKA    AI LAB KA10 (R.I.P.)
;       MLKA    MATHLAB KA10 (R.I.P.)
;       DM      DYNAMIC MODELING KA10 (R.I.P.)
;       MC      Mail Computer KS10
;       AI      AI Lab KS10
;       MX      The ex-MC KL10
;       ML      Math Lab KS10
;       MD      Mostly Development KS10
;       SI      Stacken ITS KS10
;       FU      Australian KS10
;       PM      PandaMonium KS10
;THE FILE "CONFIG" HAS ASSEMBLY SWITCHES AS A FUNCTION OF MACHINE.

.TTYMAC A
IFN ASCII/A/&ASCII/     /,.FATAL USE UPPER CASE!
DEFINE MCOND X          ;0 IFF THIS IS MACHINE X.
<IFSN X,A,[1]>,TERMIN
DEFINE MNAME X          ;USED TO SUBSTITUTE IN THIS MACHINE'S NAME.
X!!A!!TERMIN
FOO==.TTYFLG            ;MAKE ERR FILE LOOK NICE
.TTYFLG==1
PRINTX/A
/
.TTYFLG==FOO
TERMIN  ];IF1

IFNDEF PCLSW,PCLSW==1           ;1 => ASSEMBLE PCLSR TEST FEATURE
IFNDEF TT11BY,TT11BY==8         ;PDP11-TV OUTPUT BUFFER BYTE SIZE.
.MLLIT==1                       ;MULTI-LINE LITERAL MODE
ASTIME==.OP .OPER+@,0,.RTIME    ;GET ASSEMBLY TIME AND DATE IN SIXBIT.
ASDATE==.OP .OPER+@,0,.RDATE    ;RH OF INSN MUST BE 0, SO MIDAS WILL PUT IN PROPER AC FLD.

;AC DEFS

A=1
B=2
C=3
D=4
E=5
TT=6
I=7
Q=10
J=11
R=12
W=13
H=14
P=15    ;DO NOT CHANGE! ;PDL POINTER
T=16    ;"
U=17    ;"              ;USER INDEX

.XCREF A,B,C,D,E,TT,I,Q,J,R,W,H,P,T,U

IF1 EXPUNGE APR,OCT,DEC ;FOR NEW CALENDAR HACK

NULBLK==4       ;NUMBER OF LOCKED SWITCH BLKS IN USR VARIABLES
                ;USES 2 WDS OF USER VAR PER

NPVSEC==30.     ;NUMBER OF SECONDS A USER IS ALLOWED TO BE IN THE PRIVILEDGED SWAPPING CLASS
IF2 LIOBLK==<USRSTG+LUBLK*MAXJ+1777>_-10.  ;LOWEST BLOCK NEVER TO BE SHUFFLED
                        ;ALSO MAX # OF BLOCKS SYS JOB MAY HAVE
IF2 MAXJ==<LIOBLK_10.-USRSTG>/LUBLK     ;ROUND UP TO ACTUAL MAX #JOBS

DIRMAP==1       ;ENABLE DIRECT MAPPING OF HIGH HALF
                ;I DON'T THINK IT WORKS TO TURN THIS OFF.
NIOCHN==20      ;NUMBER OF I/O CHANNELS PER USER
\f
DEFINE $INSRT $%$%$%    ;PRINTX MESSAGE WHEN FILE GETS INSERTED
        .INSRT $%$%$% >
        PRINTX \    ==> INSERTED:  \
        .TYO6 .IFNM1
        .TYO 40
        .TYO6 .IFNM2
PRINTX \
\
TERMIN

;;; CONFIG uses this macro...
DEFINE CONC A,B
A!B!TERMIN

$INSRT CONFIG           ;CONFIGURATION SWITCHES FOR ALL KNOWN MACHINES

$INSRT BITS             ;DEFINITIONS OF MANY BIT NAMES

;IN BADBTS => CLASS 2 OR 1 INTERRUPT   ;IN VBDBTS=> CLASS 1 INTERRUPT
VBDBTS==%PIB42\%PIVAL\%PIBRK\%PIC.Z\%PI1PR\%PITRP\%PIDCL
BADBTS==VBDBTS\%PIMPV\%PIIOC\%PIILO\%PIMAR\%PIDIS\%PIOOB\%PILOS\%PIFET\%PIWRO\%PIPAR\%PITTY\%PIPDL\%PINXI

UUOMIN==40000,, ;SMALLEST NUM THAT COULD BE A SYSTEM CALL
UUOMAX==50000,, ;ONE GREATER THAN LARGEST NUM "
UIOT=UUOMAX     ;USE FOR USER I/O INST TRAP

        ;MAX DYN ALLOC ALLOC IO BUFFERS
MXIOB==100      ;MAX POSSIBLE

SIOMT==50       ;MAX SIZE TRANSLATION TABLE

LUPDL==50       ;LENGTH USER PDL MUST BE >= 40 FOR 2311 GC
LUIOP==20       ;LENGTH OF USER IO PDL
CPDLL==40       ;LENGTH CLOCK CHANNEL PDL
LUTCP==40       ;LENGTH UTC PDL (NETWORKS AND DISKS)
LSYSP==100      ;SYSTEM JOB PDL
LTTYP==40       ;LENGTH OF TTY (INTERRUPT LEVEL) PDL

DMNSZ==20       ;# ENTRIES IN DEMON BUFFER (DMNBF)

MXCZS==5        ;MAX NUMBER ^Z'S PER CLOCK BREAK

SCLKI==30.      ;60'THS PER SLOW CLOCK
VSCLKI==2*60.*60.       ;60'THS PER VERY SLOW CLOCK TICK
MXOPT==8.       ;SLOW CLOCK  MAX UT OP CAN TAKE
NINFP==8.       .SEE UFIN       ;MAX # OF DIRECT INFERIORS A PROCEDURE MAY HAVE

SSCHDB==100     ;LENGTH OF SCHEDULER HISTORY BUFFER

SPD==60.*60.*24.        ;# SECS IN A DAY (FITS IN A HALFWORD)
        PDUPS==60.      ;# PDCLK INCREMENTS/SEC

OPNCOM==410300  ;COMMAND FIELD IN LH OF FIRST OPEN WORD

IFN 340P,N340PB==10.    ;# EXEC PGS USED FOR 340 DATA MUST BE EVEN
IFN N11TYS,[
        NTTPG==6        ;# EXEC PGS FOR PDP11 TV TTYS.
        NTVBP==11       ;THESE PAGES ADDRESS THE WHOLE VIDEO BUFFER MEMORY ADDRESS
                        ;SPACE OF THE TV 11.  THE LAST OF THESE ADDRESSES THE
                        ;TV CONSOLE REGISTER
]
NUVPG==256.             ;NUMBER OF VIRTUAL PAGES PER USER.  SIZE OF PAGE TABLE VARS.
                        ;DON'T TRY TO CHANGE THIS.
;CIRCULAR PAGE LINK FORM
;2.9=0
;1.1-1.8 PAGE #
;2.8-1.9 USER #
;2.9=1
;2.8=0 2.7-1.1 LINK TO MMP TABLE
;2.8=1 2.7-1.1 LINK TO MEM PNT TABLE
;EXCEPT 2.9-1.1=777777 => ABSOLUTE PAGE, NOT LINKED
\f
SUBTTL GOBBLE TTYTYP FILE

IFN XGP\N11TYS,[IFE TEN11P,[
        .ERR XGP OR N11TYS WITHOUT TEN11P
        N11TYS==0
        XGP==0
]
]
IFNDEF UNSPLP,UNSPLP==<TTLPTP+OLPTP+NLPTP>*DEMON*<1-TPLP>
        ;1 IF THE "UNSPOO" PROGRAM DOES LPT SPOOLING.

IFNDEF TSYSM,[
MNAME PRINTX \NO PARAMS KNOWN FOR , MACHINE.
\
.INSRT TTY:
]

IF2,[
;TTY LINES DEFINITIONS

;MACRO WHICH RETURNS THE %TY BIT FOR THE CONTROLLER ACCORDING TO THE LINE NUMBER

DEFINE CNTRLR <N>
IRPS F,,[0      NFKSTY  NFETY   NFNTY   NFNVTY  NFDZTY  NFDPTY  NFMTY   NFDLTY  NFSTTY  NF11TY
   ]NT,,[NOTYS  NKSTYS  NETYS   NNTYS   NNVTTS  NDZTYS  NDPTYS  NMTYS   NDLTYS  NSTTYS  N11TYS
   ]FG,,[%TYOTY %TYKST  %TYETY  %TYNTY  %TYNVA  %TYDZT  %TYDPK  %TYMTY  %TYDL   %TYSTY  %TY11T]
 IFGE <N>-F,[IFL <N>-<F+NT>,[FG]]TERMIN TERMIN

;MACRO WHICH RETURNS $TTISP, $TTOSP BITS GIVEN BAUD RATES

DEFINE SPEEDC <IBAUD,OBAUD>
<IFB IBAUD,[SPEED1 OBAUD]IFNB IBAUD,[SPEED1 IBAUD]>*%TTISP+<SPEED1 OBAUD>*%TTOSP!TERMIN

DEFINE SPEED1 <BAUD>
IRPS BD,,[0   600 110 150 300 1200 1800 2400 4800 9600 25K 40K 50K 80K
    ]CD,,[0   1   2   3   4   5    6    7    10   11   12  13  14  15  ]
IFSE BAUD,BD,[CD] TERMIN TERMIN

;KEYWORD PARAMETERS TO TTY DEFINITION MACROS
; FOR OVER-RIDING DEFAULTS
;SPEED  NUMBER OF BAUDS OUTPUT
;ISPEED NUMBER OF BAUDS INPUT IF DIFFERENT
;TT     LH(TTTYP)       IN ADDITION TO SPEED CODE
;TY     RH(TTYTYP)      IN ADDITION TO CONTROLLER BIT
;TO     LH(TTYOPT)      IN ADDITION TO USUAL CODES FOR TERMINAL TYPE
;TP     RH(TTYOPT)      IN ADDITION TO PAD CODES
;TCT    TCTYP
;HOR    SCREEN WIDTH
;VER    SCREEN HEIGHT
;ROL    LINES PER GLITCH WHEN SCROLLING

;DEFINE TTY AS PRINTING.
;IF SPEED IS 110, ASSUME TTY IS TELETYPE,
;MEANING CAN'T BS, STANDARDIZE ALTMODES.
;IF KA10 CONSOLE TTY OR TK10 TTY, NEED PARITY
DEFINE TTDPRT N,+SPEED=300,ISPEED=,TT=0,TY=0,TO=0,TP=%TPORS,TCT=%TNPRT,SMARTS=0
T!N!$SMT==SMARTS,,
T!N!$HOR==80.-IFE 110-SPEED,8
T!N!$VER==MOVE
T!N!$OPT==TO+%TOOVR+%TOALT+IFN 110-SPEED,[%TOMVB+%TOLWR-%TOALT],,<1+IFE 300-SPEED,[IFE TY&<%TYDIL\%TYRLM>,[3]]>*%TPPCR+TP
T!N!$TYP==TT+<SPEEDC ISPEED,SPEED>\<IFE N,[IFN NOTYS,[%TTPAR]]>\<IFGE N-NFNTY,[IFL N-<NFNTY+NNTYS>,[%TTPAR]]>,,TY+<CNTRLR N>
T!N!$TCT==TCT
T!N!$ROL==1
TERMIN

;DEFINE TTY AS MEMOREX
DEFINE TTDMRX N,+SPEED=600,ISPEED=,TT=0,TY=0,TO=0,TP=%TPORS,HOR=120.,SMARTS=0
T!N!$SMT==SMARTS,,
T!N!$HOR==HOR
T!N!$VER==MOVE
T!N!$OPT==TO+%TOOVR+%TOMVB+%TOLWR,,4*%TPPLF+6*%TPPCR+TP
T!N!$TYP==TT+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$TCT==%TNMEM
T!N!$ROL==1
TERMIN

;DEFINE TTY AS TERMINET.
DEFINE TTDTRM N,+SPEED=1200,ISPEED=,TT=0,TY=0,TO=0,TP=%TPORS,HOR=120.,SMARTS=0
T!N!$SMT==SMARTS,,
T!N!$HOR==HOR
T!N!$VER==MOVE
T!N!$OPT==TO+%TOOVR+%TOMVB+%TOLWR,,5*%TPPLF+TP
T!N!$TYP==TT+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$TCT==%TNTRM
T!N!$ROL==1
TERMIN

;DEFINE TTY AS A LPT.
DEFINE TTDLPT N,+SPEED=9600,ISPEED=,TT=0,TY=0,TO=0,TP=0,HOR=200.,TCT=%TNPRT,SMARTS=0
T!N!$SMT==SMARTS,,
T!N!$HOR==HOR
T!N!$VER==MOVE
T!N!$OPT==TO+%TOMVB+%TOOVR,,TP
T!N!$TYP==%TTDDI+TT+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$TCT==TCT
T!N!$ROL==1
TERMIN

;DEFINE TTY AS AN LA36 DECWRITER.
DEFINE TTDLA36 N,+SPEED=300,ISPEED=,TT=0,TY=0,TO=0,TP=%TPORS,HOR=132.,TCT=%TNPRT,SMARTS=0
T!N!$SMT==SMARTS,,
T!N!$HOR==HOR
T!N!$VER==MOVE
T!N!$OPT==TO+%TOMVB+%TOOVR+%TOLWR,,TP
T!N!$TYP==TT+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$TCT==TCT
T!N!$ROL==1
TERMIN

;DEFINE TTY AS IMLAC. (RUNNING SOFTWARE-TTY PROGRAM)
DEFINE TTDIML N,+SPEED=50K,ISPEED=25K,TT=0,TY=0,TO=0,TP=0,HOR=90.,VER=44.,TCT=%TNSFW,ROL=10.,SMARTS=%TQIM1
T!N!$SMT==SMARTS,,
T!N!$HOR==HOR
T!N!$VER==VER
T!N!$OPT==TO+%TOOVR+%TOLWR+%TOMVB+%TOMVU+%TOERS+%TOLID+%TOCID,,TP
T!N!$TYP==%TTDDI+TT+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$TCT==TCT
T!N!$ROL==ROL
TERMIN

;DEFINE TTY AS VT52
DEFINE TTDVT N,+SPEED=9600,ISPEED=,TT=0,TY=0,TO=0,TP=%TPORS,HOR=80.,VER=24.,TCT=%TNESC,ROL=1,SMARTS=0
T!N!$SMT==SMARTS,,
T!N!$HOR==HOR
T!N!$VER==VER
T!N!$OPT==TO+%TOMVU+%TOMVB+%TOLWR+%TOERS,,TP+%TPPTB*<IFE SPEED-9600,[1] .ELSE [3]>
                                                ;DIRECT POSITIONING LOSES AT 9600
T!N!$TYP==TT+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$TCT==TCT
T!N!$ROL==ROL
TERMIN

;DEFINE TTY AS H19
DEFINE TTDH19 N,+SPEED=9600,ISPEED=,TT=0,TY=0,TO=0,TP=%TPORS,HOR=80.,VER=24.,TCT=%TNH19,ROL=1,SMARTS=0
T!N!$SMT==SMARTS,,
T!N!$HOR==HOR
T!N!$VER==VER
T!N!$OPT==TO+%TOMVU+%TOMVB+%TOLWR+%TOERS+%TOLID+%TOCID,,TP+%TPPTB*3
T!N!$TYP==TT+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$TCT==TCT
T!N!$ROL==ROL
TERMIN

;DEFINE TTY AS AAA
DEFINE TTDAAA N,+SPEED=9600,ISPEED=,TT=0,TY=0,TO=0,TP=%TPORS+%TPMTA,HOR=80.,VER=48.,TCT=%TNAAA,ROL=1,SMARTS=0
T!N!$SMT==SMARTS,,
T!N!$HOR==HOR
T!N!$VER==VER
T!N!$OPT==TO+%TOMVU+%TOMVB+%TOLWR+%TOERS+%TOLID+%TOCID,,TP+%TPPTB*2
T!N!$TYP==TT+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$TCT==TCT
T!N!$ROL==ROL
TERMIN

;DEFINE TTY AS C100
DEFINE TTDC100 N,+SPEED=9600,ISPEED=,TT=0,TY=0,TO=0,TP=%TPORS,HOR=79.,VER=24.,TCT=%TNHDS,ROL=1,SMARTS=0
T!N!$SMT==SMARTS,,
T!N!$HOR==HOR
T!N!$VER==VER
T!N!$OPT==TO+%TOMVU+%TOMVB+%TOLWR+%TOERS+%TOLID+%TOCID,,TP+%TPPTB*3+<IFG SPEED-1200,%TPPCR>
T!N!$TYP==TT+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$TCT==TCT
T!N!$ROL==ROL
TERMIN

;DEFINE TTY AS TEKTRONIX.
DEFINE TTDTEK N,+SPEED=1200,ISPEED=,TT=0,TY=0,TO=0,TP=%TPORS,TCT=%TNTEK,HOR=73.,VER=35.,SMARTS=0
T!N!$SMT==SMARTS,,
T!N!$HOR==HOR
T!N!$VER==VER
T!N!$OPT==TO+%TOMVU+%TOOVR+%TOMVB+%TOLWR+%TOMOR,,TP
T!N!$TYP==TT+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$TCT==TCT
T!N!$ROL==0
TERMIN

;DEFINE TTY AS A LOSING DATAPOINT
DEFINE TTDLSR N,+SPEED=2400,ISPEED=,TT=0,TY=0,TO=0,TP=%TPORS,SMARTS=0
T!N!$SMT==SMARTS,,
T!N!$TCT==%TNODP
T!N!$HOR==71.-IFN MCOND AIKA,1  ;OTHER DATAPOINTS HAVE SHORTER SCREENS.
T!N!$VER==25.
T!N!$OPT==TO+%TOMVB+%TOMVU+%TOERS,,4*%TPPCR+TP
T!N!$TYP==TT+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$ROL==1
TERMIN

;DEFINE TTY AS DATAPOINT.
DEFINE TTDDPT N,+SPEED=2400,ISPEED=,TT=0,TY=0,TO=0,TP=%TPORS,HOR=[72.-IFN MCOND AIKA,[1]],SMARTS=0
T!N!$SMT==SMARTS,,
T!N!$TCT==%TNDP
T!N!$HOR==HOR           ;OTHER DATAPOINTS HAVE SHORTER SCREENS.
T!N!$VER==25.
T!N!$OPT==TO+%TOMVB+%TOMVU+%TOERS,,4*%TPPCR+TP
T!N!$TYP==TT+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$ROL==1
TERMIN

;DEFINE TTY AS A TELERAY 1061
DEFINE TTDRAY N,+SPEED=9600,ISPEED=,TT=0,TY=0,TO=0,TP=%TPORS,HOR=80.,SMARTS=0
T!N!$SMT==SMARTS,,
T!N!$TCT==%TNRAY
T!N!$HOR==HOR
T!N!$VER==24.
T!N!$OPT==TO+%TOMVU+%TOMVB+%TOERS+%TOLWR+%TOLID+%TOCID,,3*%TPPTB+TP
T!N!$TYP==TT+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$ROL==1
TERMIN

;DEFINE A TTY THAT IS A GT40.
DEFINE TTDGT40 N,+SPEED=4800,ISPEED=,TT=0,TY=0,TO=0,TP=%TPORS,TCT=%TNDP,HOR=72.,VER=32.,ROL=1,SMARTS=0
T!N!$SMT==SMARTS,,
T!N!$HOR==HOR
T!N!$VER==VER
T!N!$OPT==TO+%TOMVB+%TOERS+%TOMVU+%TOOVR+%TOLWR,,TP
T!N!$TYP==TT+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$TCT==TCT
T!N!$ROL==ROL
TERMIN

;DEFINE A TTY THAT IS A LINE TO A PDP11.
DEFINE TTD11 N,+SPEED=4800,ISPEED=,TT=0,TY=0,TO=0,TP=0,TCT=%TNPRT,HOR=72.,VER=MOVE,ROL=1,SMARTS=0
T!N!$SMT==SMARTS,,
T!N!$HOR==HOR
T!N!$VER==VER
T!N!$OPT==TO+%TOMVB+%TOOVR+%TOALT,,TP
T!N!$TYP==TT+%TTDDI+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$TCT==TCT
T!N!$ROL==ROL
TERMIN

;DEFINE A TTY THAT IS RANDOM.
DEFINE TTDRAN N,+SPEED=FOO.,ISPEED=,TT=0,TY=0,TO=FOO.,TP=FOO.,TCT=FOO.,HOR=FOO.,VER=FOO.,ROL=FOO.,SMARTS=0
T!N!$SMT==SMARTS,,
T!N!$HOR==HOR
T!N!$VER==VER
T!N!$OPT==TO,,TP
T!N!$TYP==TT+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$TCT==TCT
T!N!$ROL==ROL
TERMIN

;DATAMEDIA
DEFINE TTDDTM N,+SPEED=4800,ISPEED=,TT=0,TY=0,TO=0,TP=%TPORS+3*%TPPCR,HOR=80.,VER=24.
T!N!$SMT==0
T!N!$HOR==HOR
T!N!$VER==VER
T!N!$OPT==TO+%TOMVB+%TOERS+%TOMVU+%TOLWR+%TOLID+%TOCID,,TP
T!N!$TYP==TT+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$TCT==%TNDTM
T!N!$ROL==1
TERMIN

;DEFINE A PDP11 TV COMMUNICATING VIA TEN-11 INTERFACE.  NO OPTIONS.
DEFINE TTDTV N
T!N!$SMT==%TQGRF+%TQVIR+%TQREC+%TQXOR+<.DPB 14,<.BP %TQHGT>>+<.DPB 6,<.BP %TQWID>>,,%TRSCN
T!N!$HOR==96.
T!N!$VER==45
T!N!$OPT==%TOMVB+%TOMVU+%TOERS+%TOSAI+%TOLWR+%TOOVR+%TOFCI+%TOLID+%TOCID,,%TP11T+%TPRSC
T!N!$TYP==%TTLCL+<SPEEDC 9600,9600>,,%TY11T
T!N!$TCT==%TNTV
T!N!$ROL==4
TERMIN

;DEFINE A PDP11 TV COMMUNICATING AS A SOFTWARE TTY.  TYPICALLY A GRINNELL (512x512).
DEFINE TTDGRN N,+SPEED=9600,ISPEED=,TT=0,TY=0,TO=0,TP=%TPCBS+%TPORS,HOR=86.,VER=50.,TCT=%TNSFW,ROL=0,SMARTS=0
T!N!$SMT==SMARTS,,
T!N!$HOR==HOR
T!N!$VER==VER
T!N!$OPT==TO+%TOMVB+%TOMVU+%TOERS+%TOSAI+%TOLWR+%TOOVR+%TOFCI,,TP
T!N!$TYP==TT+<SPEEDC ISPEED,SPEED>,,TY+<CNTRLR N>
T!N!$TCT==TCT
T!N!$ROL==ROL
TERMIN

;DEFINE AN STY LINE.  NO OPTIONS.
DEFINE TTDSTY N
T!N!$SMT==0,,
T!N!$HOR==81.
T!N!$VER==MOVE
T!N!$OPT==%TOMVB+%TOOVR+%TOLWR+%TORAW,,%TPORS
T!N!$TYP==%TYSTY
T!N!$TCT==%TNPRT
T!N!$ROL==1
TERMIN

DEFINE MCONDX MCHN
IFE MCOND MCHN,TERMIN

;;; THE NEXT TWO MACROS CAUSE TTYTYP FILE TO BE INSERTABLE BY BOTH
;;; PDP-10 AND PDP-11 PROGRAMS.

DEFINE .ENDC
TERMIN

DEFINE .ENDR
TERMIN

        .CRFOFF
$INSRT TTYTYP
        .CRFON
EXPUNGE TTDPRT,TTDTRM,TTDDPT,TTDMRX,TTDGT40,TTD11,TTDRAN,TTDGRN,TTDVT,TTDTEK
EXPUNGE TTDTV,TTD2741,TTDSTY,TTDLPT,TTDIML,TTDLA36,TTDLSR
EXPUNGE SPEEDC,SPEED1,CNTRLR,MCONDX,.ENDC,.ENDR
]               ;END OF IF2
\f
SUBTTL BUG MACROLOGY

;Macro for reporting a bug or other interesting condition
;Use this in place of JRST 4, especially when condition is automatically
;recoverable or wants explanation typed out for benefit of loser.
;
;First argument is one of the following symbols:
;       INFO - just print on the system console
;       CHECK - same as INFO unless SYSDBG non-zero or buffer full, then same as PAUSE
;       PAUSE - print message, go to DDT, allow alt-P
;       HALT - print message, go to DDT, do not allow alt-P
;       DDT - PAUSE but not because of a bug (shorter message), allow alt-P
;       AWFUL - same as HALT but usable when there is no pdl in P
;         Should there be a combination of AWFUL and PAUSE?
;         That would require restoring P upon attempt to continue
;Arguments after the first are either strings to be printed
;(enclose in brackets), or format,value pairs.  Value is any
;address; indexing and indirection are allowed, however registers
;P and TT may not be referenced.
;A format is one of the following symbols:
;       OCT - octal number, with ,, if bits on in the left halt
;       DEC - decimal number
;       THOU - decimal number with commas every three digits
;       CR - print a carriage return (unfortunately swallows and ignores an arg)
;       SIXBIT - sixbit word
;       ASCIZ - asciz string
;Undefined formats will be taken as strings to be printed.
;The maximum number of value arguments is 6
;A space is printed after each formatted value.  A space is also
;printed after the last string and before any additional formatted values.
;
;With no arguments, BUG may be used in place of JRST 4,.
;It uses the same amount of storage but has the advantage of going
;straight to DDT.  In this case there won't be a specific message
;about what the bug was, of course.
;
;Note that the BUG macro always generates one word of code, and hence
;may be skipped over.
;All registers are preserved.
;P must point at a valid PDL.
;
;Due to Midas inadequacy, the BUG macro may not be used from inside
;a literal.  You will get an error (label inside brackets) if you try it.
;
;Example:
;       BUG PAUSE,[DSK: DRIVE NUMBER ],OCT,Q,[IS OFF-LINE.]
;
DEFINE BUG FLAVOR,ARGS/
IFNB [FLAVOR][
        ;Make sure we are not in a literal, since cannot get value of "."
BUGBUG: EXPUNGE BUGBUG
        ;Generate call to appropriate flavour of subroutine
  ZZ==0
  IRPS FLA,,[INFO,CHECK,PAUSE,HALT,DDT]SUB,,[BUGINF,BUGCHK,BUGPSE,BUGHLT,BUGDDT]
    IFSE [FLAVOR]FLA,[
        PUSHJ P,SUB
        ZZ==1 ]
  TERMIN
  IFSE [FLAVOR]AWFUL, JSR BUGAWF
  .ELSE IFE ZZ, .ERR "FLAVOR" UNKNOWN FLAVOUR OF BUG

  BUGB==0                       ;Initialize formatting bits

        ;Initialize remote macros
DEFINE BUGMC1 *ZZ001*ZZ002*ZZ003*
ZZ001!ZZ002!ZZ003!TERMIN

DEFINE BUGMC4 ZZ001
ZZ001
TERMIN

  BUGN==0       ;number of accumulated arguments
  BUGNN==0      ;total number of arguments
  BUGF==0       ;next thing not argument
  IRP ARG,,[ARGS]
    ;; Processing "ARG"
    IFN BUGF,[                  ;Address of word to print
     BUGN==BUGN+1
     BUGNN==BUGNN+1
     BUGMC5 [ARG]
     BUGF==0
     ]
   .ELSE [                      ;Name of format in which to print?
    IRPS FMT,,OCT DEC THOU CR UNUSED5 SIXBIT ASCIZ
      IFSE [ARG]FMT,[
        BUGF==1
        BUGB==BUGB+<<.IRPCNT+1>_<<5-BUGNN>*3>>
        ]
    TERMIN
    IFE BUGF,[                  ;Just a string to be printed
      IFN BUGN,[        ;Say to output some arguments before this string
        BUGMC3 BUGN
        BUGN==0
        ]
      BUGMC2 [ARG]
      ] ]
   TERMIN
  IFG BUGNN-6, .ERR MORE THAN 6 WORDS TO BE PRINTED IN BUG MACRO
        ;Make bug table entry: length,,pc ? bits,,string ? args
  IF1, BUGMC1 'ZZ==[ASCIZ|',,'|]'
  IF2,[
   ZZ==.
   LOC BUGTAB+LBUGTB
   BUGNN+2,,ZZ
   BUGMC1 'BUGB,,[ASCIZ|',,'|]'
   BUGMC4
   LOC ZZ
   ]
  LBUGTB==LBUGTB+BUGNN+2
];end IFNB
.ELSE PUSHJ P,BUGNIL
TERMIN

LBUGTB==0       ;Initialize length of bug table

;This support macro appends a string to the middle argument of BUGMC1
DEFINE BUGMC2 STRING
BUGMC1 //,[DEFINE BUGMC1 *ZZ001*ZZ002*ZZ003*
ZZ001!ZZ002!]//,STRING!!ZZ003!TERMIN
TERMIN

;This support macro appends a character, given by number, to the middle
;argument of BUGMC1
;Only for characters 0 through 7
DEFINE BUGMC3 #N
IRPC C,,.QUOTE/\0\ 1\ 2\ 3\ 4\ 5\ 6\a/
 IFE .IRPCNT-N,{
  BUGMC2 C
  .ISTOP }
TERMIN
TERMIN

;This one is a simple remote macro
DEFINE BUGMC5 STR
BUGMC4 [DEFINE BUGMC4 ZZ001
ZZ001]STR
TERMIN
TERMIN
\f
SUBTTL DEFINE PI CHANNELS

LPTP==OLPTP+NLPTP+GLPTP ;ANY KIND OF LPT EXCEPT A TTY LPT
IFE NMTCS,[             ;IF NO MAG TAPES AT ALL
TM10A==0                ; CAN'T HAVE ANY KIND!
TM10B==0
TM03S==0
] ;IFE NMTCS
TM10P==TM10A+TM10B      ;SOME KIND OF A TM10 MAGTAPE PRESENT
IFN TABP,TABCLK==0      ;1=>PUT TABLET ON CLOCK CHNL

;PRIORITY INTERRUPT CHANNEL ASSIGNMENTS
                DCCHN==1        ;DC CHANNEL
                DCLOC=40+2*DCCHN ;DC INTERRUPT LOCATION
IFN IMPP,       IMPCHN==1       ;IMP STUFF
IFN NETP,       NETCHN==2       ;SOFTWARE ACTIVATED...
                UTCCHN==2       ;UTC CHANNEL
                DSKCHN==UTCCHN  ;2314 CHANNEL
                MTCCHN==UTCCHN  ;MAG TAPE CONTROL CHANNEL
                LPTCHN==4       ;LINE PRINTER, PAPER TAPE, ETC. CHANNEL
                TTYCHN==3       ;TTY CHANNEL
IFN PLTP,       PLTCHN==4       ;PLOTTER CHANNEL
IFN PTRP,       PCHCHN==4       ;PTP CHANNEL
IFN PTRP,       PTRCHN==4       ;PAPER TAPE READER CHANNEL
IFN NTYP,       NTYCHN==4       ;NTY 11 KLUDGE
IFN 340P,       SDCHN==4        ;DISPLAY SPECIAL CHANNEL
IFN DSDP,       DSDCHN==4       ;INTERRUPT FROM OTHER PROCESSOR
IFN ARMP,       TIPBCH==5       ;ARM TIP BREAK CHNL
IFN OMXP,       OMPCHN==5       ;OUTPUT MULTIPLEXOR
IFN VIDP,       NVDCHN==5       ;NEW VIDI
IFN TABP,       IFE TABCLK,     TABCHN==5       ;TABLET
IFN 340P\E.SP,  DISCHN==6       ;DISPLAY DATA CHNL
IFN CH10P,      CHXCHN==5       ;CHAOSNET
                        ;WOULD BE 6 BUT PI 6 BROKEN IN ML-KA TTLIOB
IFN CH11P,      CHXCHN==6       ;UNIBUS CHAOSNET PACKET COPYING
IFN TABP,       IFN TABCLK,     TABCHN==7       ;TABLET
                APRCHN==7       ;DO NOT CHANGE

                PIOFF==400      ;TURN OFF PI SYSTEM
                PION==200       ;TURN ON PI SYSTEM
                PICOFF==1200    ;TURN OFF PI CHANNEL
                PICON==2200     ;TURN ON PI CHANNEL
                PICIRQ==4200    ;REQUEST INTERRUPT ON PI CHANNEL
                CLKON==2201     ;ABSOLUTE
                CLKOFF==1201
IFN OMXP,       OMXON==CLKON\<400_-OMPCHN-1>
IFN OMXP,       OMXOFF==CLKOFF\<400_-OMPCHN-1>
                LPTON==CLKON\<400_-LPTCHN-1>
                LPTOFF==CLKOFF\<400_-LPTCHN-1>
IFN PTRP,       PTPON==CLKON\<400_-PCHCHN-1>
IFN PTRP,       PTROFF==CLKOFF\<400_-PCHCHN-1>
IFN PTRP,       PTRON==CLKON\<400_-PTRCHN-1>
IFN PTRP,       PTROFF==CLKOFF\<400_-PTRCHN-1>
                TTYON==CLKON\<400_-TTYCHN-1>
                TTYOFF==CLKOFF\<400_-TTYCHN-1>
                UTCON==CLKON\<400_-UTCCHN-1>
                UTCOFF==CLKOFF\<400_-UTCCHN-1>
IFN NETP,       NETON==UTCON
IFN NETP,       NETOFF==UTCOFF
IFN KL10P,      DTEON==CLKON
IFN KL10P,      DTEOFF==CLKOFF

        DSKRQ==PICIRQ\PICON\<200_-DSKCHN> ;RQ INT + TURN ON FOR SAKE OF KL
        MTCRQ==PICIRQ\PICON\<200_-MTCCHN>
        UTCRQ==PICIRQ\PICON\<200_-UTCCHN>
        TTYRQ==PICIRQ\PICON\<200_-TTYCHN>
        CLKRQ==PICIRQ\PICON\<200_-APRCHN>
IFN NETP,NETRQ==PICIRQ\PION\<200_-NETCHN>       
IFN CH11P,CHXRQ==PICIRQ\PICON\<200_-CHXCHN>

IFN TABP,[
IFN TABCLK,[
TABON==CLKON
TABOFF==CLKOFF
]
IFE TABCLK,[
TABON==CLKON\<400_-TABCHN-1>
TABOFF==CLKOFF\<400_-TABCHN-1>
]
]

IFN NUNITS, IFE NEWDTP, CUINT==5000+UTCCHN      ;CONO TO UTC TO ACTIVATE UTAPE INTERRUPT

PMLCAD==(.BP <PMRCM,,>) ;BYTE POINTER TO L.H. REAL CORE ADR
PMRCAD==(.BP PMRCM)     ;BYTE POINTER TO R.H. REAL CORE ADR
\f
SUBTTL DEFINE DEVICE CODES, IOBFT CHNL NUMBERS

IFN STKP,       STK==70         ;STANFORD KEYBOARD
IFN OLPTP,      OLPT==124       ;LINE PRINTER
IFN NLPTP,      NLPT==464
IFN TM10P,      MTC==340        ;MAG TAPE CONTROL
IFN TM10P,      MTS==344        ;MAG TAPE STATUS
IFN VIDP,       NVDX==620       ;NEW VIDI X
IFN VIDP,       NVDY==624       ;NEW VIDI Y
IFN VIDP,       NVDT==630       ;NEW VIDI T (DEFLECTION DELAY)
IFN PLTP,       PLT==654        ;CAL COMP PLOTTER
IFN HCLKP,      CLK1==710       ;HOLLOWAY CLOCK
IFN HCLKP,      CLK2==714       ; "
IFN IMXP,       MPX==574        ;INPUT MULTIPLEXOR
IFN OMXP,       OMPX==570       ;OUTPUT MULTIPLEXOR
IFN TK10P\NTYP, NTY==600        ;KNIGHT TTY KLUDGE
IFN MTYP,       MTY==400
IFN DL10P,      DLB==60         ;DL10 BASE
.ALSO           DLC==64         ;DL10 CONTROL
IFN PDCLKP,     PDCLK==500      ;DE-CORIOLIS CLOCK (FOR ML-KA AND DM, CALENDAR CLOCK)
IFN DSDP,       DSDEV==20       ;DE SELECTION AND INTER COM DEVICE
IFN DSDP,       DSDEVN==24      ;DE SELECTION DEV (FOR DEVICES YOU DATAO DEV CODE TO DSDEVN)
IFN ARMP,       TIPDEV==504     ;TIP BREAK DEVICE
IFN RBTCP,      RBTCON==514     ;ROBOT CONSOLE
IFN DPKPP,      DPK==604        ;DATA POINT KLUDGE
IFN DC10P,      DC0==610        ;2314 DISK CONTROL
IFN DC10P,      DC1==614        ;2314 DISK CONTROL
IFN RP10P,      DPC==250        ;RP10 DISK CONTROL
IFN RH10P,      DSK==270        ;RH10 DISK CONTROL
IFN KAIMP,      IMP==460        ; AI-KA/ML-KA/MC-KL IMP interface
IFN DMIMP,      FI==424         ; DM IMP hardware
IFN NUNITS,[
IFN NEWDTP,[
        DTC==320
        DTS==324
]               ;END OF IFN NEWDTP
]               ;END OF IFN NUNITS


;IOBFT CHANNEL NUMBERS - 77 MEANS "FREE"

IFN NUNITS,     NUTIC==8        ;NUMBER UT IN CHNLS
.ELSE           NUTIC==0
IFN NUNITS,     NUTOC==8        ;NUMBER UT OUT CHNLS
.ELSE           NUTOC==0
                NFCLC==NUTIC+NUTOC+1    ;# OF FIRST CORE LINK CHNL
                NCLCH==14       ;NUMBER CORE LINK CHNLS
                NFNETC==NFCLC+NCLCH     ;# OF FIRST NCP NET CHNL (if any)
                                        ;NNETCH DEFINED IN CONFIG
IFG NFNETC+NNETCH-77, .ERR TOO MANY IOBFT CHANNELS
\f
SUBTTL RANDOM DEFINITIONS FOR I/O DEVICES

IFN DSDP,       IFN VIDP,       DSNVID==200000,,        ;DEASSIGN BIT FOR NVD
IFN DSDP,       IFN 340P,       DSNDIS==4000,,  ;DEASSIGN BIT FOR DIS
IFN DSDP,       IFN NMTCS,      DSMTC==1,,      ;DEASSIGN BIT FOR MAG TAPE

IFN RBTCP,      RLTSWC==17      ;ROBOT CONSOLE SELECT FOR LIGHTS AND SWITCHES
IFN RBTCP,      IFN TABP,       RTABC==16       ;ROBOT CONSOLE SELECT FOR TABLET

IFN IMXP,       LCHN==177       ;MULTIPLEXOR LIMIT ON READ IN

                NUDCH==14       ;NUMBER DIRECTORY CHNLS
IFN IMXP,       NPOTCH==20.     ;NUMBER POT CHANNELS
IFG NQCHN+1+NQS-77, .ERR MORE THAN 6 BITS OF DISK CHANNEL NUMBER

IFN CODP,       CODBFL==5       ;CODE BUFFER
IFN PTRP,       PUNSIZ==20      ;PTP BUF SIZ
IFN PTRP,       REDSIZ==200     ;PTR BUF SIZ
IFN PLTP,       LPLBUF==200     ;PLT BUF SIZ
IFN LPTP,       LPTBSZ==1000    ;LPT BUF SIZ
IFN VIDP,       NVDLNG==340     ;NVD BUF SIZE
IFN TPLP,       TPLBSZ==100     ;TPL BUFFER SIZE IN SYS JOB
IFN TABP,       LTABBF==100     ;TABLET BUFFER
IFN N11TYS,     TT11CR==764044  ;UNIBUS ADR OF TV11 CONSOLE REG

EOFCH==3        ;SYSTEM END OF FILE CHR
EOFWRD=REPEAT 5,[EOFCH_<.RPCNT*7+1>\]0  ;WORD OF EOFCH'S

IFN 340P,       DVEF==4000      ;DISPLAY VERTICAL EDGE FLAG
IFN 340P,       DHEF==1000      ;DISPLAY HOR EDGE FLAG

IFN 340P,       EWRT==400./12.  ;EQIV "COST" IN DISPLAY WRDS FOR TRIP THRU RECYC
IFN 340P,       MDISWD=70000    ;MAX # WDS SENT TO SCOPE IN 1/2 SEC

NSWPV==E.SP\340P+VIDP+IMXP      ;# OF DEVICES THAT CAN SWAPIN PAGES

IFN C1MXP,[
IFN NMTCS,      MAGLOC==76      ;INTERRUPT LOCS FOR MAGTAPE
IFN NUNITS,     DCMLOC==74      ;"      "    FOR DC
IFN IMXP,       IMXLC==66       ;"     "   IMX
IFN IMPP,[
                IMPILC==70      ;INPUT FROM IMP
                IMPOLC==72      ;OUTPUT TO IMP
]
]

IFE C1MXP,[
IFN NMTCS,      MAGLOC==42
IFN NUNITS,     DCMLOC==42
]
IFN PLTP,[
;PLOTTER CONTROL BITS
SD==4000
PD==10000
PUP==200
PDN==400
SDC==20000
PDC==40000
SDS==1000
PDS==2000
]
\fIFN KA10P,[

SUBTTL STUFF PECULIAR TO KA-10 PROCESSOR

;;;PAGING BOX INSTRUCTIONS

LPM=102000,,    ;LOAD PG MEM STATE VECTOR DONT CLR ASSOC MEM
LPMR= LPM 2,    ;CLEAR ASSOC MEM AND LOAD
SPM= LPM 1,     ;STORE PG MEM STATE VECTOR
LPMRI=LPM 6,    ;LOAD PM, CLEAR ASSOC REG, AND CAUSE INTERRUPT
EXPGNG==4       .SEE UPQUAN     ;4 TO TURN ON EXEC PAGING
XCTR=103000,,   ;EXECUTE INSTRUCTION WITH MAPPING CONTROLLED BY AC FIELD
                ;VIOLATION CAUSES USER MEM PROTECT INTERRUPT UNLESS INHIBITED
                ;VIOLATION ALSO SKIPS BUT THIS IS OF NO CONSEQUENCE UNLESS
                ;INTERRUPT IS INHIBITED SINCE PC WILL BE RESET FROM OPC
XCTRI= XCTR 4,  ;XCTR WITH PAGE FAULT INHIBITED (SKIPS ON FAULT)
                ; AC FIELD VALUES FOR XCTR AND XCTRI
        XR==1   ;MAP READ MAIN OPERAND OF SIMPLE INSTRUCTION (MOVE, SKIPL, HLL)
        XW==2   ;MAP WRITE MAIN OPERAND OF SIMPLE INSTRUCTION (MOVEM)
        XRW==3  ;MAP READ/WRITE OPERAND OF SIMPLE INSTRUCTION (E.G. IORM)
        XBYTE==3;MAP BYTE DATA AND BYTE POINTER (ILDB, IDPB)
        XBR==1  ;MAP BLT READ
        XBW==2  ;MAP BLT WRITE
        XBRW==3 ;MAP BOTH OPERANDS OF BLT
                ;KA10 PAGING BOX GOES BY WHETHER IT'S A READ OR WRITE (OR RW) CYCLE
                ;KL10 PAGING BOX WORKS DIFFERENTLY (SEE BELOW)
                ;DO NOT USE MULTI-OPERAND INSTRUCTIONS (DMOVE, PUSH, ETC.) WITH XCTR

DEFINE CLRPGM U ;CLEAR PAGER ASSOCIATIVE MEMORY.  ARG IS USUALLY "(U)".
 SPM UPGML!U    ;STORE SO DON'T LOSE QUANTUM TIMER
 LPMR UPGML!U
TERMIN

;;; MISCELLANEOUS BUILTIN I/O DEVICES

PI==4           ;INTERRUPT SYSTEM
LIGHTS==PI      ;DEVICE CODE FOR DATAO THAT SETS CONSOLE LIGHTS.
CLK==0          ;DEVICE CODE FOR 60 HZ CLOCK INTERRUPT (APR)
CLKINT==1000    ;CONI CLK, BIT FOR INTERRUPT.  ALSO CONO BIT TO CLEAR.
PTR==104        ;PAPER TAPE READER
PTP==100        ;PAPER TAPE PUNCH
TTY==120        ;CONSOLE TTY
DTC==320        ;DECTAPE CONTROL
IFN 340P, DIS==130      ;340 DISPLAY

PI0LOC==40      ;INTERRUPT VECTOR BASE

OIPBIT==%PC1PR  ;PC BITS FOR 1-PROCEED.
BADPC==%PCUIO+%PCSPC+37 ;BITS IN PC USER NOT ALLOWED TO TURN ON

DEFINE UUOH     ;UUO HANDLER LOCATIONMS ARE REFERENCED THROUGH THESE MACROS
XUUOH!TERMIN

DEFINE FORTY
40!TERMIN

DEFINE SYSCTX   ;SET UUO LEVEL AC BLOCKS
TERMIN

DEFINE USRCTX   ;SET USER-MODE AC BLOCKS
TERMIN

DEFINE OVHMTR NAME      ;OVERHEAD METERING DOESN'T WORK ON KA'S
TERMIN
]               ;END OF IFN KA10P
\fIFN KL10P,[

SUBTTL STUFF PECULIAR TO KL-10 PROCESSOR

;;;PAGING BOX INSTRUCTIONS

XCTR=074000,,   ;EXECUTE INSTRUCTION WITH MAPPING, PAGE FAILS ENABLED
XCTRI=075000,,  ;SAME BUT SKIPS IF THERE IS PAGE FAIL (DONE SNEAKILY BY SOFTWARE)
LPMR=076000,,   ;LOAD PAGER MEMORY (JPC, DBRS) AND CLEAR PT DIR
SPM=077000,,    ;STORE PAGER MEMORY
                ;AC FIELD VALUES FOR XCTR AND XCTRI
        XR==4   ;MAP MAIN OPERAND OF SIMPLE INSTRUCTION (FOR READING)
        XW==4   ;MAP MAIN OPERAND OF SIMPLE INSTRUCTION (FOR WRITING)
        XRW==4  ;MAP MAIN OPERAND OF SIMPLE INSTRUCTION (FOR READING AND WRITING)
        XBYTE==5;MAP BYTE DATA AND BYTE POINTER
        XBR==1  ;MAP BLT SOURCE
        XBW==4  ;MAP BLT DESTINATION
        XBRW==5 ;MAP BOTH BLT OPERANDS
        XEA==16 ;MAP EFFECTIVE ADDRESS COMPUTATION
                ;IN KL10 BITS ARE:  14 INDIRECT WORDS
                ;                   10 XR UNDER SOME RANDOM WIERD CONDITIONS (?)
                ;                    4 MAIN OPERAND "  "  " ALSO BYTE WRITE
                ;                    2 INDEX REGISTER, @ AND XR IN BYTE PTRS
                ;                    1 2ND OPND - BLT SOURCE, BYTE READ, STACK DATA

DEFINE CLRPGM U ;CLEAR PT DIR WITHOUT SWITCHING USERS.  ARG IS USUALLY "(U)".
 CONO PAG,660000+<EPT/1000>
TERMIN

;;; INTERNAL "I/O" DEVICES

PI==4           ;INTERRUPT SYSTEM
PAG==10         ;CONO, DATAO PAG SET UP PAGING
 ..D010==0      ;FOR DDT
CCA==14         ;CACHE OPERATIONS
TIM==20         ;TIMER DEVICE
MTR==24         ;METERS DEVICE

IFN PDCLKP,[    ;IF THIS KL-10 HAS FREEMAN KL-UDGE BOARD,
LIGHTS==500     ;DATAO LIGHTS, SETS CONSOLE LIGHTS.
CLK==500        ;60 HZ CLOCK INTERRUPT (ON KL-UDGE BOARD)
CLKINT==10      ;CONI CLK, BIT FOR INTERRUPT.  ALSO CONO BIT TO CLEAR.
                ;ALSO DATAI 500, IS THE DECORIOLIS CLOCK.
                ;AND CONO 500,400000 TURNS CLOCK BACK ON AFTER POWER FAIL.
]

OIPBIT==%PS1PR  ;1-PROCEED BITS IN THE PC.
BADPC==%PSUIO+37        ;%PSPUB IS OK?

;;; SPECIAL INSTRUCTIONS

SWPIA=DATAI CCA,        ;INVALIDATE WHOLE CACHE
SWPIO=CONI CCA,         ;INVALIDATE ONE PAGE OF CACHE
SWPUO=CONSO CCA,        ;UNLOAD ONE PAGE OF CACHE
SWPUA=DATAO CCA,        ;UNLOAD WHOLE CACHE
WRPAE=702100,,          ;WRITE PERFORMANCE-COUNTER ENABLES
APRID==BLKI             ;READ CPU SERIAL NUMBER AND OPTIONS
RDERA=BLKI PI,          ;READ ERROR ADDRESS
RCCL=DATAI TIM,         ;READ CALENDAR CLOCK (DOUBLE WORD)
RPERFC=BLKI TIM,        ;READ PERFORMANCE COUNTER (DOUBLE WORD)
REBOXC=DATAI MTR,       ;READ EBOX CYCLE COUNTER (DOUBLE WORD)
RMBOXC=BLKI MTR,        ;READ MBOX CYCLE COUNTER (DOUBLE WORD)

;;;EPT LOCATIONS

$INSRT EPT

;;;PAGE FAIL WORD - UPFW(U)

 %PF==1,,405000
 %PFUSR==400000         ;USER PAGE
 %PFCOD==370000         ;FAILURE CODE:
  %PFPRO==210000        ;PROPRIETARY VIOLATION
  %PFMAR==230000        ;MAR BREAK
  %PFILW==240000        ;ILLEGAL WRITE IN READ ONLY
  %PFPNA==330000        ;PAGE NO ACCESS
  %PFPTP==250000        ;PAGE TABLE PARITY
  %PFPAR==360000        ;PARITY ERROR, DATA IN AR
  %PFPRX==370000        ;PARITY ERROR, DATA IN ARX
 %PFPUB==4000           ;PUBLIC PAGE
 %PFCCH==2000           ;CACHED
 %PFPAG==1000           ;PAGED
 $PFPNO==121000         ;VIRTUAL PAGE NUMBER
                        ;1.1-3.5 VIRTUAL ADDRESS

DEFINE UUOH     ;UUO HANDLER LOCATIONS REFERENCED THROUGH THESE MACROS
XUUOH(U)TERMIN

DEFINE FORTY
MUUODP(U)TERMIN

;SET SPECIAL CONTEXT: CURRENT AC BLOCK CURACS, PREVIOUS BLOCK (FOR XCTR) OLDACS,
; UPT AS SPECIFIED. IF NO ACS SPECIFIED, THEY DON'T CHANGE; SAME FOR UPT.
; DISABLE, IF NONBLANK, CAUSES ACCOUNTING UPDATING NOT TO BE DONE EVEN THOUGH
; UPT IS BEING SET.
DEFINE SPCCTX CURACS,OLDACS,UPT,DISABLE
DATAO PAG,[IFNB CURACS OLDACS,[SETZ]+IFNB UPT,[1^13]+2^13+CURACS_33+OLDACS_30+UPT/1000+400000-IFNB UPT,[IFB DISABLE,[400000]]]
TERMIN

SYSCTX=SPCCTX 0,1       ;UUO LEVEL CONTEXT: CURRENT AC BLOCK 0, PREVIOUS = 1.
USRCTX=SPCCTX 1,1       ;USERS RUN IN BLOCK 1.
IRPC N,,[234567]
 AC!N!CTX=SPCCTX 0,N    ;CUR AC 0, PREV N.  USE XCTR TO ACCESS SPECIAL ACS
TERMIN

;AC BLOCK USAGE:
; 0   ACCUMULATORS FOR SYSTEM (AT UUO LEVEL)
; 1   ACCUMULATORS FOR USER
; 2   USED TEMPORARILY BY TTY INPUT INTERRUPTS
; 3-5 NOT USED
;     BLOCKS 2 & 3 ARE USED BY THE UNFINISHED MUSIC MICROCODE
;     BLOCKS 4 & 5 ARE USED BY THE UNFINISHED JPC RING FEATURE
; 6-7 USED BY MICROCODE
]               ;END OF IFN KL10P
\fIFN KS10P,[

SUBTTL STUFF PECULIAR TO THE KS-10 PROCESSOR

EPT==:0                         ; This MUST agree with the Salvager!
HSB==:500
$INSRT KSDEFS

DEFINE CLRPGM U ;CLEAR PT DIR WITHOUT SWITCHING USERS.  ARG IS USUALLY "(U)".
 WREBR 20000+<EPT/1000>
TERMIN

OIPBIT==1000            ;BIT 8 (SYMBOLIC NAME %PSINH)
BADPC==%PSUIO+37        ;BITS IN PC THAT USER CANNOT TURN ON

DEFINE UUOH     ;UUO HANDLER LOCATIONS REFERENCED THROUGH THESE MACROS
XUUOH(U)TERMIN

DEFINE FORTY
MUUODP(U)TERMIN

;SET SPECIAL CONTEXT: CURRENT AC BLOCK CURACS, PREVIOUS BLOCK (FOR XCTR)
; OLDACS, UPT AS SPECIFIED. IF NO ACS SPECIFIED, THEY DON'T CHANGE; SAME
; FOR UPT.
DEFINE SPCCTX CURACS,OLDACS,UPT
WRUBR [IFNB CURACS OLDACS,[SETZ]+IFNB UPT,[1^13]+CURACS_33+OLDACS_30+UPT]
TERMIN

SYSCTX=SPCCTX 0,1       ;UUO LEVEL CONTEXT: CURRENT AC BLOCK 0, PREVIOUS = 1.
USRCTX=SPCCTX 1,1       ;USERS RUN IN BLOCK 1.
IRPC N,,[234567]
 AC!N!CTX=SPCCTX 0,N    ;CUR AC 0, PREV N.  USE XCTR TO ACCESS SPECIAL ACS
TERMIN

;AC BLOCK USAGE:
; 0   ACCUMULATORS FOR SYSTEM (AT UUO LEVEL)
; 1   ACCUMULATORS FOR USER
; 2   USED TEMPORARILY BY TTY INPUT INTERRUPTS
; 3-6 NOT USED
; 7   USED BY MICROCODE (AC0 GETS BAD DATA WHEN MEMORY ERROR OCCURS, THIS
;     COULD BE FIXED IF ANYONE THINKS IT IS WORTH IT...)
]               ;END OF IFN KS10P

IFE KS10P,[     ; For the benefit of processors without UMOVE and UMOVEM.

DEFINE UMOVE (AC,ADDR)
XCTR XR,[MOVE AC,ADDR]
TERMIN

DEFINE UMOVEM (AC,ADDR)
XCTR XW,[MOVEM AC,ADDR]
TERMIN

] ;IFE KS10P
\f
SUBTTL SYS IOC STATUS WORD FORMAT

;RIGHT HALF WORD DEVICE STATUS
;1.1-1.6 SYS PHYSICAL DEVICE CODE
;1.7-1.9 OPEN MODE
;2.1 SYS BUFF CAP FULL
;2.2 "   "    "  EMPTY
;2.9-2.3 DEVICE DEPENDANT

;LEFT HALF WORD CHANNEL STATUS 
;3.6-3.1 SET BY OPENS THAT DONT SKIP
;4.5-3.7 SET BY IOC ERRORS (INTERRUPTS) AT IOT OR OPER TIME
 ;3.9-3.7 ARE FOR 340 OR E&S ERRORS
 ;4.5-4.1 ARE FOR OTHER DEVICES
;A LIST OF ERROR CODES FOR OPEN FAILURES ARE IN THE FILE  BITS.

NDOPL==7        ;NUM OF DIS OPNL

;4.5-3.7 SET BY IOC ERRORS AT IOT OR OPER TIME

;3.9-3.7 SET BY 340 ROUTINES
;1 ILLEGAL SCOPE MODE
;2 SCOPE HUNG
;3 MORE THAN 1K SYS SCOPE BUF
;4 MEMORY PROTECT
;5 ILLEGAL SCOPE OP
;6 MEMORY PROTECT ON PDL POINTER
;7 ILLEGAL PARAMETER SET

;4.5-4.1
;DECIMAL CODE
;13 DIRECTORY'S ALLOCATION EXHAUSTED
;12 DIRECTORY FULL
;11 ILLEGAL CHR AFTER ^P ON TTY DISPLAY
;10 CHNL IN ILLEGAL MODE WHEN .IOT ATTEMPTED
;9 DEVICE FULL
;8 CHANNEL NOT OPEN
;7 USR OP CHNL DOES NOT HAVE USR OPEN
;6 ATTEMPT TO OVER IOPUSH
;5 ATTEMPT TO OVER IOPOP
;4 NON-EXISTANT SUB DEVICE
;3 NON-RECOVERABLE DATA ERROR ;NON-EX-MEM ON PDP6 REF
;2 END OF FILE
;1 DEVICE HUNG OR REPORTING NON-DATA ERROR

MIOTER==1       ;LOWEST IOCERR CODE USED
NIOTER==13.     ;NUMBER "  "

;4.9-4.5 ALWAYS ZERO (USED BY IOPUSH FOR CHNL NUM)
\f
;SYS PERIPHERAL DEVICE CODES

;1.6 INDICATES DIRECTORY DEVICE
;1.5 INDICATES NON PHYSICAL DEVICE

SNTTY==1
SNTDS==2        ;TERMINAL DISPLAY
SNLPD==3        ;DATA PRODUCTS LPT
SNVID==4
SNBAT==5
SNPLT==6
SNPTP==7
SNIMPX==10
SNOMPX==11
SNPTR==12
SN340==13       ;340 AS ASCII DEVICE
;SN340I==14     ;INTERPRETED DISPLAY ON 340
SNMTC==15       ;MAGTAPE
SNCOD==16       ;CODE DEVICE
SNTAB==17
SNNUL==21
SNJOB==22
SNBOJ==23
SNSPY==24
SNSTY==25
SNNET==26       ; Arpanet NCP
SNLPV==27       ;VOGUE LPT
SNSTK==30       ;STANFORD KEYBOARD
SNMSP==31       ;CROCK "IPC" FOR NOW
IFN CHAOSP,SNCHA==32    ;CHAOS NET
IFN TCPP,SNTCP==33      ; Internet TCP/IP network device
SNTRAP==34      ;TRAP "DEVICE"
IFN INETP,SNIPQ==35     ; Internet Queue
SNUTC==41
SN2311==43
SNFUSR==60
SNUSR==61
SNCLK==62       ;CLO, CLU, & CLI
SNDIR==63
SNPDP==64       ;PDP6
SNDIRH==65      ;DIRHNG "DEVICE"
\f
SUBTTL SYSTEM VERSION NUMBER & MISC MACROS

ITSMCH==:<MNAME SIXBIT/,/>      ; Define SIXBIT machine name symbol
ITSVRS==:.FNAM2 ; Preserve SIXBIT symbol value of ITS version #
FNM==ITSVRS     ;SRI GETS VERSION NUMBER
                ;WORKS FOR DECIMAL IGNORES LOW ORDER NON-NUMERIC CHRS
DEFINE VNAM
.TAG FOO
        ZZZQ==FNM&77
        IFGE ZZZQ-'0,IFLE ZZZQ-'9,.GO BAR
        FNM==FNM_-6
        .GO FOO
.TAG BAR
        ZZZQ==1
        SRI==0
.TAG MUM
        IFE FNM,.GO END
        ZCHR==FNM&77-'0
        IFL ZCHR,.GO END
        IFG ZCHR-9,.GO END
        SRI==SRI+ZZZQ*ZCHR
        ZZZQ==ZZZQ*10.
        FNM==FNM_-6
        .GO MUM
.TAG END
        TERMIN

IF1 VNAM

DEFINE SRITYP A
ZZZ==10 ;SAVE OLD RADIX
RADIX 10.
        MOVEI I,[MNAME [.ASCII ?
] ITS !SRI A?]
RADIX ZZZ
        TERMIN

                ;"MONTHS OF THE YEAR" MACRO

DEFINE MNIRP A
IRPS M,,[JAN:FEB:MAR:APR:
MAY:JUN:JUL:AUG:
SEP:OCT:NOV:DEC:]L,,[31. 29. 31. 30.
31. 30. 31. 31.
30. 31. 30. 31.]
A
TERMIN
TERMIN

FOO==-1 ;ACCUMULATED VALUE FOR FOLLOWING DEFINITION:

MNIRP [M==FOO
FOO==FOO+L]     ;JAN=-1, FEB=30., MAR=59., ETC.
\f
DEFINE INFORM A,B
IF1,[PRINTX \A = B
\]TERMIN

ZZZ==10
RADIX 10.
INFORM VERSION,\SRI
RADIX ZZZ

SSYS==0 ;LENGTH OF SYS CODE

DEFINE EBLK
IFN CKPAR,.ERR LOSS AT EBLK
CKPAR==1
IFE .-CKZZ,.STOP                ;NO WORDS BETWEEN BBLK AND EBLK
CONC CK,\CKNUM,==CKZZ-.,,CKZZ
CKNUM==CKNUM+1
SSYS==SSYS+.-CKZZ
TERMIN

DEFINE BBLK
CKZZ==.
IFE CKPAR,.ERR LOSS AT BBLK
CKPAR==0
TERMIN

CKPAR==1
CKNUM==0


;INSERT CALL TO THIS MACRO AT ANY PLACE IT IS POSSIBLE TO PCLSR
;(IF IT IS DESIRED FOR PCLSR TEST FEATURE TO TEST THAT SECTION)

DEFINE PCLT
IFN PCLSW,[
        SKIPE PCLDBM
        PUSHJ P,PCLTST
]
TERMIN

DEFINE  PCLTH A
IFN PCLSW,[
        SKIPN PCLDBM
        JRST .+3
        PUSHJ P,PCLTSH
        A
]
TERMIN

DEFINE  PI2SAF
        CONSO PI,20000
         CONSO PI,40
          CAIA
           JRST 4,.     ;PI 2 NOT OFF AND NOT IN PROGRESS
TERMIN
\f
SUBTTL DEFINE EXEC PAGES

EXPGN==0

DEFINE EXECPG X
X==EXPGN
EXPGN==EXPGN+1
ZZQ==<X+1>&1
ZZQQ==X_-1
.!X==220000*ZZQ+2200,,ZZQQ
TERMIN

;EXEC MAP ASSIGNMENTS
IFN 340P,[
EXECPG 340P1,   ;USED TO FETCH + TRACE 340 PNTRS
EXECPG 340P2,
REPEAT N340PB,CONC [EXECPG DPG]\.RPCNT,;        ;DATA AREA PNTRS FOR 340 DATA
]
EXECPG CORJF,   ;CORE JOB FROM PAGE
EXECPG CORJT,   ;CORE JOB TO PAGE
IFN VIDP,[
EXECPG VSB1,    ;.VSCAN B1
EXECPG VSB2,    ;.VSCAN B2
]
IFN TEN11P,[
EXECPG T11CP,   ;TEN11 CONTROL PAGE
]
EXECPG PAREP,   ;USED BY SYSTEM IN ITS DILIGENT EFFORTS TO FIX PARITY ERRORS

IFN ECCMEM, EXECPG ECCPG,       ;PAGE USED TO ACCESS ECC HISTORY

IFN XGP,[
EXECPG XGPC,    ;LOW 2K OF XGP PDP-11   (USED TO TRACE BUFF POINTERS)
EXECPG XGPB,    ;2K BUFFER IN PDP-11 (CHANGES LOCATION)
EXECPG XGPUB,   ;XGP USER CORE EXEC PG SETUP TO POINT TO USER CORE DURING XGPIM SYSTEM CALL
]
IFN N11TYS,[
REPEAT NTTPG,[CONC [EXECPG TTPG]\.RPCNT,
]
REPEAT NTVBP,[CONC [EXECPG TTR]\.RPCNT,
]]
IFN CHAOSP,[ IFN T11CHP,[
EXECPG CHSPG    ;CHAOS NET 10-11 COMMUNICATION PAGE
T11CHS=400000+CHSPG*2000
]] ;CHAOSP, T11CHP
;^ INSERT NEW EXEC PAGES HERE
;EXEC PAGES BELOW THIS POINT WILL BE COPYABLE BY USERS
REPEAT NMMP,CONC [EXECPG MMP]\.RPCNT,;  ;MMP TABLE
 MMP=MMP0*2000+400000   ;VIRTUAL ADDRESS OF MMP
EXPUNGE EXECPG
NEXPGS==EXPGN   ;# EXEC PGS USED
\f
SUBTTL LOW CORE

.YSTGWD         ;STORAGE WORDS OKAY NOW

IFN KL10P, LOC EPT+1000         ;KL needs a full DEC page for EPT
IFN KS10P,[
 IFE KSIMP, LOC EPT+1000        ;KS needs a full DEC page, too,
 IFN KSIMP, LOC EPT+2000        ; unless you are losing even worse.
]

PATB=.
LOC 20
        BBLK

IFN KS10P,[
LOC 30                          ; 8080 communications area
        EBLK
] ;IFN KS10P

IFN TM10B,[
        LOC 30
        EBLK
MICWA:  MIOWD
        0
IFE RP10P+RH10P,BBLK
]
IFN RP10P+RH10P,[
        LOC 32
IFE TM10B,EBLK
QICWA:  QIOWD
        0
IFN QRDCMP,[
RCICWA: 0
        0
];QRDCMP
        BBLK
]
IFN E.SP,[
        LOC 34
        E.SPM   ;POINTER , NEVER CHANGES
]

IFE KS10P,[
LOC 37
        EBLK
] ;IFE KS10P

LOC 41
IFN KA10P, JSR UUOH     ;UUO TRAP
IFE KA10P, JSR LUUOEX   ;USER UUO IN EXEC MODE (ERROR)

LOC PI0LOC+2
        REPEAT 2,       JSR RINT1
        REPEAT 6*2,     JSR RINT        ;INITIALIZE ANY UNUSED PI LOCNS

LOC 61
IFN KA10P, JSR 60H              ;60 TRAP
IFN C1MXP, REPEAT 2*7., JSR RINT1       ;INITIALIZE C1MPX LOCNS

LOC PI0LOC+2*APRCHN
        JSR CLKBRK      ;PROCESSOR OR CLOCK INTERRUPT
        JRST 4,.

LOC PI0LOC+2*LPTCHN
        JSR LPTBRK      ;LPT,DISPLAY,PTP,PTR,OTHER PROCESSOR
IFN 340P,       JSR DRECYC      ;HACK HACK

LOC PI0LOC+2*TTYCHN
        JSR TTYBRK      ;TTY,DATAPOINT KLUDGE
        JRST 4,.

LOC PI0LOC+2*UTCCHN
        JSR UTCBRK      ;MICRO TAPE OR DISK (S)
        JRST 4,.

IFN E.SP,[
LOC PI0LOC+2*DISCHN
        JSR ESBRK
        JRST 4,.
]
IFN 340P,[
LOC PI0LOC+2*DISCHN
        JSR DIGNOR      ;340 DISPLAY BLKO GETS PATCHED IN HERE
        CONO PI,4000+200_<-SDCHN>       ;HACK HACK
]
IFN CH10P+CH11P,[
LOC PI0LOC+2*CHXCHN
        JSR CHXBRK
        JRST 4,.
];CH10P

IFN VIDP,[
LOC PI0LOC+2*OMPCHN
        JSR OMPXBK      ;OUTPUT MPXR, NVID, ETC.
        JRST 4,.
]
IFN KAIMP,[
LOC PI0LOC+2*IMPCHN
        JSR IMPBRK
LOC IMPILC
        JSR IMPIBK
        0
LOC IMPOLC
        JSR IMPOBK
        0
] ; IFN KAIMP

IFN KL10P,[
LOC PFOPC
PFOPC:  0               ;PAGE FAIL OLD PC STORED HERE
PFNPC:  PFAIL           ;WHERE TO GO FOR PAGE FAIL

LOC EPTDIA
EPTDIA: JRST SALV       ;STD COMMAND START ADDRESS ("DIAGNOSTIC")
EPTDDT: JRST DDT        ;DDT COMMAND START ADDRESS
EPTSTL: JRST DSKDMP     ;STL COMMAND START ADDRESS ("LOADER")
EPTITS: JRST BEG        ;STM COMMAND START ADDRESS ("MONITOR")
                        ;SALV THEN GO
LOC EPTTR1
EPTTR1: CAI             ;ARITH OVERFLOW EXEC MODE IGNORED
EPTTR2: JSR ILLTRP      ;PDL OVERFLOW EXEC MODE IS AN ERROR
EPTTR3: JSR ILLTRP      ;ONE PROC CODE?

LOC DTEBPO
DTEBPO: 0               ;BYTE TRANSFER NOT USED
DTEBPI: 0               ;BYTE TRANSFER NOT USED
DTELOC:                 ;INTERRUPT FROM CONSOLE 11
IFE PDCLKP,     JSR DTEBRK      ;IF USING 11 FOR CLOCK, FIRST CHECK FOR CLOCK INTR
.ELSE           JSR TTYBRK      ;OTHERWISE JUST USING 11 FOR TTYS.
        0               ;UNUSED WORD
DTEPRO: 0               ;NO PROTECTED EXAMINES
DTERLO: 0               ;..
DTEPRI: 0               ;NOR PROTECTED DEPOSITS
DTERLI: 0               ;..

LOC EPT+430
REPEAT 8,MUUOEX         ;HALT IF UUO IN PROCESSOR BREAK ROUTINES

LOC EPTEBC
EPTEBC: 0 ? 0           ;EBOX COUNT FOR PROC BRK ROUTINES AND NULL JOB
EPTMBC: 0 ? 0           ;MBOX DITTO

LOC TIMLOC
        JSR OVHBRK      ;INTERVAL TIMER INTERRUPT, EVERY 39 MILLISEC ON CHANNEL 1

;OVHMTR MACRO IS USED TO CONSTRUCT TABLE OF AREAS OF EXEC CORE TO BE METERED
;ON KL10 OVHBRK CHECKS WHERE THE PC IS IF IT IS IN EXEC MODE.

DEFINE OVHMTR NAME      ;NAME IS 3 CHARACTERS NAMING THE REGION THAT BEGINS HERE
OVHMT1 NAME,\.          ;EVALUATE "." AT THIS POINT IN TIME
TERMIN

;KLUDGE MACRO
DEFINE OVHMT1 NAME,POINT
OVHTAB [DEFINE OVHTAB FOO
FOO]    <(SIXBIT/NAME/)>,,POINT ? 0
TERMIN
TERMIN

;THIS IS THE CORRESPONDING REMOTE MACRO
DEFINE OVHTAB FOO
FOO
TERMIN
]               ;END OF IFN KL10P
\f
IFN KS10P,[

LOC EPTUIT+UBAQ
        UBAQIB          ; Pointer to interrupt table for Unibus Q (dsk)

LOC EPTUIT+UBAI
        UBAIIB          ; Pointer to interrupt table for Unibus I (other)

LOC EPTPFW
EPTPFW: 0               ; Page fail word
EPTPFO: 0               ; Page fail old PC
EPTPFN: PFAIL           ; Page fail new PC

IRP I,,[1,2,3,4,5,6,7]
LOC EPTP!I!W
EPTP!I!W:       0               ; Page fail word
EPTP!I!O:       0               ; Page fail old PC
EPTP!I!N:       PF!I!AIL        ; Page fail new PC at PI level I
TERMIN

LOC EPTTR1
EPTTR1: CAI             ;ARITH OVERFLOW EXEC MODE IGNORED
EPTTR2: JSR ILLTRP      ;PDL OVERFLOW EXEC MODE IS AN ERROR
EPTTR3: JSR ILLTRP      ;TRAP 3 SHOULD NOT HAPPEN

LOC EPT1PO
EPT1PO: 0               ;ONE-PROCEED OLD-PC
EPT1PN: MUUOEX          ;ONE-PROCEED SHOULD NOT HAPPEN IN UPT=EPT MODE

LOC EPTUEN
EPTUEN: MUUOEX          ;HALT IF UUO IN PROCESSOR BREAK ROUTINES
EPTUET: MUUOEX
LOC EPTUUN
EPTUUN: MUUOEX
EPTUUT: MUUOEX

IFN KSIMP,[
;Here because with EPT at 0, this is the second half of physical
; page 0, which is uncached, which we want, and otherwise unused.
;
LOC EPT+1000                    ; IMP data reformatting buffers
IMPIBF: BLOCK 400
IMPBFS==.-IMPIBF
IMPOBF: BLOCK 400
]

;OVHMTR MACRO IS USED TO CONSTRUCT TABLE OF AREAS OF EXEC CORE TO BE METERED
;ON KS10 PC SAMPLING FACILITY IS USED, 60-CYCLE CLOCK COLLECTS THAT DATA
;NOTE THAT THE TABLE FORMAT IS NOT THE SAME AS ON KL10, FOR SPEED REASONS

DEFINE OVHMTR NAME      ;NAME IS 3 CHARACTERS NAMING THE REGION THAT BEGINS HERE
OVHMT1 NAME,\.          ;EVALUATE "." AT THIS POINT IN TIME
TERMIN

;KLUDGE MACRO
DEFINE OVHMT1 NAME,POINT
OVHTAB [DEFINE OVHTAB FOO
FOO]    POINT,,<(SIXBIT/NAME/)>
TERMIN
TERMIN

;THIS IS THE CORRESPONDING REMOTE MACRO
DEFINE OVHTAB FOO
FOO
TERMIN
]               ;END OF IFN KS10P
\f
IFN DL10P,[     ;DL10 COMMUNICATIONS AREA IN NON-ENCACHED LOW CORE
IFN KL10P, LOC 500      ;500-777 RESERVED FOR DL10 AREA AND BUFFERS
IFN KA10P, LOC 100      ;IF KA10, PUT DL10 AREA JUST BELOW START OF SYSTEM
IFN KS10P, .ERR DL10 on KS10 system?

DL10AR: JSR TTYBRK      ;INTERRUPT INSTRUCTION (NOT ACTUALLY USED)

;FOLLOWING LOCATIONS MUST AGREE WITH IOELEVEN PROGRAM

DL10VR: NDLTYS_8+NFDLTY ;"I/O VERSION NUMBER"
DL10UP: 0               ;INCREMENTED BY -11 EVERY 1/60 SECOND.
                        ;SETOM'ED BY 10 EVERY 1/2 SECOND.  DETECTS UP/DOWNNESS.

DL10SO: 0               ;LINE # TO SET OUTPUT DONE FOR, SET BY -10, CLEARED BY -11.

DL10IL: 0               ;LINE # WITH INPUT AVAILABLE.  CLEARED BY -10 AFTER CHAR READ.
DL10IC: 0               ;CHARACTER RECEIVED FROM THAT LINE.

DL10OD: 0               ;LINE # WITH OUTPUT DONE.  CLEARED BY -10 WHEN PROCESSED.
DL10BS: 0               ;BUFFER SIZE FOR THAT LINE.

DL10BP: 0               ;WIERD DL10 BYTE POINTER TO TTY OUTPUT BUFFER.
DL10CC: 0               ;NUMBER OF CHARACTERS BEING OUTPUT TO TTY.
DL10LN: 0               ;LINE # OUTPUT BEING SENT TO.  CLEARED BY -11 WHEN GOBBLED.

DL10CL: 0               ;DIALUP LINE CONNECT OR DISCONNECT INFO. SET BY 11, 0'D BY 10.
                        ;0000NN => LINE # NN DISCONNECTED.
                        ;01RTNN => LINE # NN CONNECTED, %TTISP=R, %TTOSP=T.

DL10PL: 0               ;LINE # TO SET PARAMETERS OF.  CLEARED BY -11 WHEN PROCESSED.
DL10PR: 0               ;VALUE OF DH11 LPR REGISTER.
DL10PS: 0               ;NUMBER OF BYTES OF OUTPUT BUFFERING DESIRED.

DL10XD: 0               ;1=EXAMINE -11 CORE, 2=DEPOSIT.  CLEARED BY -11 WHEN DONE.
DL10XA: 0               ;EXAMINE/DEPOSIT ADDRESS
DL10XW: 0               ;EXAMINE/DEPOSIT WORD

GLPTBP: 0               ;BYTE POINTER TO BUFFER FOR GOULD LPT
GLPTBC: 0               ;BYTE COUNT " " - IF NONZERO BUFFER IS ACTIVE BY PDP11.
GLPTER: 0               ;NONZERO => PDP11 CLAIMS PRINTER IS BROKEN.
GLPGRF: 0               ;NONZERO => GRAPHICS MODE (SET BY 10).

;CHAOS NET SHARED VARIABLES
DLCINI: 1               ;THE COMMENTS ARE IN THE CHAOS FILE
DLCSP1: 0
DLCSP2: 0
DLCSS1: 0
DLCSS2: 0
DLCRP1: 0
DLCRP2: 0
DLCRS1: 0
DLCRS2: 0

;^ ADD MORE HERE

DLXEND:: ;END OF ASSIGNED DL10 AREA

IFG .-DL10AR-100, .ERR DL-10 AREA TOO BIG, CHANGE CONO IN TSS INITIALIZATION
LOC DL10AR+100 ;SKIP OVER 11-ACCESSIBLE AREA
        
DL10BF: BLOCK <261.+3>/4        ;OUTPUT BUFFER, 8-BIT BYTES.  HAS TO BE NON-ENCACHED.

IFN GLPTP,[
GLPBSZ==255.    ;BUFFER SIZE IN WORDS.  MAXIMUM POSSIBLE WITHOUT MODIFYING (ELIMINATING)
                ;"WORD COUNT" HARDWARE IN DL-10.
GLPMPP: 0       ;MAIN PROGRAM POINTER - IF NONZERO BUFFER IS ACTIVE BY M.P. LEVEL (PDP10)
GLPMPC: 0       ;MAIN PROGRAM COUNTER
GLPTBF: BLOCK GLPBSZ    ;ONE BUFFER FOR NOW
]       ;END IFN GLPTP

IFN KL10P, IFG .-1000,.ERR DL10 STORAGE TOO BIG, DOESN'T FIT IN UNENCACHED PAGE
IFN KA10P, PATB=.       ;MOVE ORIGIN OF SYSTEM UP
]       ;END IFN DL10P
\f
IFN NETYS,[     ;ASSEMBLE DTE20 CONTROL AREA
IFE KL10P, .ERR DTE20 WITHOUT KL10?
LOC 400

DTEVER: NETYS_8+NFETY   ;400 I/O VERSION NUMBER, SET BY 10, CHECKED BY 11

DTECHK: 0               ;401 INCREMENTED BY 11 60 TIMES PER SECOND
                        ;SETOMED BY 10 EVERY HALF SECOND.
                        ;USED TO TELL 11 THAT 10 IS UP.

DTEINP: -1              ;402 -1 IF IDLE, ELSE INPUT REQUEST FROM 10 TO 11
                        ;SETUP DTEBPI IN EPT AND DO DATAO DTE, BEFORE SETTING THIS.
                        ;SEE COMMENTS BELOW DTEOUT FOR WHAT GOES HERE
DTEOUT: -1              ;403 -1 IF IDLE, ELSE OUTPUT REQUEST FROM 10 TO 11
                        ;SETUP DTEBPO IN EPT BEFORE SETTING THIS.
                ;CONTENTS OF DTEINP AND DTEOUT ARE DESCRIBED BELOW.
                ;THESE ARE SET BY THE 10, SETOMED BY 11 WHEN TRANSFER STARTS.
                ;RH # BYTES EXPECTED.  LH COMMAND+LINE#.  COMMANDS ARE:
 %DCTYO==1000           ;TELETYPE OUTPUT                (NOTE 4.1=0 INPUT, =1 OUTPUT)
 %DCETI==2000           ;ETHERNET INPUT (N.Y.I.)
 %DCETO==3000           ;ETHERNET OUTPUT (N.Y.I.)

DTELSP: -1              ;404 LINE # WHOSE SPEED IS TO BE SET, SET BY 10, SETOMED BY 11
DTELPR: -1              ;405 CORRESPONDING DH11 LINE PARAMETER REGISTER,,BUFFER SIZE

DTEOST: -1              ;406 LINE# TO START OUTPUT ON (SET OUTPUT DONE).
                        ;SET BY 10, SETOMED BY 11

        BLOCK 1         ;407 NOT USED

DTETYI: -1              ;410 TELETYPE INPUT.  SET BY 11, SETOMED BY 10.
                        ;LH LINE#,,RH CHAR RCVED.

DTEODN: -1              ;411 TELETYPE OUTPUT DONE.  SET BY 11, SETOMED BY 10.
                        ;LH LINE#,,RH BUFFER SIZE.

DTEHNG: -1              ;412 HANGUP/DIALIN WORD.  SET BY 11, SETOMED BY 10.
                        ;0000NN LINE # NN HUNG UP.
                        ;01RTNN LINE # NN HAS SPEED RCV=R, XMT=T (CODES AS IN TTYTYP)

;^ ADD MORE LOCATIONS HERE, NOT TO EXCEED 437

;LOCATIONS 440-457 ARE KNOWN ABOUT BY BOTH IOELEV AND KLDCP,
;USED MOSTLY FOR NON-TIMESHARING PROGRAMS.
];NETYS
\f
LOC PATB

        ;FOR VARIABLES (MONITORABLE WITH KEYS)
NSKED:  0       ;# TIMES NON-NULL JOB IS RUN
NNSKED: 0       ;# TIMES NULL JOB IS RUN
NRSKED: 0       ;# OF FULL SCHEDULES (MUST SCAN ALL JOBS)
NSSKED: 0       ;# OF SCHEDULES SAVED BY SCHBLN FEATURE.
NRESKED:0       ;# TIMES A JOB SCHEDULED JUST AFTER IT RAN.
NSCHDU: 0       ;TOTAL NUMBER OF JOBS FOUND RUNNABLE IN FULL SCHEDULES
NNULBK: 0       ;# OF CONSECUTIVE BLOCKS OF NULLTIME.
NUINT:  0       ;# TIMES USER GIVEN INTERRUPT
NAUINT: 0       ;# ATTEMPTED USER INT (POSSIBLY UNSUCCESSFUL DUE TO PG FAULT)
NPCLSR: 0       ;# ATT TO PCLSR
NEPCLS: 0       ;# PCLSRS WHERE JOB WAS IN EXEC MODE
NFPCLS: 0       ;# OF PCLSRS THAT FAILED (JOB WAS IN EXEC MODE AND NOT BLOCKED)
NSOUSR: 0       ;# ATT TO SWAP OUT USR
NSOPGS: 0       ;# TIMES THRU LOOP LOOKING FOR PG TO SWAP OUT
NPGSO:  0       ;# TIMES AT SWOPG
NAGEAB: 0       ;# TIMES SWAP OUT ABORTED BY AGE BITS
NSHRAB: 0       ;# TIMES SWAP OUT ABORTED BY SHARING
NPGFLT: 0       ;# PAGE FAULT (ALL CAUSES)
NCLKI:  0       ;# CHNL 7 INTS (ALL CAUSES)
NPGLD:  0       ;# TIMES AT PGLDU
NUFLS:  0       ;# TIMES AT UFLS
NTUSB:  0       ;# TIMES USER SWAP BLOCKED
NTSBUP: 0       ;# TIMES SWAP BLOCKED USER TOOK PAGE FAULT AND LET IN
NTSBUB: 0       ;# TIMES SWAP BLOCKED USER TOOK PAGE FAULT AND BLOCKED
NTSBUU: 0       ;# TIMES SWAP BLOCKED USER UNBLOCKED BEFORE TIME (MEM APPARENTLY AVAIL)
NAGES:  0       ;# TIMES AROUND PAGE-AGEING LOOP

;THE FOLLOWING FOUR MUST BE CONSECUTIVE
NRPI:   0       ;# REFS TO PAGE IN (BUT MAP WAS NOT SET UP, ETC)
NRPCI:  0       ;# PAGE FAULTS REFS TO PAGE COMMING IN
NRPO:   0       ;# REFS TO PAGE OUT
NRPGO:  0       ;# TO PAGES GOING OUT
CLKBRS: 0       ;CLKBRK COPIED INTO HERE (SINCE CLKBRK GETS CHANGED)

PAT:    IFG .-PATB-40,.ERR PAT TOO HIGH

LOC PATB+40

BBLK

PATCH:  BLOCK 140       ;PATCH SPACE CODE AND CONSTANTS

EBLK

VPATCH:
VPAT:
BLOCK 40        ;PATCH SPACE VARIABLES
\f
SUBTTL PROCESSOR BREAK ROUTINES

DEFINE CLKSAV BRK=CLKBRK
IFE KA10P,      XCT CLCXSV      ;DATAI PAG,CLCX(U)
        XCT CLUSAV              ;STORE U IN AC17S FOR CURRENT USER (UNLESS NULL JOB)
        MOVE U,BRK              ;SAVE AWAY BRK
        MOVEM U,CLKBRS
IFSN BRK,CLKBRK, MOVEM U,CLKBRK ;SAVE IN CLKBRK IF NOT CLKBRK
TERMIN

IFE KA10P,[
DEFINE CLKLEV                   ;ENTER CLOCK-LEVEL CONTEXT
        SPCCTX 0,1,EPT          ;UPT = EPT; CLOCK LEVEL CONTEXT.
        MOVE U,USER
        JRST 2,@.+1             ;MAKE XCTR WORK RIGHT
          %PSPCU,,.+1
        MOVE P,CPDLP
TERMIN
] ;IFE KA10P
IFN KA10P,[
DEFINE CLKLEV
        MOVE U,USER
        MOVE P,CPDLP
TERMIN
] ;IFN KA10P

IFN KL10P,[     ;CODE USED IF GETTING 60-CYCLE CLOCK FROM PDP11 (IN CASE MAIN CLOCK DOWN)

;HACKING THE DTE:

;THE TTY CODE ASSUMES, SINCE THE DTE20 IS USED BY ITS SOLELY AS
;THE INTERFACE TO THE CONSOLE TTY AND THE LINE-FREQUENCY CLOCK,
;THAT IT MAY FREELY GIVE THE "MONITOR TTY OUTPUT" COMMAND WHEN
;THE "MONITOR TTY OUTPUT DONE" INTERRUPT IS RECEIVED.  ANY CODE
;WHICH HACKS THE DTE OTHER THAN AT PI LEVEL OR IN ITS INITIALIZATION
;MUST THEREFORE OBSERVE THE FOLLOWING PROTOCOL:
;       CONO PI,DTEOFF
;       SKIPN DTEFLG            ;WAIT FOR MONITOR TTY OUTPUT TO GO THROUGH
;        JRST .-1
;       SETZM DTEFLG
;        ;HERE SET DTECMD
;       CONO DTE,%DBL11
;       SKIPN DTEFLG            ;WAIT FOR THIS COMMAND TO GO THROUGH
;        JRST .-1
;       CONO PI,DTEON
;

DTEBRK: 0
BBLK
        CONSO PI,1_<7-APRCHN>   ;TEMPORARY (I HOPE) HARDWARE BUG IN KL10 PI HARDWARE
         JRST 4,.               ;ALLEGEDLY FIXED
        CONO PI,TTYRQ           ;REALLY WANTED TO INTERRUPT ON TTY CHANNEL,
        JFCL                    ; BUT HAVE TO DO IT THIS WAY DUE TO 
        JFCL                    ; MISFEATURES IN THE PI HARDWARE
        SKIPN DTECLK            ;DON'T TAKE OUT THE JFCLS!!
         JRST 12,@DTEBRK
        CLKSAV DTEBRK           ;TAKE CLOCK INTERRUPT
        JRST CLKB2A
EBLK
];KL10P
\f
CLKBRK: 0               ;PC SAVED HERE BY JSR FOR CLOCK INT.

BBLK
IFN KL10P,[
        CONSO PI,1_<7-APRCHN>   ;HARDWARE BUG IN KL10 PI SYSTEM
         JRST 4,.               ;ALLEGEDLY FIXED
]
IFE KA10P, CONO PI,020000+200_<-APRCHN> ;BAG-BITING DEC LOSERS CHANGED
                                        ;FUNCTIONAL SPECIFICATION OF
                                        ;PROGRAMMED REQUESTS
CLKBR2: CLKSAV          ;SAVE AC BLK STATUS AND U.
CLKB2A: AOS NCLKI
        SKIPGE U,USER   ;PICK UP INDEX OF CURRENT USER, SKIP UNLESS NULL JOB
         JRST [ SPM UPGML       ;JUMP IF NULL JOB WAS RUNNING
                JRST CLKBKR ]
        SPM UPGML(U)    ;STORE PAGE MAP AWAY
        AOSN UFLSF      ;SKIP UNLESS GOT HERE FROM UFL6
         JRST CLUFLS
        MOVEM T,AC16S(U)        ;STORE AWAY T
        MOVEI T,AC0S(U)
        BLT T,AC15S(U)  ;STORE REST OF ACS
CLKBKR: CLKLEV          ;SET UP CROCK-LEVEL CONTEXT HARDWARE

;;; CHECK FOR THINGS OTHER THAN CLOCK TICKS (PAR ERR, PG FAULT, NXM, PDLOV,
;;; AROV AND ARFOV ARE POSSIBLE ON ONE MACHINE OR THE OTHER).

IFN KA10P,[
        CONSZ 270220    ;CHECK PDL OV, MEM PROTECT, NXM, FOV, AR OV
         JRST CLKB1     ;JUMP ON LOSSAGE
CLKB1D: CONSZ PI,200000
         JRST CLKB1E    ;PARITY
] ;KA10P

IFN KL10P,[
        AOSG PFAILF
         JRST PFA6      ;PAGE FAULT
        CONSZ 7740      ;This is all but the cache sweep done bit (=20).
         JRST CLKB2     ;APR ERROR INTERRUPT
] ;KL10P

IFN KS10P,[
        AOSG PFAILF
         JRST PFLU2
        CONSZ 7620      ;This is all but the interval timer's bit (=40).
         JRST CLKBKS    ; (Memory ECC (=100) doesn't interrupt)
        CONSO 40
         JRST CLK1F
] ;KS10P

IFN PDCLKP\KA10P,[      ;IF 60 HZ CLOCK IS IN HARDWARE
        CONSO CLK,CLKINT
         JRST CLK1F     ;INTERRUPT NOT FROM CLOCK, MUST BE SPURIOUS (OR
                        ;PREEMPT) 
] ;PDCLKP\KA10P

;DROP THROUGH FOR PLAIN CLOCK-TICK.
\f;
; 60-CYCLE CLOCK INTERRUPT
;
CLKTIC:
;IFN 340P,      DATAI CLK1,LQTIM
        SOSG @CLROOT    ;COUNT DOWN, SKIP IF NOT YET TO NEXT REQUEST
         JRST CLQBRK    ;SERVICE CLOCK QUEUE REQUEST
CLQBRT:
IFN KS10P,              CONO 020040+APRCHN      ;Clear interval flag
IFN PDCLKP\KA10P,       CONO CLK,CLKINT+APRCHN  ;Clear hardware clock flag
IFE PDCLKP\KA10P\KS10P, SETZM DTECLK            ;Clear software clock flag
IFN KA10P,[
        DATAI CLKBSW
        SKIPGE CLKBSW
] ;KA10P
IFN KL10P, SKIPGE DTESWR
IFN KS10P, SKIPE 8SWIT0
         BUG DDT,[SWITCH 0 IS UP]
IFN KS10P, SETZM 8SWIT0         ; Allow hacker to <alt>P
IFN CHAOSP, IFN T11CHP, PUSHJ P,T11WAK  ;RUN TEN-11 CHAOS NET INTERFACE
IFN XGP,[
        SKIPL XGPUSR
         PUSHJ P,XGPCLK
]
IFN 340P,[
        AOSGE T,DTIME
         JRST DSTPD     ;WAIT IF DTIME CLOBERED DUE TO RATE EXCEEDED
        CAILE T,2
         MOVEI T,2
        MOVEM T,DTIME
        SKIPL CDISOF
         SKIPGE DISOFF
          JRST DSTPD
        AOSG DISON
         CONO DIS,1100\SDCHN_3\DISCHN   ;RESTART DISPLAY
DSTPD:
]
IFN E.SP,[
        SKIPN T,E.SPGW  ; E&S WAITING FOR PAGE
         JRST E.SOK
        HRRZM T,DISSPG  ; SAVE FOR SWPPIN
        SKIPL T,DISUSR  ; -1 IMPLIES NO USER
         MOVEM T,DISSWI ; USER INDEX FOR SWPPIN
E.SOK:
]
IFN N11TYS,[
        SKIPE @TT11HD   ;ANY INPUT FROM PDP11?
         PUSHJ P,TT11IN ;YES, DO INPUT INT LVL STUFF FOR IT,.
]
IFN DZ11P,[
        PUSHJ P,DZSCAN  ;SCAN DZ'S FOR INPUT
]
        MOVS T,TTERQS
        CAIE T,(MOVE)
         PUSHJ P,TTECH  ;CHARACTERS TO BE ECHO ED
IFN NETP,[
        SKIPE STYNTA    ;IF THERE ARE STY'S CONNECTED TO NETWORK I/O,
         PUSHJ P,STYNTC ;XFER BETWEEN THEM.
]
IFN KS10P, PUSHJ P,OVHCLK
        SETCMM CLKFL1
        SKIPL CLKFL1
         AOS TIME       ;GET HERE EVERY THIRTIETH OF A SECOND
IFN PAGPRE,[
        SKIPE PREEMP    ;CHECK FOR PRE-EMPTION INTERRUPT
         JRST PRESCD
];PAGPRE
        AOSG SCHFLG
         JRST CLKB5     ;TIME NOT UP
        AOS NLPCLK
        JRST SCHED      ;SCHEDULE

CLK1F:
IFN PAGPRE,[
        SKIPE PREEMP    ;CHECK FOR PRE-EMPTION INTERRUPT.  THIS IS HERE
         JRST PRESCD    ; BECAUSE OF SCREW CASE WHEREBY DLSRCH PREVENTS
                        ; PREEMP FROM DOING ANYTHING, AND PREEMP WOULD
                        ; PREVENT CLOCK FLAG FROM GETTING CLEARED IF IT WAS
                        ; TESTED BEFORE CLOCK.
];PAGPRE
;       MOVEI J,APRCHN  ;DO NOT TAKE THESE OUT WITHOUT SEEING RG!!!!
;       JSP E,SPUR
;       JRST SCHED
        AOS CHSPUR+APRCHN       ;COUNT SPURIOUS INT
        JRST SCHED              ;(MIGHT HAVE BEEN RUNNING NULL JOB)

IFN PAGPRE,[
PRESCD: AOS NLPPRE
        JRST SCHED
];PAGPRE

IFN KL10P,[
CLKB2:  CONSZ 2000              ;NXM
         PUSHJ P,MEMHNG
        CONSZ 1040              ;POWER FAIL OR I/O PAGE FAIL
         BUG HALT,[KL: POWER FAIL OR I/O PAGE FAIL]
        CONSZ 300               ;CACHE DIR OR PT DIR PAR ERR.
         BUG HALT,[KL: CACHE OR MAP DIR PAR ERR]
        CONSO 4400              ;SBUS ERR OR MB PAR ERR
         JRST SCHED             ;CALLED MEMHNG, AND NOTHING ELSE => SCHEDULE.
        SETOM PARRSN            ;TEL PAR ERR SCANNER THIS IS AN INTERRUPT, NOT A PG FAIL.
        RDERA PARERA            ;STORE ADDR OF PAR ERR.
        JRST CLKB1E
] ;IFN KL10P

IFN KS10P,[
CLKBKS: CONSZ 7600      ; Any bad guys? (8080 -> KS is 20, Interval is 40,
         JRST CLKKS1    ; Memory ECC is 100.)
        CONO 020020+APRCHN      ; 8080 wants service.  Clear the bit.
        MOVEI I,NFKSTY          ; TTY # (fancy name for 0)
        CONO PI,TTYOFF          ; Pretend this is TTY interrupt level.
        SKIPN A,8CTYIN          ; Any input from 8080?
         JRST CLKKS2
        SETZM 8CTYIN            ; Yes:  Make room for more.
        PUSHJ P,NTYI1           ; Stuff it into the tty.
        MOVEI I,NFKSTY          ; Just in case...
CLKKS2: SKIPN 8CTYOT            ; Room for output yet?
         PUSHJ P,TYPSC          ; Yes:  Get some now.
        CONO PI,TTYON           ; No:  8080 will wake us up later.
        JRST SCHED              ; Null job might have been running.

CLKKS1: CONSZ 1000              ;Power failure
         BUG HALT,[KS: POWER FAIL]
        CONSZ 6000              ;KS -> 8080 or Flag 24
         BUG HALT,[KS: KS->8080 FLAG OR FLAG 24 SET]
        CONSZ 400               ;NXM
         PUSHJ P,MEMHNG
        CONSO 200               ;Bad memory data
         JRST SCHED
        IORD B,[KSECCS]
        MOVEM B,PARERA
        JRST CLKB1E

] ;IFN KS10P
\f
CLUFLS: CONO PI,CLKON   ;FROM UFLS
        CLKLEV
        MOVE T,UPC(U)
        MOVEM T,CLKBRK
        AOS NUFLS
        AOS NLPUFL
        JRST SCHED2

        ;CLOCK QUEUE SERVICE
CLQBRK: SKIPG U,CLROOT  ;GET POINTER TO CURRENT BLOCK
         BUG            ;CLK QUEUE SCREWED
        SKIPG T,1(U)    ;GET POINTER TO NEXT BLOCK
         BUG            ;CLK QUEUE SCREWED
        MOVEM T,CLROOT  ;SET UP POINTER FOR NEXT BLOCK
        SETOM 1(U)      ;INDICATE CURRENT BLOCK IDLE
        XCT 2(U)        ;EXECUTE REQUEST (PROBABLY A JRST)
                ;FALL THROUGH IF SINGLE INST RQ
CLQRET:         ;RETURN FROM REQUEST
        SKIPN @CLROOT   ;SKIP IF TIME TILL NEXT RQ NONZERO
        JRST CLQBRK     ;ZERO TIME DELTA, DO NEXT RQ
        JRST CLQBRT     ;RETURN TO CLOCK ROUTINE

CLQTTR: JUMPE TT,CLQRET ;COMMON RETURN FOR TT IDLE FLAG
CLQREE: MOVEI E,CLQRET  ;RE ENTER RQ

;CLOCK OFF OR IN PROGRESS LEVEL ADD TO CLOCK QUEUE, CALL BY JSP E,
        ; T HAS TIME TILL RQ IN 60'THS
        ; C POINTS TO THREE WORD BLOCK, RQ'ED INST IS IN THIRD
CLQPUT: MOVEI B,CLROOT-1
CLQPU2: MOVE A,B        ;REPLACE POINTER TO PREV BLOCK WITH CURRENT
        SKIPG B,1(B)    ;GET LINK TO NEXT BLOCK
         BUG            ;CLK QUEUE SCREWED
        SUB T,(B)       ;SUBTRACT TIME DELTA FOR NEXT BLOCK
        JUMPG T,CLQPU2  ;JUMP IF RQ LATER THAN CURRENT BLOCK
        JUMPE T,CLQPU6  ;JUMP IF RQ SAME AS " " (COULD USE PU2 BUT THIS FASTER)
        ADD T,(B)       ;RQ EARLIER, ADD BACK
        MOVEM T,(C)     ;SET DELTA OF BLOCK BEING ADDED
        SUB T,(B)       ;COMPUTE NEG OF DELTA FOR NEXT BLOCK
        MOVNM T,(B)     ;SET TIME DELTA FOR NEXT BLOCK
        MOVEM B,1(C)    ;SET LINK OF NEW BLOCK TO NEXT
        MOVEM C,1(A)    ;SET LINK OF PREV BLOCK TO NEW
        JRST (E)

CLQPU6: SETZM (C)       ;SET TIME DELTA OF NEW BLOCK TO ZERO
        MOVE A,1(B)     ;GET POINTER TO NEXT BLOCK
        MOVEM A,1(C)    ;SET POINTER OF NEW TO NEXT BLOCK
        MOVEM C,1(B)    ;SET POINT OF CURRENT TO NEW BLOCK
        JRST (E)
\f
;MAIN PROG LEVEL ADD TO CLOCK QUEUE
;CALL BY PUSHJ P,CLQADD
;WITH POINTER TO BLOCK IN NEXT WORD AND TIME TILL RQ IN T IN 60'THS
;POINTER TO BLOCK SHOULD NOT BE INDEXED BY C

CLQAD1: MOVEI T,1       ;RQ IN ONE TICK
CLQADD: PUSH P,C
        MOVE C,@-1(P)   ;GET BLOCK POINTER
        MOVEI C,@C
        SKIPL 1(C)      ;SKIP IF IDLE
        JRST POPCJ1     ;IGNORE THIS RQ, BLOCK ALREADY ACTIVE
        PUSH P,A
        PUSH P,B
        PUSH P,E
        SKIPN (C)       ;DELTA WORD OF IDLE BLOCK SHOULD BE ZERO
        SKIPG T         ;TIME SHOULD BE NON-ZERO
         BUG            ;CLK QUEUE SCREWED
        CONO PI,CLKOFF
        JSP E,CLQPUT    ;ADD RQ
CLQDE4: CONO PI,CLKON
        POP P,E
        POP P,B
        POP P,A
        JRST POPCJ1

;DELETE CLOCK QUEUE ENTRY
;CALL BY PUSHJ P,CLQDEL WITH POINTER TO BLOCK IN NEXT WORD
CLQDEL: PUSH P,C
        MOVE C,@-1(P)   ;GET BLOCK POINTER
        MOVEI C,@C
        CONO PI,CLKOFF
        SKIPGE 1(C)     ;IGNORE RQ TO DELETE  IF IDLE
        JRST CKOCJ1
        PUSH P,A
        PUSH P,B
        PUSH P,E
        JSP E,CLQCLR
        JRST CLQDE4

CLQCLR: MOVEI B,CLROOT-1        ;CLOCK OFF OR IN PROGRESS VERSION
CLQDE2: MOVE A,B
        SKIPG B,1(B)    ;GET POINTER TO NEXT BLOCK
         BUG            ;CLK QUEUE SCREWED
        CAME B,C        ;SKIP IF FOUND BLOCK TO DELETE
         JRST CLQDE2
        SKIPG B,1(B)    ;GET POINTER TO BLOCK AFTER ONE TO DELETE
         BUG            ;CLK QUEUE SCREWED
        MOVEM B,1(A)    ;PATCH AROUND DELETED BLOCK
        MOVE A,(C)
        ADDM A,(B)      ;ADD DELTA OF DELETED BLOCK TO NEXT
        SETZM (C)       ;CLEAR DEL
        SETOM 1(C)      ;MARK IDLE
        JRST (E)
\f
OVHMTR PGF      ;PAGE FAULT

IFN KL10P,[
EBLK
PFAILU: 0       ;SAVED U AS OF A PAGE FAILURE
PFINST: 0       ;PF INSTRUCTION IF XCT
PFOPC1: 0       ;SAVE PFOPC WHILE SWITCHING TO CLK LEVEL (PROTECT AGAINST XCTRI)
BBLK

;PAGE FAULTS COME HERE, WITH PC IN PFOPC, AND PI SYSTEM TURNED OFF.

PFAIL:  MOVEM U,PFAILU
        HLRZ U,EPTPFW
        ANDI U,%PFCOD   ;GET THE PFAIL CODE FROM THE PFW
        CAIE U,%PFPAR
         CAIN U,%PFPRX
          JRST PFA2     ;IT'S A PAR ERR; BYPASS XCTR HACKS
        MOVE U,PFOPC
        TLNE U,%PCUSR
         JRST PFA2
        LDB U,[331100,,(U)]     ;GET OPCODE OF LOSING INSTRUCTION.
                                ;ASSUME THAT IN EXEC MODE VIRTUAL
                                ; AND PHYSICAL ADDRESSES ARE IDENTICAL
                                ; FOR INSTRUCTION FETCHES.  ALSO ASSUME
                                ; THAT NOBODY DOES XCT OF XCT OF XCTR.
PFA4:   CAIE U,XCTRI_-33        ;SKIP IF "XCTR WITH INHIBIT"
         JRST PFA1
REPEAT 2, AOS PFOPC             ;ONCE COMPENSATING FOR INSTR ABORT, AND ONCE TO SKIP
        MOVE U,PFAILU
        JRST 17,@PFOPC          ;KL-10 CROCK: JRST 17, TURNS ON PI SYSTEM

PFA1:   CAIE U,XCTR_-33         ;SKIP IF "XCTR WITH NO INHIBIT"
         JRST PFA3
PFA2:   CONSO PI,77400          ;PI IN PROGRESS?
         CONSO PI,1             ;CHANNEL 7 ENABLED?
          BUG AWFUL,[PAGE FAULT WITH PI IN PROGRESS OR CLKOFF]
        SKIPGE USER
         BUG AWFUL,[PAGE FAULT IN NULL JOB]
        MOVE U,PFOPC
        MOVEM U,PFOPC1
        MOVE U,PFAILU           ;RESTORE U SO CLKSAV CAN RE-SAVE IT
TPFLT1: SETOM PFAILF
        CONO PI,CLKRQ           ;CAUSE CLK BREAK AND PI SYSTEM ON
        JRST .                  ;TAKES A WHILE TO GO OFF

;COME BACK HERE PI IN PROGRESS ON CLK CHANNEL
PFA6:   MOVE T,PFOPC1
        MOVEM T,CLKBRK          ;SAVE PC AS OF PAGE FAULT AS PLACE INTERRUPTED FROM
        AOSN PFAILF             ;IF INTERRUPTED FROM INTPFL,
         JRST PFA9              ; PC DOESN'T POINT TO FAULTING INSTRUCTION
        TLNE T,%PSUSR           ;MAYBE SPURIOUS MPV ON IOT IN USER MODE?
         TLNE T,%PSUIO
          JRST PFA9             ;CAN'T BE, I/O IS LEGAL
        HLRZ TT,UPFW(U)         
        ANDI TT,%PFCOD
        CAIE TT,%PFPNA          ;CAN'T BE IF PAGE FAULT IS REALLY SOME OTHER RANDOM BREAK
         CAIN TT,%PFILW         ;SUCH AS A PARITY ERROR
          JRST PFA11
PFA9:
;       MOVE T,PFOPC
;       MOVEM T,UPOPC(U)        ;SOLELY FOR THE .OPC USER VARIABLE
        LDB E,[$PFPNO,,UPFW(U)] ;FAILING PAGE NO
        HLRZ D,UPFW(U)
        ANDI D,%PFCOD           ;GET THE PAGE-FAULT CODE.
        MOVEI A,0               ;INIT USER INT BITS
        CAIE D,%PFPNA
        CAIN D,%PFILW
         JRST PFA5              ;REAL PAGE FAULT OR RWF
        CAIN D,%PFMAR
         JRST PFA7A
        CAIN D,%PFPRO
         JRST PFA7              ;OTHER RANDOM BREAKS
        CAIE D,%PFPAR
        CAIN D,%PFPRX
         JRST PFA14             ;PARITY ERROR
        MOVSI D,SCLBPF          ;UNKNOWN PFW, GET SYSTEM JOB TO BARF ABOUT IT
        TDNE D,SUPCOR
         BUG PAUSE,[BAD PAGE FAIL WORD ],OCT,BPFPFW     ;LOSING IN REAL TIME
        IORM D,SUPCOR
        AOS BPFERR
        MOVEM U,BPFUSR
        MOVE D,UPFW(U)
        MOVEM D,BPFPFW
        MOVE D,CLKBRK
        MOVEM D,BPFPC
        JRST SCHED              ;IGNORE THE FAULT (BUT DO A FULL SCHEDULE SO SYS JOB WAKES)

PFA14:  SETZM PARRSN            ;SAY THIS IS PAR ERR TRAP, NOT PAR ERR INTERRUPT.
        MOVE D,UPFW(U)
        MOVEM D,PARPFW          ;SAVE PFW OF PAR ERR FOR ERROR MESSAGE
        AC7CTX                  ;SELECT AC BLOCK 7, USED BY UCODE.
        UMOVE D,0               ;SAVE THE AC THAT HOLDS THE BAD WORD
        MOVEM D,PARWRD
        SYSCTX                  ;AND RESET THE DATAO PAG TO NORMAL VALUE
        JRST CLKB1E             ;GO SCAN FOR THE ERROR.

PFA3:   CAIE U,XCT_-33
         BUG HALT,[PAGE FAULT IN SYSTEM AT ],OCT,PFOPC  ;BARF!
        MOVE U,@PFOPC           ;QUUX! LET ONE LEVEL OF XCT WIN
        MOVEM U,PFINST
        MOVE U,PFAILU
        LDB U,[331100,,@PFINST]
        JRST PFA4

PFA11:  XCTRI XR,[MOVE T,(T)]   ;GET INSTRUCTION IN WHICH PAGE FAIL OCCURRED
         TLCA T,700000          ;AND CHECK HIGH THREE BITS OF OPCODE
          JRST PFA9             ;JUMP IF FAULT WAS ON INSTRUCTION FETCH
        TLCE T,700000
         JRST PFA12             ;JUMP IF INSTRUCTION NOT AN IOT
PFA13:  MOVSI TT,(HRRI T,)
        DPB T,[2700,,TT]
        XCTRI XEA,TT            ;COMPUTE ITS EFFECTIVE ADDRESS
         TLZA T,37              ;CLEAR @+XR, BUT LEAVE OPCODE AND AC
          JRST PFA9             ;JUMP IF FAULT ON INDIRECT WORD
        MOVEM T,MUUODP(U)       ;IT WAS A SPURIOUS MPV, SO
        MOVE T,CLKBRK           ; SIMULATE TRAPPING AS A UUO
        HRRI T,1(T)
        MOVEM T,XUUOH(U)        ;STORE OLD PC
        MOVE T,CLCX(U)
        MOVEM T,MUUOCX(U)       ;AND OLD CONTEXT
        MOVE T,MUUOCN(U)
        MOVEM T,CLKBRK          ;GET NEW PC
        JRST CLKB5              ;AND RESTART USER AT UUOH0

PFA12:  TLNN T,700000           ;MAYBE AN INSTRUCTION OVERLAYED ON AN MUUO, E.G. LPMR
         TLNN T,040000          ;OPCODES 040-077 QUALIFY.
          TLCA T,(XCT)
           JRST PFA13           ;YUP.
        TLNE T,777000           ;SKIP IF OPCODE WAS XCT
         JRST PFA9
;       TLZ T,777740
;       TLO T,(MOVEI T,)
;Following instruction is suspected of not working (sometimes using wrong AC block)
;       XCTRI XEA,T             ;COMP EFFECTIVE ADDRESS OF XCT IN USER CONTEXT
;;       JRST PFA11             ;AND GO PROCESS INSTRUCTION AT THAT ADDRESS
;        JRST [ MOVEM T,TRMNAM(U)       ;TEMPORARY FOR DEBUGGING
;               JRST PFA11 ]
;       JRST PFA9               ;HERE IF FAULT WAS IN INDIRECT CYCLE
;Replacement code:
PFA15:  DATAI PAG,TT            ;HMM, SEE IF WRONG AC BLOCK SELECTED
        TLNN TT,100
         BUG
        LDB TT,[220400,,T]      ;CHECK FOR NEED TO SIMULATE INDEXING
        JUMPE TT,PFA16
        UMOVE TT,(TT)
        ADD TT,T
        HRR T,TT
PFA16:  TLNN T,(@)              ;CHECK FOR NEED TO SIMULATE INDIRECT
         JRST PFA11
        XCTRI XR,[MOVE T,(T)]
         JRST PFA15             ;PROCESS INDIRECT WORD
        JRST PFA9               ;TAKE FAULT ON INDIRECT WORD
;End replacement code.
];KL10P
\f
IFN KS10P,[

EBLK

IRP I,,[1,2,3,4,5,6,7]
PF!I!SVU:       0       ;Saved U at PI level I page fail
PF!I!SVT:       0       ;Saved T at PI level I page fail
PF!I!INS:       0       ;Instruction at PI level I page fail
TERMIN
IFN .-PF1SVU-21., .ERR Wrong length PFXSVU block.

BBLK

IRP I,,[1,2,3,4,5,6,7]
PF!I!AIL:       ;;PI level I page fail comes here.
        MOVEM T,PF!I!SVT        ;Save T
        MOVEM U,PF!I!SVU        ;Save U
        JSP U,PIFAIL            ;Set up U and join common code
TERMIN
IFN .-PF1AIL-21., .ERR Wrong length PFXAIL block.
PFXSVT==:0,,<PF7SVT-<PF7AIL+3>>
PFXINS==:0,,<PF7INS-<PF7AIL+3>>
PFXWRD==:0,,<EPTP7W-<PF7AIL+3>>
PFXOPC==:0,,<EPTP7O-<PF7AIL+3>>

PIFAIL: MOVE T,PFXWRD(U)        ;Check page fail word
        TLNE T,%PFNXI
         BUG AWFUL,[NON-EX IO REG WITH PI IN PROGRESS ],OCT,PFXWRD(U),[PC=],OCT,PFXOPC(U)
        TLNE T,%PFNXM\%PFPAR
         BUG AWFUL,[NXM OR PARITY ERROR WITH PI IN PROGRESS]
        MOVE T,PFXOPC(U)        ;Check for user mode.
        TLNE T,%PSUSR
         BUG AWFUL,[PAGE FAULT IN USER MODE WITH PI IN PROGRESS]
        SKIPA T,(T)             ;We assume that it wasn't the instruction
                                ;fetch itself that caused the fault.
PIFL2:   MOVEI U,PF7AIL-PF7XCT(U)       ;Correct U on return from PFXXCT
        MOVEM T,PFXINS(U)       ;Save instruction that caused fault
        LSH T,-33               ;Look at opcode
        CAIE T,XCTRI_-33        ;XCTRI gets special treatment:
         JRST PIFL1
REPEAT 2, AOS PFXOPC(U)         ;Arrange for it to skip.
        JRST PFXRET(U)          ;And return.

IRP I,,[1,2,3,4,5,6,7]
PF!I!RET:
        MOVE T,PF!I!SVT         ;Restore T
        MOVE U,PF!I!SVU         ;Restore U
        JRST 2,@EPTP!I!O        ;Return
TERMIN
IFN .-PF1RET-21., .ERR Wrong length PFXRET block.
PFXRET==:0,,<PF7RET-<PF7AIL+3>>

;;;Let XCT chains that end in XCTRI win.  We assume that none of the
;;;fetches along the way to the XCTRI itself caused the fault.
PIFL1:  CAIE T,XCT_-33
         BUG AWFUL,[PAGE FAULT WITH PI IN PROGRESS]
        MOVE T,PFXSVT(U)        ;Restore T
        JRST PFXXCT(U)          ;Go pick up word XCT'ed

IRP I,,[1,2,3,4,5,6,7]
PF!I!XCT:
        MOVE U,PF!I!SVU         ;Restore U
        MOVE T,@PF!I!INS        ;Pick up XCTed instruction
        JSP U,PIFL2             ;Set up U again and rejoin common code
TERMIN
IFN .-PF1XCT-21., .ERR Wrong length PFXXCT block.
PFXXCT==:0,,<PF7XCT-<PF7AIL+3>>
\f
EBLK

PFLCLK: 0       ; Did page fault happen with CLKOFF?
PFLSVU: 0       ; Saved U during page fail
PFLSVT: 0       ; Saved T during page fail
PFLINS: 0       ; Faulting instruction

BBLK

;;; Note!
;;; If we are swapped out while running with Exec mode PC between PFAIL and
;;; PFAILE inclusive, EPTPFO is saved as our PC.  (There are actually only
;;; a few PC's for which this is possible given that we mostly run CLKOFF.)

PFAIL:  SETZM PFLCLK
        CONSO PI,1
         SETOM PFLCLK
        CONO PI,CLKOFF          ; Don't bother me
        MOVEM U,PFLSVU          ; Save U
        MOVEM T,PFLSVT          ; Save T
        SKIPGE U,USER
         BUG AWFUL,[PAGE FAULT IN NULL JOB]
        MOVE T,EPTPFW           ; Get the explanation
        MOVEM T,UPFW(U)         ; Save it for others
        MOVE U,PFLSVU           ; Restore U, only needed it for a moment.
        TLNE T,%PFNXM\%PFPAR    ; Bad stuff should interrupt us, right?
         BUG AWFUL,[NXM OR PARITY ERROR DIDN'T INTERRUPT]
        MOVE T,EPTPFO
        TLNE T,%PSUSR           ; In Exec mode?
         JRST PFLUSR
        MOVE T,(T)              ; We assume that it wasn't the instruction
                                ; fetch itself that caused the fault.
PFLOOP: MOVEM T,PFLINS          ; Save instruction that caused fault.
        LSH T,-33               ; Check opcode for XCTRI
        CAIN T,XCTRI_-33        ; Should we skip?
         JRST PFLSKP
        CAIN T,XCTR_-33         ; Touching user address?
         JRST PFLUSR
        CAIE T,UMOVE_-33        ; These guys are just like XCTR
         CAIN T,UMOVEM_-33
          JRST PFLUSR
        ;; Let XCT chains win.  We assume that none of the fetches along
        ;; the way caused the fault.
        CAIE T,XCT_-33
         BUG HALT,[PAGE FAULT IN SYSTEM AT],OCT,EPTPFO
        MOVE T,PFLSVT           ; Restore T for a moment
        MOVE T,@PFLINS          ; Pick up XCTed instruction
        JRST PFLOOP

;;; Come here to cause faulting instruction to skip.
PFLSKP: MOVE T,PFLSVT           ; Restore T
REPEAT 2, AOS EPTPFO
        SKIPL PFLCLK            ; Unless clock was already off
         CONO PI,CLKON          ; turn it back on
PFAILE: JRST 2,@EPTPFO

;;; Come here on NXI error.
PFLNXI:

;;; We come here when the page fault is "soft" and it happened in user mode
;;; or while using XCTR, UMOVE, or UMOVEM.
PFLUSR: MOVE T,EPTPFW
        TLNN T,%PFNXI           ; Non-existent IO Register?
         JRST PFLU1             ; Nope
        MOVE T,EPTPFO
        TLNE T,%PSUSR           ; NXI in User IOT mode is not fatal.
         TLNN T,%PSUIO
          BUG AWFUL,[NON-EX IO REG ],OCT,EPTPFW,[PC=],OCT,EPTPFO
PFLU1:  MOVE T,PFLSVT           ; Restore T
        SKIPGE PFLCLK           ; Check for lossage
         BUG AWFUL,[PAGE FAULT WITH CLKOFF AT],OCT,EPTPFO
TPFLT1: SETOM PFAILF            ; Cause CLK level to go to PFLU2
CCLKRQ: CONO PI,CLKRQ
        JRST .                  ; Takes a while to go off...

;;;CLKBRK comes back here at CLK level.
PFLU2:  MOVE T,EPTPFO
        MOVEM T,CLKBRK          ;Save PC of page fault as place interrupted
                                ;from.
        LDB E,[$PFPNO,,UPFW(U)] ;E: Virtual page number
        HLRZ D,UPFW(U)
        ANDI D,%PFNXI\%PFWRT\%PF2.9\%PF2.8      ;D: Page fault code
        MOVEI A,0               ;A: User interrupt bits
        TRNE D,%PFNXI           ;NXI in User IOT mode.
         JRST PFA7A

;Drops through into PFA5

] ;KS10P
\f
IFN KA10P,[
CLKB1:  MOVE T,CLKBRK
        CONSZ 200
         JRST CLKFO1    ;FLOATING OVERFLOW ENABLED
CLKFO2: CONSZ 20        ;SKIP IF AR OV INT NOT ENABLED
         CONSO 10       ;OV ENABLED, SKIP IF OV
          CONSZ 270000  ;NOT OV, CHECK PDL OV, MEM PROTECT, NXM
           JRST CLKB1C  ;PDL OV, NXM, ETC
        JRST CLKB1D     ;ONLY CLOCK BREAK, AR OV JUST ENABLED

CLKFO1: CONSO 100       ;SKIP ON FLOATING OVERFLOW
         JRST CLKFO2    ;NOT REALLY FLOATING OVERFLOW
CLKB1C: JUMPL U,CNLJL   ;NULL JOB LOST
        MOVEI A,0       ;SET UP INTERRUPT BITS FOR USER
        CONSZ 20        ;SKIP IF OV NOT ENABLED
         CONSO 10       ;OV ENABLED, SKIP ON OV
          JRST CLB1A    ;NOT AROV
        PUSHJ P,AROV
CLB1A:  CONSZ 200       ;SKIP IF FL OV NOT ENABLED
         CONSO 100      ;FL OV ENABLED, SKIP ON FL OV
          JRST CLB1B    ;NOT FLOATING OVERFLOW
        PUSHJ P,ARFOV
CLB1B:  CONSO 270000    ;SKIP IF PDL OV, NXM, OR MEM PROTECT
         JRST CLB1X
        CONSZ 10000     ;NON EX MEM
         PUSHJ P,MEMHNG
        CONSO 200000
         JRST CLKB1H
        TRO A,%PIPDL    ;PDL OVFLO
        TLNN T,%PCUSR   ;SKIP IF IN USER MODE
         BUG HALT,[PDL OVERFLOW IN EXEC MODE]
CLKB1H: CONSO 20000     ;MEM PROTECT
         JRST CLKB1G
        HLLZ D,UPQUAN(U)        ;PICK UP FAULT BITS
        TLNE D,1000
         TLNN D,770     ;ALL CONDITIONS WHICH ABORT INSTRUCTION
          JRST CLKB1J   ;(PLUS PAGE NXM FOR RANDOMNESS)
        TRZ A,%PIPDL    ;INSTRUCTION ABORTED, DON'T SET PDL OV
        HLLZ T,UPOPC(U)
        LSH T,5
        HRR T,UPOPC(U)  ;FIX UP OPC
        MOVEM T,CLKBRK  ;RESET PC FROM OPC
        AOS NPGFLT
        HLRZ E,UPJPC(U) ;GET VIRTUAL PAGE # (LH OF JPC)
        TRNN E,400
         JRST CFHFPF
        ANDI E,377      ;FLUSH AGE ETC
] ;KA10P
        ;DROP THROUGH INTO PFA5
\f
IFE KA10P,[
PFA5:   AOS NPGFLT
] ;IFE KA10P
        MOVE TT,LUMPS
        HRRZ W,USER
IFN KA10P,[
        TLNE D,320      ;SKIP IF REALLY PAGE FAULT
         JRST CFH4      ;OTHERWISE WRITE IN READ ONLY OR EXECUTING IMPURE PAGE
] ;KA10P

;COME HERE WITH
;  A    BITS FOR USER'S PIRQC
;  D    PAGE FAULT BITS OR CODE
;  E    VIRTUAL PAGE NUMBER OF PAGE FAILURE
;  TT   THE UMAPS SETTING
;THE MYSTERIES OF W:
;  RH IS A USER INDEX
;  LH 0 => NORMAL PAGE FAULT
;     NON0 => SWAP IN REQUEST FOR OTHER REASON.  D,TT SHOULD BE 0.
;     SPECIFICALLY,
;     4.9 => DMA DEVICE SWAP-IN, SEE SWIRQB, SWPPIN
;     4.8 => FROM SCHEDULER, TO GIVE INTERRUPT (?)  THIS IS NO LONGER USED,
;            PROBABLY. 
;     4.7 => FROM CFHAHD, TO PAGE AHEAD.  THIS IS ONE LEVEL OF RECURSIVE
;            USE OF CFHSW1. 
;  FOR A NORMAL PAGE FAULT, THE USER PC IS IN CLKBRK.

CFHSW1:         HRRZM E,CFHUVP  ;USER'S VIRTUAL PAGE NUMBER
                TRZN E,200
                 JRST CFH1
                MOVEI C,UPGCPH(W)       ;VIRTUAL ADDRESS IN USER'S HIGH SEG
                TLNN TT,%UMMPU  ;IS MY UPPER NORMAL?
                 JRST CFH2      ;YES, USE MY UPPER CPB
                MOVEI C,UPGCPH(TT) ;NO, TRY HIS UPPER.
                TLNE TT,%UMUTL  ;IS MY UPPER GOING TO HIS LOWER?
                 MOVEI C,UPGCP(TT) ;YES, TRY HIS LOWER.
                JRST CFH2

CFH1:           MOVEI C,UPGCP(W)        ;VIRT ADDRESS IN USER'S LOW SEG
                TLNN TT,%UMMPL
                 JRST CFH2      ;MY LOWER DBR NOT HACKED
                MOVEI C,UPGCP(TT)
                TLNE TT,%UMLTU  ;WAS MY LOWER HACKED TO POINT TO UPPER?
                 MOVEI C,UPGCPH(TT) ;YES.
CFH2:           ROT E,-1
                ADD C,E
                HRLI C,222200
                SKIPGE E
                 HRLI C,2200
                MOVE T,C        ;CALCULATE MAP ENTRY B.P. FROM CIRC PTR B.P.
                ADD T,[(200000-2000)UPGMP-UPGCP]
                LDB E,C         ;CIRC MEM USE POINTER FOR PAGE FAULT
                JUMPE E,CFH4    ;ADDRESS IS IN REAL ILM
                CAIN E,-1
                 JRST CFH4      ;ON REFERENCE TO ABS PAGE ALSO ILM
IFN KL10P,[     CAIE D,%PFILW
                 JRST CFHW1
                LDB I,T
                JRST .+1(I)
                  BUG           ;?
                  JRST CFH4     ;WRITE IN READ ONLY?
                  JRST CFHRWF   ;READ WRITE FIRST
                  BUG           ;?
] ;KL10P
IFN KS10P,[     CAIN D,%PFWRT\%PF2.8    ;WRITE IN READ ONLY
                 JRST CFH4
                CAIN D,%PFWRT\%PF2.9    ;READ WRITE FIRST
                 JRST CFHRWF
                TRNE D,%PF2.8\%PF2.9    ;PAGE NOT IN MAP
                 BUG HALT,[BOGUS PAGE FAIL CODE]
] ;KS10P
IFN KA10P,[
                TLNE D,40
                 JRST CFHRWF
] ;KA10P
;REFERENCE TO PAGE WITH NO ACCESS IN MAP.
CFHW1:          SKIPGE RPCL(W)
                 JUMPGE W,CFF1  ;BEING RPCLSRED?
                MOVEM A,CFHAS
                AOSE CIRPSW
                 JRST CFH5      ;CIRPSW NOT AVAILABLE
                TRZE E,400000
                 TRNE E,200000
                  JRST CFHSW3
                CAML E,MMPMX
                 BUG            ;MMP OUT OF RANGE
                MOVE C,E        ;CIRC PNTR ALREADY POINTS TO MMP
                ADD C,MMPEAD
                JRST CFHSW4

CFHSW3:         PUSHJ P,UCPRL   ;FIND MMP
                  200000,,.+2
                 BUG            ;NONE?
                SUB P,[4,,4]
CFHSW4:         LDB D,[410200,,(C)]     ;TWO BITS OF MMP ENTRY GIVES DISPOSITION OF PAGE
                AOS NRPI(D)
                JRST @CFHDT(D)

CFHDT:  CFHPI   ;IN
        CFHPCI  ;COMING IN
        CFHPO   ;OUT
        CFHPGO  ;GOING OUT
\f
;PAGE FAULT IN JOB BEING PCLSR'D.
CFF1:   MOVE C,CLKBRK
        TLNE C,%PCUSR
         BUG            ;BEING RPCLSRED IN USER MODE
IFN KA10P,[
        MOVSI D,1770
        ANDCAM D,UPQUAN(W)      ;CLR PG FLT
        LPMR UPGML(W)
        CONO 470000+APRCHN      ;CLR PDL OV + QT OV + MPV + NXM
] ;KA10P
        MOVE T,[BADBTS]
        IOR T,MSKST(W)
        AND T,A
        IORM T,PIRQC(W)
IFE KA10P,[
        MOVE T,CLCX(W)          ;RESTORE UPT BUT NOT ACS
        HRLI T,300000
        DATAO PAG,T
] ;IFE KA10P
        CONO PI,CLKOFF          ;GO ALLOW SELF TO GET RPCLSRED
        JRST 10,UFL1            ;GO INTO UFLS WITH CLK OFF RATHER THAN
                                ;IN PROGRESS

CFHRWF:                 ;HANDLE "WRITE IN READ-WRITE-FIRST PAGE" PAGE FAULT.
IFN KA10P,[
        TLNE D,10
         JRST CFHW1     ;SOMETIMES NO ACCESS SEEMS TO BE ON TOO
        LDB I,T
        CAIE I,2
         BUG            ;GOT "WRITE IN R-W-F PAGE" BUT PAGE ISN'T R-W-F.
] ;KA10P
        MOVEI I,3
        DPB I,T
        MOVEM A,CFHAS
        JRST CFHX1

;; EXIT FROM PAGE FAULT HANDLING FOR NON-ERROR FAULT.
;; C SHOULD CONTAIN 0 IF CAN CONTINUE NOW, OR A FLSINS TO WAIT WITH.
;; A SHOULD CONTAIN -1 IF FAULT HANDLED SUCCESFULLY (PAGE IN OR ON ITS WAY), ELSE 0.
CFHX:   SETOM CIRPSW
        TLNN W,200000
         JUMPL W,CPOPJ
CFH5A:  JUMPE C,CFHX1   ;IF NOT GOING TO WAIT, SKIP NPGWTU CODE
        MOVSI D,%SWPGW
        IORM D,USWST(W) ;WAITING FOR PAGE
        AOS NPGWTU      ;KEEP COUNT OF USERS WAITING FOR A PAGE
        SKIPN FLSINS(W)
         MOVEM C,FLSINS(W)
        SKIPE FLSINS(W)
         CLEARM DLSRCH
CFHX1:  MOVE A,CFHAS
IFN KA10P, MOVSI D,1770         ;CLEAR FAULT STATUS BITS
        MOVE U,USER
        JRST CFH6

;; WAIT FOR CIRPSW TO BE AVAILABLE.
CFH5:   SETZ A,
        JUMPL W,CPOPJ
        MOVE C,[SKIPL CIRPSW]
        AOS NLPPGC
        JRST CFH5A
\f
;PAGE FAULT ON PAGE THAT'S REALLY IN CORE.
CFHPI:  PUSHJ P,CFHAHC  ;SEE IF WE WANT PAGE-AHEAD OR PAGE-BEHIND.
        MOVSI D,MMPPGA
        TDNE D,(C)
         AOS NPGAHR     ;COUNT NUMBER OF PAGED-AHEAD PAGES ACTUALLY USED.
        ANDCAB D,(C)
        MOVSI D,MMPPGB
        TDNE D,(C)
         AOS NPGBHR     ;COUNT NUMBER OF PAGES AGED BY PAGE-BEHIND WHICH WERE USED AGAIN.
        ANDCAB D,(C)
        HRLI C,2200
        PUSH P,C        ;SAVE MMP ENTRY ADDRESS FOR PPIUM.
        PUSHJ P,UCPRL
            100000,,.+2 ;RETURN ON MEMPNT
         BUG            ;NO MEMORY LINKED IN?
        SUB P,[4,,4]    ;FIND MEMBLT INDEX
        POP P,C
        TLNE D,MMPBAD   ;WAS THIS PAGE RECENTLY A PAR ERR VICTIM?
         JRST CFHPB     ;YES; READ IT BACK OFF THE DISK IF POSSIBLE.
IFN E.SP,[
        JUMPGE W,E.SBAR ;IF NOT CALLED FROM SWPPIN
        HRRZ H,DISUSR   ;CHECK TO SEE IF SERVICING E&S
        CAIN H,(W)      ;NOT DISPLAY, THEN SKIP
         PUSHJ P,E.SPGI ;ELSE TIE DOWN PAGE
E.SBAR:
]
        MOVE A,T
        HLLZS MMSWP(A)  ;CLEAR LENGTH OF CIRC LIST (BUT NOT EXEC PGS COUNT)
        MOVE D,C
        HRLI D,(TDNE T,)
        PUSHJ P,PPIUM   ;PUT PAGE INTO USERS' MAPS
IFN E.SP,SETZM  E.SPGH  ; CLEAR QSWI1 FLAG
        MOVEI C,0
        MOVNI A,1
        JRST CFHX

;COME HERE FOR PAGE WHICH SEEMS TO BE IN CORE, BUT HAD A PAR ERR RECENTLY.
;"SWAP IT OUT", SO IF IT'S PURE IT WILL JUST BE READ BACK FROM DISK.
CFHPB:  PUSH P,W
        MOVE A,T
        SETOM CIRPSW    ;UNLOCK, SO SWPOPG CAN RE-LOCK.
        MOVE C,USER     ;TELL SWPOPG WHICH JOB SHOULDN'T BE PCLSR'ED.
        PUSHJ P,SWPOPL  ;"SWAP OUT" THE PAGE (EVEN IF LOCKED DOWN)
         JRST [ POP P,W ;FAILED TO GO OUT.  COULD BE EXEC PAGE POINTING TO IT,
                SETZ A, ;OR A JOB THAT CAN'T BE PCLSRED RIGHT NOW.
                MOVSI C,(CAIA)  ;WAIT A LITTLE AND TRY AGAIN (HOPE FOR THE BEST)
                JRST CFHX ]
        POP P,W
        AOSE CIRPSW     ;SWPOPG UNLOCKS; RE-LOCK.
         JRST CFH5      ;OR ELSE GO INTO PAGE-WAIT TILL CIRPSW FREE.
        MOVE C,SWOMMP
        JRST CFHSW4     ;TRY AGAIN TO REFERENCE PAGE, SWAPPING IT BACK IN.
\f
;ON A RANDOM PAGE FAULT, SEE IF WE WANT PAGE-AHEAD OR PAGE-BEHIND.
;ASSUMES W SET UP AS FOR CFHSW1, AND TT
CFHAHC: MOVE D,CFHUVP   ;GET USER'S VIRTUAL PAGE NUMBER.
        TLNN W,-1       ;PAGE AHEAD ONLY FOR NORMAL PAGE FAULT (SO PC IS IN CLKBRK).
         SKIPN PAGAHD(W)        ;IS PAGE-AHEAD WANTED FOR THIS JOB?
          POPJ P,
        MOVSI T,%UMMPU
        TRNN D,200
         MOVSI T,%UMMPL
        TDNE TT,T       ;NO PAGE-AHEAD ON PAGE NOT MAPPED NORMALLY.
         POPJ P,
        HLRZ H,PAGRAN(W)
        HRRZ T,PAGRAN(W)
        CAML D,H        ;IS PAGE IN RANGE FOR AUTOMATIC PAGE-AHEAD?
         CAML D,T       ;IF SO, GO DO IT.
          POPJ P,
        PUSH P,C
        PUSHJ P,CFHAHD
        POP P,C
        POPJ P,

;AUTOMATIC PAGE-AHEAD AND PAGE-BEHIND.
;WHEN PAGE N IS PUT INTO THE MAP, PAGE N+1 IS SWAPPED IN
;AND PAGE N-1 IS SWAPPED OUT.
;(ACTUALLY, 1 IS A PARAMETER, IN THE PAGAHD VARIABLE)
CFHAHD: PUSH P,CFHUVP
;LOOP, REQUESTING SWAP-IN FOR THE NEXT N PAGES.  E HAS PAGE NUMBER TO SWAP IN.
CFHAH1: MOVE E,CFHUVP
        HLRE A,PAGAHD(W)
        MOVE T,A
        ADD A,(P)
        CAMN A,E                ;DETECT END OF LOOP.
         JRST CFHAH2
        SKIPL T                 ;ELSE INCREMENT OR DECREMENT PAGE NUMBER.
         AOSA E
          SOS E
        PUSHJ P,CFHRNG          ;IS PAGE NUMBER IN RANGE FOR PAGE-AHEAD?
         JRST CFHAH2
        PUSH P,W
        HRLI W,500000           ;PAGE AHEAD THE PAGE.  100000 MEANS PAGE-AHEAD.
        SETZB D,TT
        SETOM CIRPSW            ;ALLOW CFHSW1 TO LOCK CIRPSW.
        PUSH P,CFHAS
        PUSHJ P,CFHSW1
        POP P,CFHAS
        SETZM CIRPSW            ;BUT REALLY IT'S ALREADY LOCKED SO KEEP IT SO.
        POP P,W
        SKIPN A
         AOS NPGAH1             ;COUNT NUMBER OF TIMES AN ATTEMPT FAILS.
        JRST CFHAH1

;NOW IT'S TIME FOR PAGE-BEHIND.  E HAS PAGE NUMBER TO SWAP OUT.
CFHAH2: MOVE E,(P)
;???? IS THERE ANY NEED TO PRESERVE U, EVER, INSIDE CFHSW1?
        PUSH P,U
        HRRE A,PAGAHD(W)        ;GET PAGE-BEHIND DISTANCE.
        JUMPE A,CFHAH4
        ADDB A,E                ;COMPUTE WHICH PAGE TO PAGE OUT.
        PUSHJ P,CFHRNG          ;SKIP IF PAGE IS IN RANGE FOR PAGE-BEHIND.
         JRST CFHAH4
        MOVE U,W
        PUSHJ P,UPLC            ;LOOK UP THE PAGE IN THE MAP.
        LDB D,Q                 ;D GETS CIRC PNTR
        JUMPE D,CFHAH4          ;NO PAGE THERE
        CAIN D,-1
         JRST CFHAH4            ;ABSOLUTE PAGE, DO NOTHING.
        LDB D,T
        TRO D,PMAGEM            ;AGE THE PAGE, IF THE PAGE IS REALLY IN THE MAP,
        TRNE D,600000
         DPB D,T
        AOS NPGBHA              ;COUNT PAGES AHED FOR PAGE-BEHIND.
        MOVE D,T                ;SAVE B.P. TO PAGE MAP HALFWORD, FOR CFHAH6.
        MOVE C,Q                ;STARTING FROM CIRC PTR, FIND MMP
        PUSHJ P,UCPRL
            200000,,.+2
         BUG                    ;IF NONE FOUND
        SUB P,[4,,4]            ;FOUND MMP, C POINTS TO IT
        MOVE E,C                ;SAVE ADDRESS OF MMP ENTRY
        MOVSI T,MMPTMP\MMPOUT   ;IF PAGE IS IN TRANSIT OR OUT, DO NOTHING TO IT.
        TDNE T,(C)
         JRST CFHAH6
        MOVE T,CLKBRK
        TLNN T,%PCUSR           ;IF JOB IN EXEC MODE, CAN'T SWAP OUT PAGE, SO JUST LEAVE AGED.
         JRST CFHAH6
        MOVE T,MEMFR
        SUB T,NCBCOM            ;IF LOTS OF FREE MEM, DON'T SWAP OUT.
        SUB T,SILNG
        CAML T,CFHAHS
         JRST CFHAH6
        PUSHJ P,UCPRL           ;GET CORE PAGE NUMBER IN T.
            100000,,.+2
         BUG
        SUB P,[4,,4]
        HLRZ A,MMSWP(T)
        JUMPN A,CFHAH6          ;POINTED TO BY AN EXEC PAGE, E.G. 340, CAN'T SWAP OUT.
        PUSH P,E
        PUSH P,D
        PUSH P,W
        MOVE A,T                ;PHYSICAL PAGE # TO SWAP OUT
        HRRZ C,W                ;DON'T PCLSR ME
        SETOM CIRPSW            ;SWPOPG WILL WANT TO RE-LOCK CIRPSW.
        PUSHJ P,SWPOPG          ;SWAP OUT
         JRST CFHAH5            ;CAN'T SWAP OUT => LEAVE JUST AGED.
        AOS NPGBHD              ;COUNT PAGES SWAPPED OUT BY PAGE-BEHIND.
CFHAH5: POP P,W
        POP P,D
        POP P,E
        POP P,U
        POP P,CFHUVP
        AOS CIRPSW              ;SWPOPG UNLOCKS; RE-LOCK.
        POPJ P,                 ;CAN'T GET LOCKED BY SOMEONE ELSE, WE ARE AT CLOCK LEVEL

;HERE FOR PAGE-BEHIND PAGE WHICH WE CAN'T OR DON'T WANT TO SWAP OUT.
CFHAH6: MOVSI T,MMPPGB          ;IT HAS ALREADY BEEN AGED.  MARK IT FOR METERING PURPOSES.
        IORM T,(E)              ;E POINTS TO MMP ENTRY.
CFHAH4: POP P,U
        POP P,CFHUVP
        POPJ P,

;SKIP IF PAGE NUMBER IN E IS IN RANGE FOR PAGE-AHEAD OR PAGE-BEHIND.
;ASSUMES USER INDEX IN W.  CLOBBERS T.
CFHRNG: CAIL E,400
         POPJ P,
        HLRZ T,PAGRAN(W)
        CAIGE E,(T)
         POPJ P,
        HRRZ T,PAGRAN(W)
        CAIL E,(T)
         POPJ P,
        JRST POPJ1

EBLK

CFHAHS: 20              ;IF LESS THAN THIS MUCH FREE MEM, PAGE-BEHIND SHOULD SWAP OUT.

NPGAHD: 0               ;NUMBER OF PAGES WE ACTUALLY SWAPPED IN FOR PAGE-AHEAD.
NPGAH1: 0               ;NUMBER OF TIMES WE WERE UNABLE TO PAGE AHEAD.
NPGBHD: 0               ;NUMBER OF PAGES WE ACTUALLY SWAPPED OUT FOR PAGE-BEHIND.
NPGBHA: 0               ;NUMBER OF PAGES WE DID PAGE-BEHIND.
NPGAHR: 0               ;NUMBER OF PAGED-AHEAD PAGES ACTUALLY USED.
NPGBHR: 0               ;NUMBER OF PAGES AGED FOR PAGE BEHIND AND USED AGAIN.

BBLK
\f
;REFERENCE TO SWAPPED OUT PAGE, MMP ADDRESS IN C.  SWAP IN THE PAGE.
;W HAS THE USER INDEX AND FLAGS.
CFHPO:  PUSHJ P,CFHPOA
         JRST [ SETZ A, ;FAILED.  RETURN CODE FOR FAILURE, IF THIS IS FOR DEVICE (W<0).
                JRST CFHX]
        TLNN W,100000           ;IF THIS IS A PAGE-AHEAD REQUEST,
         JRST CFHPOB
        MOVSI A,MMPPGA          ;MARK THE MMP ENTRY SO,
        IORM A,(C)
        AOS NPGAHD              ;AND COUNT IT AS A SUCCESSFUL ATTEMPT TO PAGE AHEAD.
CFHPOB: TLNN W,200000
         JUMPL W,CFHPO2
        PUSHJ P,CFHAHC          ;ORDINARY PG FAULT => MAYBE PAGE AHEAD.
        MOVSI D,%SWBEM
IFN SWPWSP,[            ;SWAPPING IN A PAGE FOR THIS GUY 
         ANDCAM D,USWST(W)      ;SO CLEAR BEST EFFORT MADE TO SWAP OUT BIT
];SWPWSP
IFE SWPWSP,[
        TDNN D,USWST(W)         ;IF JOB IS BRINGING IN FIRST PAGE
         JRST CFHPO2            ; SINCE BEING SWAPPED OUT,
        ANDCAM D,USWST(W)       ;CLEAR BEST EFFOR MADE TO SWAP OUT BIT
        EXCH U,W                ;AND MAKE SWAP HISTORY TABLE ENTRY
        MOVSI T,0               ;FOR "BEGIN LOADING"
        PUSHJ P,SWPKHT
        EXCH U,W
];SWPWSP
CFHPCI:
CFHPGO:
CFHPO2: MOVNI A,1       ;SIGNAL "SUCCESS"
        TLNN W,200000
         JUMPL W,CFHX
        MOVSI D,MMPTMP          ;BIT ON IF PAGE "IN TRANSIT"
        SKIPN FLSINS(W)
         MOVEM D,EPDL2(W)       ;HANG USER UNTIL PAGE GETS WHERE IT'S GOING
        HRLI C,(TDNE T,)        ;COMBINE WITH ADDRESS OF MMP
        AOS NLPPAG
        JRST CFHX
\f
;SWAP IN PAGE.  W HAS USER INDEX AND FLAGS.  C HAS MMP ADDRESS.
;SKIPS IF SUCCESSFUL.  OTHERWISE RETURNS FLSINS IN C.
;SIGN BIT IN W IS SET FOR SWAP IN FOR DEVICE OR FOR PAGE-AHEAD
;(THAT IS, NOT ONE WHICH A JOB MUST WAIT FOR)
;SO DON'T INCREMENT SOME COUNTERS AND DON'T BOTHER WITH FLSINS IN C.
CFHPOA:
IFE SWPWSP,[
        SKIPGE USWSCD(W)        ;IF SWAP BLOCKED, EITHER UNBLOCK OR GIVE UP.
         JRST CFBO1
CFBO2:
];SWPWSP
IFN SWPWSP,[
        MOVE E,USWST(W) ;IF SWAPPED OUT, WE ARE EITHER GOING TO ENTER
        TLNE E,%SWOUT   ;THE LOADING STATE OR THE SWAP BLOCKED STATE
         JRST CFSB
CFSB1:
];SWPWSP
        MOVSI E,MMPISW
        AND E,(C)
        CONO PI,UTCOFF-1
        JUMPN E,CFHPO5  ;INITIAL SWAPIN; GIVE UP AND WAIT NOW IF TUT IS LOCKED.
CFHPO7: PUSHJ P,HMRQC   ;GET PHYS MEM BLOCK, NUMBER IN A.
         JRST CFHPO1    ;MEM NOT AVAILABLE
        MOVEI B,1
        DPB B,[410200,,(C)]     ;INDICATE COMING IN
        HRRZ B,(C)              ;OLD CP OF MMP
        MOVEM B,MEMPNT(A)       ;BECOMES LINK OUT OF CORE BLOCK
        HLRZ B,1(C)             ;B := DISK ADDRESS
        LDB I,[$MMPUN,,(C)]     ;I := DISK NUMBER
        CAIL I,NQS
         BUG
        HRLM B,MEMPNT(A)        ;SET DISK ADDRESS CORE BLOCK COMING FROM
IFN SWPWSP,[
        MOVE D,USWST(W)
        TLNN D,%SWLOD
         AOSA NPLBNL
          AOS NPLBLJ
];SWPWSP
        SKIPE E         ;IF INITIAL SWAP IN PAGE, SOS THE TUT NOW
         PUSHJ P,CFHPO8 ;SINCE WE ARE DISSOCIATING THE PAGE FROM THE DISK BLOCK.
        CAIGE A,TSYSM
         CAIGE A,SYSB
          BUG           ;SHOULDN'T HAVE TO SWAP IN THE SYSTEM
        CONO PI,UTCON-1 ;LEAVE CLKCHN OFF.
        SOS NPGSWO
        AOS SWIPRQ      ;TOTAL SWAP IN REQUESTS
;; MARK THE PHYSICAL MEMORY BLOCK AS BEING SWAPPED INTO BY THIS PAGE.
        MOVEI B,MUSWPG
        DPB B,[MUR,,MEMBLT(A)]
        MOVEI B,600000(A)
        HRRM B,(C)      ;MAKE CP OF MMP POINT TO MEMPNT
        MOVE TT,C
        SUB TT,MMPEAD
        DPB TT,[MMMPX,,MEMBLT(A)]       ;STORE MMP INDEX IN MEMBLT
        MOVEI TT,.BM MLO
        ANDCAM TT,MEMBLT(A)     ;SET END OF LIST IN THIS BLOCK
;; PUT THE TRANSFER ON THE SWAP IN LIST.
        CONO PI,UTCOFF-1
        HLRZ TT,SINLST(I)       ;GET PREV BLOCK
        SKIPE TT
         DPB A,[MLO,,MEMBLT(TT)]        ;CHAIN TO PREV BLOCK
        SKIPN TT
         MOVEM A,SINLST(I)      ;OR TO HEADER IF FIRST
        HRLM A,SINLST(I)        ;AND SET NEW LAST BLOCK
        AOS SILNG               ;AOS NUMBER OF PENDING SWAP IN RQS.
        PUSHJ P,QSTRT1          ;WAKE UP DISK INTERRUPT LEVEL.
        CONO PI,UTCON-1
;; UPDATE SWAP HISTORY TABLE.
        HRLZ TT,W
        IDIVI TT,LUBLK          ;TT 3.1-3.8 GETS USER NUMBER, BASHES I
IFN SWPWSP,[
        MOVSI T,%SWLOD
        TDNE T,USWST(W)
         TLO TT,(SETZ)
];SWPWSP
        MOVE T,CFHUVP
        DPB T,[321000,,TT]
        HRR TT,TIME
        MOVEM TT,@PGIHTP
        AOS T,PGIHTP
        MOVE TT,UTRNTM(W)
        MOVEM TT,PGIHTL-1(T)
        MOVEI TT,PGIHTB
        CAIL T,PGIHTB+PGIHTL
         MOVEM TT,PGIHTP
        TLNN W,200000
         JUMPL W,POPJ1
        AOS USIPRQ(W)
        JRST POPJ1      ;HANG USER UNTIL PAGE IN
\f
;IF SWAPPNG IN "INITIAL SWAP IN" PAGE, CHECK TO SEE WHETHER TUT IS AVAILABLE.
;WE CAN'T SWAP THE PAGE IN IF NOT.
CFHPO5: LDB I,[$MMPUN,,(C)]     ;GET DSK #
        CAIL I,NQS
         BUG
        SKIPL QTUTO(I)
         JRST CFHPO7    ;DISK TUT AVAIL
        CONO PI,UTCON-1
        TLNN W,200000
         JUMPL W,CPOPJ  ;NO COUNTER AOS IF SWAPIN FOR DEVICE OR PAGE AHEAD.
        MOVE C,[SKIPGE QTUTO]   ;ALSO MUSTN'T SMASH C
        ADD C,I
        AOS NLPPGT
        POPJ P,

;LATER ON, COME HERE TO SOS THE TUT, AFTER GETTING THE MEM, WHEN WE CAN NO LONGER BLOCK.
CFHPO8: ANDCAM E,(C)    ;CLEAR INITIAL SWAPIN BIT
        MOVE D,B        ;GET TRK #
        PUSHJ P,TUTPNT
        CAIGE B,TUTMNY
         SOJL B,[JRST 4,.]
        DPB B,D
        HRRZS 1(C)      ;CLEAR ASSIGNED TRACK NUMBER SO NEW SPACE ASSIGNED ON SWAPOUT
        POPJ P,

;HERE IF NO MEMORY TO SWAP PAGE INTO.
CFHPO1: CONO PI,UTCON-1
        TLNN W,200000
         JUMPL W,CPOPJ
        SKIPGE MEMFRZ           ;IF BECAUSE MEMFRZ LOCKED, MAKE JOB WAIT FOR MEMFRZ.
         JRST CFHPO4
        MOVE C,[SKIPL MEMFRZ]
        AOS NLPPGM
        POPJ P,

CFHPO4: MOVE C,[PUSHJ P,CFHPO3]
        MOVN D,SOLNG
        SUB D,SWPOPR    ;- # PGS GOING OUT
        ADDI D,10.      ;MAKE SURE AT LEAST 10. GOING OUT
        JUMPLE D,.+2
         ADDM D,SWPOPR
        MOVEI D,1
        SKIPN FLSINS(W)
         MOVEM D,EPDL2(W)
        AOS NLPPG3
        POPJ P,

CFHPO3: PUSH P,A        ;FLSINS ROUTINE (NEEDED MEM)
        MOVE A,MEMFR
        SUB A,NCBCOM
        CAIL A,5(T)
         JRST POPAJ1    ;NEEDED MEM AVAILABLE
        ADD A,SOLNG
        ADD A,SWPOPR
        SUBI A,10.(T)
        JUMPGE A,POPAJ  ;WILL EVENTUALLY WIN
        MOVNS A
        ADDM A,SWPOPR   ;LOSING - SWAP SOME MORE STUFF OUT
        JRST POPAJ

IFE SWPWSP,[
;HERE IF TRYING TO SWAP IN A PAGE BUT SWAP BLOCKED
CFBO1:  MOVE E,MEMFR    ;GUY SWAPPED BLOCKED
        SUB E,NCBCOM
        SUB E,AUSOPG
        SUB E,SILNG
        ADD E,SOLNG
        JUMPGE E,CFBO3  ;SEEMS TO BE ROOM SO LET IT COME IN
        TLNN W,200000
         JUMPL W,CPOPJ  ;HANG GUY UNTIL SWAP BLOCK GOES AWAY
        MOVE C,[SKIPGE USWSCD]
        ADDI C,(W)
        AOS NTSBUB
        AOS NLPPGB
        POPJ P,

CFBO3:  AOS NTSBUP
        JRST CFBO2
];SWPWSP
\f
OVHMTR WS       ;WORKING-SET COMPUTATIONS

IFN SWPWSP,[
;HERE WHEN A SWAPPED OUT OR SWAP BLOCKED JOB TRIES TO SWAP IN A PAGE.
;JOB IN W, C -> MMP, USWST(W) IN E.  RETURN TO CFSB1.
;WE DECIDE WHETHER ENOUGH CORE CAN BE GARNERED TO LET HIM IN, AND PUT
;HIM INTO THE LOADING STATE, OR ELSE PUT HIM INTO THE SWAP BLOCKED STATE.

CFSB:   PUSH P,C
        TLNN E,%SWSB            ;ALREADY SWAP BLOCKED?
         PUSHJ P,WSRCM          ;NO, RECOMPUTE WORKING SET
        POP P,C
        MOVE B,USWPRI(W)        ;FIND SUM OF WS'S OF SWAPPED IN GUY'S WITH BIGGER USWPRI
        PUSHJ P,WSAVL
        MOVE D,USVWRK(W)        ;COMPUTE AMT OF WS NOT ALREADY IN CORE
        SUB D,UWRKST(W)
IFL TSYSM-356.,[
        CAML D,[TSYSM-100.,,]
         JRST .+3               ;WS > PHYSICAL MEM, ALLOW IN ANYWAY, FOO!
];TSYSM
        CAMGE A,D               ;WILL IT FIT IN AVAILABLE MEM?
         JRST CFSB2             ;NO, SWAP BLOCK
        PUSHJ P,CFELD           ;YES, ENTER 'LOADING' STATE
        JRST CFSB1              ;AND GO AHEAD AND BRING IN THE PAGE

CFSB2:  TLNN W,200000           ;IF PAGE-AHEAD, JUST RETURN.
         JUMPL W,CPOPJ
        MOVE T,TIME
        MOVSI A,%SWSB           ;ALREADY SWAP BLOCKED?
        TDNE A,USWST(W)
         JRST CFSB3
        IORM A,USWST(W)         ;NO, ENTER SWAP BLOCKED STATE
        AOS NUSWB
        MOVEM T,USWTIM(W)
CFSB3:  MOVE U,W
        MOVSI T,3_16.           ;MAKE SWAP HISTORY TABLE ENTRY FOR SWP BLK
        PUSHJ P,SWPKHT
        MOVE T,TIME
        SUB T,USWTIM(W)         ;HOW LONG SWAP BLOCKED
        CAIGE T,20.*30.         ;IF LESS THAN 20 SECONDS,
         SKIPA T,[15.]          ; SLEEP FOR 1/2 SECOND,
          MOVEI T,5*30.         ; OTHERWISE SLEEP FOR 5 SECONDS
        ADD T,TIME
        SKIPN FLSINS(W)
         MOVEM T,EPDL2(W)
        MOVEI A,0               ;WILL THEN TAKE FAULT AGAIN AND
        MOVE C,[CAMLE T,TIME]   ;CHECK AVAILABLE MEMORY AGAIN
        AOS NLPPGB
        POPJ P,

;ROUTINE TO FIND MEMORY AVAILABLE TO A JOB WHOSE USWPRI IS IN B
;RETURNS IN LH(A) SUITABLE FOR COMPARING TO UWRKST.  SMASHES T,TT,J

WSAVL:  MOVEI J,2*LUBLK         ;DON'T LOOK AT SYS NOR CORE JOB
        MOVSI T,%SWOUT+%SWLOD   ;IF THESE BITS CLEAR, JOB IS SWAPPED IN
        MOVE A,MEMFR            ;FREE CORE 
        SUB A,NCBCOM            ;FUDGE FOR THINGS IN PROCESS
        SUB A,SILNG             ;..
        ADD A,SOLNG             ;..
        ADD A,NLOOSP            ;LOOSE PAGES ARE EVICTABLE
        SUB A,SWPOPR            ;DON'T COUNT PAGES ALREADY COMMITTED TO EVICT
        HRLZI A,-4(A)           ;ALIGN AS UWRKST AND ALLOW 4 PAGES OF SLOP
        SKIPA TT,TIME           ;TO SEE IF PROTECTED AGAINST MEMORY PREEMPTION
WSAVL1:  ADDI J,LUBLK
        CAML J,USRHI
         POPJ P,
        SKIPE UNAME(J)
         TDNE T,USWST(J)
          JRST WSAVL1           ;DOESN'T EXIST, OR NOT SWAPPED IN, OR LOADING
        CAMGE B,USWPRI(J)
         CAMGE TT,USWTIM(J)
          JRST WSAVL1           ;HIGHER PRIORITY OR PROTECTED
        ADD A,UWRKST(J)         ;THIS GUY'S WORKING SET IS PREEMPTABLE
        JRST WSAVL1     
\f
;Routine to re-compute working set, also re sets up map
;to point to any pages which are swapped in but not mapped in.
;This is necessary in order to get the proper estimate of
;how much core is going to have to be swapped out to make
;this job fit.  Called when a job leaves the swapped-out state,
;to enter either Loading or Swap-blocked.
;Job is in W, smashes A,B,C,D,E,T,TT,H,I,U.
;Call with CIRPSW locked and clk in progress.
WSRCM:  SETZM UWRKST(W)
        MOVEI E,UPGMP(W)        ;SET UP SCAN OF USER'S MAP
        HRLI E,442200
        MOVEI C,UPGCP(W)        ;AND OF CIRCULAR POINTERS
        HRLI C,442200
        LDB D,[121100,,HUSRAD(W)]       ;# OF USER PAGES
WSRCM1: ILDB A,E                ;GET PAGE MAP ENTRY
        ILDB B,C                ;AND CIRCULAR POINTER
        JUMPE A,WSRCM2          ;JUMP IF PAGE DOESN'T EXIST
        CAIN B,-1
         JRST WSRCM2            ;ABS PAGE, DON'T COUNT
        TRNN A,600000           ;ALREADY SWAPPED IN?
         JRST WSRCM3            ;NO, GO PONDER
        ANDI A,PMRCM            ;GET PAGE MAPPED TO
        HRRZ B,MMSWP(A)         ;GET # SHARERS
        MOVSI A,1               ;COMPUTE WS ADJUSTMENT
        IDIV A,B
        ADDM A,UWRKST(W)
WSRCM2: SOJG D,WSRCM1           ;LOOP
        POPJ P,

WSRCM3: PUSH P,C                ;PAGE NOT MAPPED, SEE IF IT'S IN
        PUSHJ P,UCPRL
            100000,,WSRCM4      ;RETURN WITH 4 PUSHES IF MEMORY IN LOOP
        POP P,C                 ;NO MEMORY, LEAVE ALONE
        SOJG D,WSRCM1
        POPJ P,

WSRCM4: SUB P,[4,,4]            ;FOUND MEMORY, IN T
        TRNE A,2
         MOVEI A,2              ;USE READ/WRITE/FIRST RATHER THAN READ/WRITE
        LSH A,20
        IORI A,PMCSHM(T)        ;SET UP MAP
        DPB A,E
        AOS C,MMSWP(T)          ;ONE MORE USER POINTING TO PAGE
        MOVSI A,1
        MOVEI B,-1(C)
        IDIVM A,B               ;ADJUST WS AS IF WAS ALREADY POINTING TO PAGE
        ADDM B,UWRKST(W)        ;ADDM DOES NOTHING IF THERE WAS DIVIDE BY ZERO
        IMULI C,-1(C)           ;COMPUTE WS DECREASE DUE TO ADDITIONAL SHARING
        MOVNI C,(C)
        IDIV A,C                ;IF DIVIDE BY ZERO, A GETS RIGHT THING!
        MOVE C,(P)              ;ADJUST ALL SHARER'S WS'S
        PUSHJ P,UCPRL
            SETZ WSRCM5
        POP P,C
        SOJG D,WSRCM1
        POPJ P,

WSRCM5: ADDM A,UWRKST(U)
        POPJ P,
\f
;LEAVE LOADING STATE IF IN IT.  JOB IN U, SMASH C,TT,T,I
LVLOAD: MOVE C,USWST(U)
        TLZN C,%SWLOD
         POPJ P,                ;NOT IN LOADING STATE
LVLOA0: MOVEM C,USWST(U)        ;TURN OFF LOADING STATE
        MOVE T,TIME
        SUB T,USWTIM(U)         ;TIME IT TOOK TO LOAD
        IMUL T,LODFCT           ;COMPUTE PROTECT TIME
        HLRZS T
        ADD T,TIME
        MOVEM T,USWTIM(U)
        MOVSI T,1_16.           ;MAKE SWAP HISTORY TABLE ENTRY
        JRST SWPKHT

;PUT JOB IN W INTO THE 'LOADING' STATE.  CALL WITH D CONTAINING USVWRK-UWRKST.
;WSRCM MUST HAVE BEEN CALLED ALREADY ON THIS JOB.  SMASHES A,D,T,TT,I

CFELD:  MOVE T,USWST(W)
        TLNE T,%SWSB
         SOS NUSWB              ;CEASES TO BE SWAP-BLOCKED
        TLZ T,%SWOUT+%SWSB+%SWDSO+%SWBEM
        TLO T,%SWLOD
        MOVEM T,USWST(W)
        MOVE T,TIME             ;SAVE TIME STARTED TO LOAD
        MOVEM T,USWTIM(W)
        MOVE U,W
        MOVSI T,0               ;MAKE SWAP HISTORY TABLE ENTRY
        PUSHJ P,SWPKHT
        JUMPLE D,CPOPJ
        HLRZ D,D                ;NUMBER OF PAGES GOING TO NEED, PROBABLY
        MOVE A,MEMFR            ;FREE CORE 
        SUB A,NCBCOM            ;FUDGE FOR THINGS IN PROCESS
        SUB A,SILNG             ;..
        ADD A,SOLNG
        SUB D,A                 ;NUMBER OF PAGES GOING TO HAVE TO SWAP OUT
        SKIPLE D
         ADDM D,SWPOPR          ;START THEM GOING OUT NOW
        POPJ P,
];SWPWSP
\f
OVHMTR FLT      ;MISC FAULTS

CFH4:   TLNE W,100000           ;PAGE-AHEAD OF NON-EX PAGE: DO NOTHING.
         POPJ P,
        JUMPL W,SWIILM          ;IF FROM DMA DEVICE, GIVE ERROR
;HERE FOR FAULTS WHICH ABORT THE INSTRUCTION.
PFA7:   MOVE T,OPTION(U)        ;IF USER WANTS IT,
        TLNN T,%OPOPC           ;GIVE HIM THE OPC RATHER THAN
         AOSA T,CLKBRK          ;THE INCREMENTD PC.
PFA7A:    MOVE T,CLKBRK         ;HERE FOR KL10 MAR BREAK AND KS10 NXI
                                ;ERROR, ALWAYS GIVE ORIGINAL PC, INST
                                ;ABORTED
        TLNE T,%PCUSR
         JRST CLKB1J
        MOVEI C,IOADCR          ;FROM EXEC MODE SO RESET PC TO IOADCR
        EXCH C,CLKBRK
        HRRM C,LEXFDR(U)        ;AND SAVE FAULT EXEC ADR FOR DEBUGGING
        CLEARM DLSRCH           ;IN CASE IT WAS SET
        CLEARM UMAPS(U)         ;RESTORE NORMAL MAP IN CASE RANDOM ONE WAS
                                ;IN USE

CLKB1J: HRLM D,LEXFDR(U)        ;SAVE PF BITS FOR DEBUGGING PURPOSES

IFN KS10P,[     TRNE D,%PFNXI   ;Non-existent IO register in KS10 Unibus.
                 TLO A,(%PINXI)
] ;KS10P

IFN KS10P,      TRNN D,%PFNXI\%PF2.9\%PF2.8
IFN KA10P,      TLZE D,210      ;NO ACCESS OR DBL
IFN KL10P,      CAIN D,%PFPNA
                 TRO A,%PIMPV   ;ILM

IFE KS10P,[
IFN KA10P,      TLZE D,20       ;PURE
IFN KL10P,      CAIN D,%PFPRO
                 TLO A,(%PIFET)
] ;IFE KS10P

IFN KS10P,      CAIN D,%PFWRT\%PF2.8
IFN KA10P,      TLZE D,100      ;W IN RD ONLY
IFN KL10P,      CAIN D,%PFILW
                 TLO A,(%PIWRO)

                TDNE A,[%PIMPV\%PIWRO\%PINXI]
                 PUSHJ P,MPVMAS         ;SAVE FAULT PAGE # FOR DEBUGGING

;;; NO ABORT-TYPE FAULTS, CHECK OTHERS:

IFE KS10P,[
IFN KL10P,      CAIN D,%PFMAR
IFN KA10P,      TLZE D,2
                 PUSHJ P,PCMARB
] ;IFE KS10P

IFN KA10P,[     TLZE D,2000
                 PUSHJ P,CPROC1 ;ONE PROCEED
                ANDCA D,UPQUAN(U)       ;GET BITS FLUSHED BY TLZE'S
] ;KA10P

CFH6:
IFN KA10P,[
        ANDCMI D,-1     ;DON'T CLOBBER USER'S RUNTIME.
        TLZ D,4         ;DON'T CLOBBER EXEC PAGING FLAG.
        TLO D,1         ;IGNORE QUANTUM-TIMEOUT INT.
        ANDCAM D,UPQUAN(U)
] ;KA10P
CLKB1K: LPMR UPGML(U)
CLKB1G: IFN KA10P, CONO 470000+APRCHN   ;RESET
CLB1X:  MOVE T,CLKBRK   ;PUT USER'S PC WHERE IT BELONGS
        MOVEM T,UPC(U)
        MOVE B,[BADBTS]
        IOR B,MSKST(U)  ;GET OR OF ENABLED AND BAD BITS
        AND B,A         ;GET AND WITH BITS ACTUALLY ON
        JUMPE B,CLB1XA  ;NOT BAD OR ENABLED, FORGET ABOUT IT
        IORM B,PIRQC(U) ;GIVE INTERRUPT
        CAIN T,IOADCR   ;READY TO BE INTERRUPTED?
         JRST CLKB5     ;NOT QUITE, RUN MOMENTARILY AND WILL UFLS
IFN SCHBLN,SETZM SCHMNY ;DO FULL SCHEDULE TO DELIVER THE INTERRUPT
        JRST SCHED2

CLB1XA: MOVSI T,%SWINT  .SEE INTPFL     ;IF PAGE FAULT DUE TO USER TRYING TO
        TDNN T,USWST(U)                 ;INTERRUPT, BETTER SCHED SO HE GETS THE INT.
         SKIPE FLSINS(U)        ;ELSE PROCEED THE USER IF HE HAS GOT WHAT HE WANTED.
          JRST SCHED2           ;OR IF HE'S WAITING, GO SCHEDULE.
        JRST CLKB5

IFN KA10P,[     ;NULL JOB LOST
CNLJL:  CONSZ 230220    ;SKIP ON JUST "ADDR BREAK" (QUANTUM OVERFLOW)
         BUG PAUSE,[KA: APR ERROR IN NULL JOB]
        CONO 470000+APRCHN
        JRST SCHED

CFHFPF: BUG PAUSE,[PAGE FAULT IN SYSTEM, PC=],OCT,CLKBRK,[PAGE=],OCT,E
        MOVSI D,1770    ;FALSE PAGE FAULT
        MOVEI A,0
        JRST CFH6
] ;KA10P
\f
EBLK
RINT:   0
BBLK
        CONI RINTAP     ;SAVE STATUS IN CASE SOMEONE DUMPS IT
        CONI PI,RINTPI
        BUG AWFUL,[RANDOM INTERRUPT, APR ],OCT,RINTAP,[PI ],OCT,RINTPI
        JRST 12,@RINT           ;YOU CAN TRY PROCEEDING

EBLK
RINTAP: 0       ;APR STATUS AT RINT
RINTPI: 0       ;PI STATUS AT RINT

IFN KS10P,[     ; On KS, all random interrupts are created equal.
BBLK
RINT1==:RINT
] ;IFN KS10P

IFE KS10P,[
R1NTAC: BLOCK 20
RINT1:  0
BBLK
        MOVEM 17,R1NTAC+17
        MOVEI 17,R1NTAC
        BLT 17,R1NTAC+16
        MOVEI J,1
        JSP E,SPUR
        MOVSI 17,R1NTAC
        BLT 17,17
        JRST 12,@RINT1
] ;IFE KS10P
\f
IFE KS10P,[     ;KS10 HAS NO MAR

PCMARB:
IFN KA10P,[
        HLLZ B,UPOPC(U) ;FLAGS
        LSH B,5
        HRR B,UPOPC(U)  ;PC
        MOVE T,B
        XOR T,CLKBRK    ;DID PC CHANGE FROM START OF INST TO PLACE TRAPPED?
        TDNE T,[#<%PCFPD,,>]
         TLO B,(@)      ;YES, INSTRUCTION COMPLETED, FLAG FOR USER
] ;KA10P                ;LOSES FOR JSR .-1 WITH MAR AT .-1, BUT OTHERWISE OK
IFN KL10P,[
        MOVE B,CLKBRK   ;PC OF FAULTING INST IF USER, OR IOADCR IF EXEC
;       MOVEM B,UPOPC(U)        ;SOLELY FOR .OPC USER VAR
;NOTE- ON KL10 THE INSTRUCTION IS NEVER COMPLETED, DON'T SET 3.5
] ;KL10P
        TLNE B,%PCUSR
         JRST PCMAR1            ;USR MODE, USE PC FROM PAGER
        MOVE B,UUOH             ;EXEC MODE, USE USER PC (UUO)
        HRRI B,-1(B)
IFN KL10P,[     ;ON KL10 AVOID DOING AOS UUOH AT IOADCR
        MOVEM U,AC0S+U(U)
        MOVEI T,UUOER2
        MOVEM T,CLKBRK
];KL10P
PCMAR1: MOVEM B,UMARPC(U)
        TRO A,%PIMAR
        MOVEI B,0
IFN KA10P,      DPB B,[220300,,UPMAR(U)]        ;DISABLE MAR
IFN KL10P,      DPB B,[270400,,UPMAR(U)]        ;DISABLE MAR
        POPJ P,

] ;IFE KS10P

IFN KA10P,[
CPROC1: MOVE T,CLKBRK
        TLNN T,%PCUSR   ;SKIP IF FROM USER MODE
         JRST CPRUUO
        TRO A,%PI1PR    ;GIVE USER INTERRUPT
        POPJ P,

CPRUUO: MOVE T,[JRST ONEPROC]   ;ONE PROCEED INT. FROM EXEC. MODE
        MOVEM T,UEXIT   ;CLOBBER EXIT TO RUN SYS CALL TO COMPLETION
        POPJ P,

AROV:   TLZE T,400000
         TLNN T,%PCUSR
          JRST AROV2    ;NOT REALLY SET OR SET BY SYS
        MOVEM T,CLKBRK
        SKIPE PICLR(U)  ;SKIP IF INTERRUPTS TO USER NOT ENABLED
         TRO A,%PIARO   ;GIVE USER INTERRUPT
        POPJ P,

AROV2:  MOVEM T,CLKBRK
        POPJ P,

ARFOV:  TLZE T,40000
        TLNN T,%PCUSR
        JRST AROV2
        MOVEM T,CLKBRK
        SKIPE PICLR(U)
        TLO A,(%PIFOV)
        POPJ P,
] ;KA10P
\f
;;; HANDLE PARITY ERRORS.

CLKB1E: SETZM PARDIE    ;AT FIRST ASSUME THE PAR ERR ISN'T FATAL.
        CONO PI,PIOFF   ;TURN OFF WORLD
IFN KA10P, CONO PI,240000       ;RESET
IFN KL10P,[             ;CLEAR THE CACHE
        SWPUA
        CONSZ 200000
         JRST .-1
] ;KL10P
IFN KS10P,[
        CLRCSH                  ;Clear the cache
] ;KS10P
        MOVSI B,SCLPAR
        TDNE B,SUPCOR   ;IF PREV ERROR NOT PRINTED, PRINT IT NOW AND PAUSE
         BUG PAUSE,[TOO MANY PARITY ERRORS.  PREV STATUS=],DEC,PARCNT,OCT,PARAAN,OCT,PARAOR,OCT,PARAND,OCT,PARIOR
        IORM B,SUPCOR   ;TELL SYS JOB TO PRINT OUR DATA WHEN WE FINISH.
        AOS PARERR      ;COUNT # OF PAR ERRS SINCE SYSTEM STARTED.
        SETOM PARAND    ;INIT LOGAND AND LOGOR OF ALL BAD DATA WORDS
        SETZM PARIOR
        SETOM PARAAN    ;AND SIMILAR FOR ADDRESSES OF PAR ERRS.
        SETZM PARAOR
        MOVE T,CLKBRK
        MOVEM T,PARPC
        MOVE T,USER
        MOVEM T,PARUSR  ;REMEMBER WHICH JOB GOT THE PAR ERR.
        JUMPL T,PARSCJ  ;PAR ERR IN NULL JOB? OR WHAT?
IFN KL10P,[
        SKIPE PARRSN            ;PAR ERR IN WORD NOT REFERENCED
         JRST PARSCJ            ; SHOULDN'T SCREW THE RUNNING JOB
] ;KL10P
        CAIG T,LUBLK
         SETOM PARDIE           ;PAR ERR IN A SUPERVISOR-MODE JOB IS HOPELESS.
        MOVSI TT,(%PIPAR)
        IORM TT,PIRQC(T)        ;GIVE RUNNING USER A PARITY ERROR (CLASS 1 INT)
PARSCJ: SPM PARPG
IFN KL10P,[
        PUSH P,PFNPC    ;MAKE SURE THE PAR ERRS WE DETECT WHILE SCANNING DON'T
        MOVEI D,PARFX4  ;CALL US RECURSIVELY (ON KA, THAT'S DONE BY HAVING
        MOVEM D,PFNPC   ;CLKCHN OFF) 
] ;KL10P
IFN KS10P,[
        PUSH P,EPTP7N           ;Same hack for the KS except page fails trap
        MOVEI D,PARFX4          ;as a function of current PI level.
        MOVEM D,EPTP7N
] ;KS10P
        MOVEI D,0       ;POINTER TO ERROR BUFFER
        MOVSI TT,-TSYSM
        PUSHJ P,PARSCN  ;SCAN MAIN MEM BLOCKS
IFN PDP6P,[
        MOVE TT,[-LPDP6M,,PDP6BM_-10.]  ;SCAN PDP6 MEM FOR PARITY ERRORS
        SKIPGE PDP6UP                   ;BUT NOT IF PDP6 IS DOWN.
         PUSHJ P,PARSCN
]
IFN KL10P,[
        POP P,PFNPC
        CONO 024400+APRCHN      ;CLEAR PAR ERR FLAGS.
] ;KL10P
IFN KS10P,[
        POP P,EPTP7N
        CONO 020200+APRCHN      ;CLEAR FLAG
        MOVSI A,%KEHLD+%KEREF   ;CLEAR STATUS AND ERROR ADDR
        IOWR A,[KSECCS]
] ;KS10P
        MOVEI A,0
        DPB A,[.PAREP+EXEUMP]
        LPMR PARPG      ;SET UP MAP WITH PARPG SET TO MPV.
        MOVEM D,PARCNT  ;SAVE AWAY COUNT OF ERRORS IN BUFFER
        SKIPE PARDIE
         BUG HALT,[PARITY ERROR IN SYSTEM MEMORY.  CNT=],DEC,PARCNT,[ADR AND ],OCT,PARAAN,CR,0,[  ADR IOR ],OCT,PARAOR,[DATA AND ],OCT,PARAND,[DATA IOR ],OCT,PARIOR
                        ;FATAL ERROR (DONT ALLOW CONTINUE SINCE ERR IS
                        ;KNOWN TO BE A LOSER)
        CONO PI,PION    ;TURN WORLD BACK ON
        JRST SCHED
\f
PARSCN:
PARFX3: HRRZ T,TT       ;SCAN AOBJN POINTER IN TT
        CAIL T,TSYSM
        JRST PARFX7
        LDB T,[MUR,,MEMBLT(TT)]
        CAIN T,MUHOLE
        JRST PARFX8     ;HOLE THERE
PARFX7: MOVEI T,600000(TT)      ;NOTE THAT WE ARE NOT ENABLING THE CACHE.
        DPB T,[.PAREP+EXEUMP]   ;ON KL10 THIS WILL CAUSE A 1-WORD READ.
        LPMR PARPG      ;SET UP TO CHECK PAGE # IN TT
        MOVEI B,0       ;ADDRESS WITHIN PAGE
PARFX1:
IFN KA10P, CONO PI,200000       ;CLEAR PAR ERR
PARFX5: MOVE C,400000+PAREP*2000(B)     ;REFERENCE EVERY MEMORY LOCATION
IFN KA10P,[
        ;;ON KA, MUST CHECK EXPLICITLY.
        ;;ON KL AND KS, PAR ERR WILL TRAP RIGHT TO PARFX4.
        CONSZ PI,200000 ;PARITY ERR? 
         JRST PARFX4    ;YES. 
] ;KA10P
        CAIGE B,1777    ;SKIP ON FINISHED WITH BLOCK
         AOJA B,PARFX5
PARFX8: AOBJN TT,PARFX3 ;CHECK NEXT PAGE
        POPJ P,         ;DONE
\f
PARFX4:         ;HERE WHEN THE SCAN FINDS A WORD WITH BAD PARITY
IFN KL10P, HRRZ T,PFOPC
IFN KS10P, HRRZ T,EPTP7O
IFE KA10P,[
        ;;DID THIS TRAP COME FROM SCAN LOOP WHERE WE EXPECT THEM?
        CAIE T,PARFX5
         JRST 4,.
        AC7CTX
        UMOVE C,0       ;GET CONTENTS OF LOCATION WITH BAD PARITY
        SYSCTX
] ;IFE KA10P
        SETO T,         ;MAKE SURE T ISN'T ACCIDENTALLY 0 AT PARFX6.
        HRRZ E,TT
        LSH E,10.
        IOR E,B ;MAKE MEM ADR
        CAIGE E,20      ;PAR ERR IN SHADOW ACS ISN'T SERIOUS.
         JRST PARFX6
        ANDM E,PARAAN   ;UPDATE ANDS AND ORS OF DATA AND ADRS
        IORM E,PARAOR
        ANDM C,PARAND
        IORM C,PARIOR
        MOVE A,USRHI
        CAIGE E,USRSTG(A)
         SETOM PARDIE   ;PARITY ERROR IN EXEC CORE
        HRRZ T,TT
        CAIL T,TSYSM
         JRST PARFX6
        LDB T,[MUR,,MEMBLT(TT)]
        CAIE T,MUFR
         CAIN T,MUINP
          JRST PARFX6
        CAIE T,MUDISB
         CAIN T,MUFRT
          JRST PARFX6
        CAIN T,MUDDT
         JRST PARFX6
        SOJE T,PARFX6   ;USER
        SETOM PARDIE    ;ERR IN CRITICAL MEMORY (DISK DIR, ETC)
PARFX6: MOVEM C,400000+PAREP*2000(B)    ;FIX UP MEMORY AS BEST WE CAN
        MOVEM C,PARCON(D)       ;SAVE LOSING CONTENTS
        MOVEM E,PARADR(D)       ;SAVE LOSING ADDRESS
        CAIL D,MXPARS-1 ;OVERFLOWING BUFFER?
         SOS D          ;JUST DON'T CLOBBER STUFF. AT LEAST PARAND, ETC. WILL BE VALID.
        JUMPN T,PARFX9
        PUSH P,D        ;PAR. ERR IN USER MEMORY,
        HRRZ D,TT
        CAIL D,TSYSM
         JRST PARFXA
        PUSHJ P,UCPRL4  ;HAS ANY JOB WRITTEN IN THIS PAGE?
         400000,,PARFU1
        JUMPL D,PARFXB  ;SOMEONE HAS; JUST GIVE EVERYONE AN INTERRUPT.
        PUSHJ P,UCPRL4  ;DOES MMP SAY PAGE WAS WRITTEN? IF SO, SET SIGN(D);
         200000,,PARFU2 ;OTHERWISE, SET MMPBAD, CAUSING PAGE TO BE RELOADED FROM DISK.
        JUMPGE D,PARFXA
PARFXB: PUSHJ P,UCPRL4  ;PAGE HAS BEEN WRITTEN SINCE LAST ON DISK, SO WE CAN'T ESCAPE
         400000,,PARFU3 ;GIVING EVERY JOB AN INTERRUPT.
PARFXA: POP P,D
PARFX9: AOS B                   ;INCREMENT B HERE SO YOU DON'T HACK THE SAME
                                ; WORD AGAIN.  IF THAT WORD WAS SOLIDLY BAD,
                                ; THIS CODE WOULD LOOP
        CAIG B,1777             ;MIGHT BE DONE WITH PAGE
         AOJA D,PARFX1
        AOJA D,PARFX8

PARFU1: CAIG U,LUBLK
         SETOM PARDIE   ;SYS JOB OR CORE JOB HAS PAGE
        PUSH P,Q
        MOVE A,I        ;FIND PAGE-MAP HALFWORD FOR THIS PAGE
        PUSHJ P,UPLC
        POP P,Q
        LDB A,T
        LSH A,-20
        CAIE A,1        ;MAP SET UP TO A PAGE, AND IN READ-ONLY MODE?
         JRST PARFU5
        DPB A,T         ;YES, UNMAP IT SO THAT NEXT ACCESS WILL TRAP AND GO TO CFHPB
        SOS MMSWP(D)    ; IN CASE WE WILL SET MMPBAD.
                ;NOTE, THIS MAY CRASH THE SYSTEM IF THE JOB WAS RUNNING IN A UUO,
                ;HAD CHECKED ACCESS TO THE PAGE, AND WAS ASSUMING IT COULD ACCESS
                ;IT AGAIN SAFELY.  USUALLY THIS ONLY HAPPENS WHEN WRITING, HOWEVER.
IFN SWPWSP,             ;DON'T BOTHER ADJUSTING WORKING SET.  WILL BE FIXED ON NEXT SWAPIN.
PARFU5: CAIL A,3
PARFU4:  TLO D,400000   ;IF THIS JOB HAS WRITTEN THE PAGE, SET SIGN (D)
        POPJ P,         ;TO SIGNAL THAT SETTING MMPBAD IS NO USE.

PARFU2: MOVE T,(C)      ;C HAS ADDR OF MMP ENTRY; HAS PAGE BEEN WRITTEN BY A JOB
        TLNN T,MMPWRT   ;THAT NO LONGER HAS IT IN MAP?
         TLNN T,MMPWOD  ;OR HAS IT NEVER BEEN ON DISK?
          JRST PARFU4   ;IF SO, AVOID SETTING MMPBAD, AND INTERRUPT EVERYONE.
        HLRZ T,1(C)
        JUMPE T,PARFU4  ;DITTO IF THERE IS NO DISK SPACE ASSIGNED.
        MOVSI T,MMPBAD
        IORM T,(C)
        POPJ P,

PARFU3: MOVSI T,(%PIPAR)
        IORM T,PIRQC(U)
        POPJ P,
\f
MEMHNG:
IFN PDP6P,[
        LDB B,[221100,,UPJPC(U)]        ;FAULT ADDR
        TRZN B,400              ;SKIP IF REFERENCE WAS VIA USER MAP
         JRST MEMHN1
        MOVEI C,UPGMP(U)
        ROT B,-1
        ADDI C,(B)
        HRLI C,PMLCAD           ;POINTER TO CORE ADR FIELD OF LH PAGE IN MAP WD
        SKIPGE B
         HRLI C,PMRCAD          ;RH MAP WD
        LDB C,B                 ;C GETS PAGE #
        CAIGE C,<PDP6BM_-10.>+LPDP6M
        CAIGE C,PDP6BM_-10.
         JRST MEMHN1
        MOVE B,CLKBRK
        TLNE B,%PCUSR
         JRST MEMHN3            ;USER MODE PDP6 NXM
        MOVEI B,IOCER3          ;PDP6 MEM
        HRRM B,CLKBRK
        JRST MEMHN2
]

MEMHN1:                 ;NXM
        ; JRST 4,.+1    ;COMMENTED OUT SINCE NXM STOP SHOULD ALWAYS BE SET.
MEMHN2:
IFN KA10P,CONO 10000+APRCHN     ;CLEAR NON EX MEM AFTER HALT TO RESET MEMORY
IFN KL10P,CONO 22000+APRCHN
IFN KS10P,[
        CONO 20400+APRCHN       ;Clear APR flag
        MOVSI B,%KEHLD+%KEREF   ;Clear saved error address
        IOWR B,[KSECCS]
] ;KS10P
        MOVSI B,SCLNXM
        TDNE B,SUPCOR           ;Haven't printed previous error?
         BUG PAUSE,[TOO MANY NXM ERRORS.]
        IORM B,SUPCOR
        MOVE T,CLKBRK
        MOVEM T,NXMPC
        MOVE T,USER
        MOVEM T,NXMUSR
        AOS NXMERR
        POPJ P,

IFN PDP6P,[
MEMHN3: MOVSI B,%PIMPV  ;PDP6 NXM GIVE MPV INTERRUPT
        IORM B,PIRQC(U)
        JRST MEMHN2
]
\fSUBTTL SLOW CLOCK SERVICE ROUTINE

OVHMTR SLW      ;SLOW CLOCK

SSLCK:  SKIPGE SHUTDN   ;SYSTEM "DEAD" =>
         PUSHJ P,COFFIN ;GO TO DDT AFTER RIGOR MORTIS SETS IN.
        SETCMB A,SCKPHS ;CHECK SYSTEM CHECKSUMS EVERY OTHER SLOW CLOCK TICK
        MOVE T,SUPCOP   ;WHICH IS ONCE PER SECOND.
        SKIPE A
         IORM T,SUPCOR
IFN KS10P,[
        CONSO 100               ; Check for memory ECC corrected errors
         JRST SSLCK0
        IORD A,[KSECCS]         ; A: status and error addr
        MOVEM A,ECCERA          ; Remember most recent one
        AOS ECCERR              ; Also count 'em
        CONO 20100+APRCHN       ; Clear memory ECC APR flag 
        MOVSI T,%KEHLD+%KEREF   ; Clear status and error addr
        IOWR T,[KSECCS]
        MOVE T,A
        AND A,ECCAND            ; A: AND of previous errors
        IOR T,ECCIOR            ; T: IOR of previous errors
        CAMN A,ECCAND           ; If either changes, this is news.
         CAME T,ECCIOR
          BUG INFO,[MEMORY: ECC CORRECTED ERROR],OCT,ECCERA
        MOVEM A,ECCAND
        MOVEM T,ECCIOR
SSLCK0: ] ;IFN KS10P
IFN NETP,PUSHJ P,NETCLK ; Run 1/2 sec clock routines for various net stuff
IFN NETYS, SETOM DTECHK         ;TELL 11 WE'RE ALIVE
IFN DPKPP,[
        CONSO DPK,7
         CONO DPK,TTYCHN        ;CROCK - IF DPK LOSES ITS PIA, GIVE IT BACK.
]
        MOVE A,UTTBF
        CAIGE A,30
         JRST SSLCK2
        SETOM UTBFLF    ;SIGNAL CORE JOB TO FLUSH UTAPE BUFFERS
        AOS NCORRQ
SSLCK2: SKIPE UTTYCT    ;SKIP IF NO NEW USERS
         SKIPL TREESW   ;SKIP UNLESS SOMEBODY'S MUNGING THE TREE STRUCTURE.
          CAIA
           PUSHJ P,USTART ;NEW USER TO START
IFN 340P,[
        SKIPL T,DWDS
         MOVEI T,0
        ADDI T,MDISWD
        MOVEM T,DWDS    ;RESET DISPLAY RATE COUNTER
]
        CONO PI,UTCOFF  ;UTC OFF WHILE HACKING UTAPE, MTAPE, DISK, ETC.
IFN RH10P+RH11P,[
        SKIPLE USFHLT
         SOS USFHLT
];RH10P+RH11P
IFN NUNITS,[
IFE NEWDTP,[
        MOVE T,TIME
        AOSN UIDLE      ;SKIP IF DEC TAPE NOT IDLE
         JRST [MOVEM T,LUTOTM ? JRST SSLCK1]    ;DEC TAPE IDLE
        SUB T,LUTOTM    ;SUBTRACT LAST UTC OPERATION TIME
        CONSO UTC,4000
         CAIGE T,MXOPT*SCLKI    ;SKIP IF DEC TAPE HUNG TOO LONG ON ONE OPERATION
          JRST SSLCK3   ;OK
        SETOM UTHERR    ;SET UTC HUNG ERR FLAG
SSLCK1: CONO UTC,CUINT  ;CAUSE DEC TAPE INTERRUPT ROUTINE TO RUN
SSLCK3:
]
IFN NEWDTP,[
        MOVE T,TIME
        AOSN UIDLE
         JRST [MOVEM T,LUTOTM ? JRST SSLCK1]
        SUB T,LUTOTM
        CAIGE T,MXOPT*SCLKI
         JRST SSLCK3
        SETOM UTHERR
SSLCK1: SETOM CUINT
        CONO PI,UTCRQ
SSLCK3:
]]      ;END IFN NUNITS
        SKIPL QSDU              ;IF DISK TRANSFER IN PROGRESS
         JRST [ MOVE T,LQTM     ;SEE IF IT'S TAKING UNREASONABLY LONG TIME
                ADDI T,5*30.
                CAMGE T,TIME
                 PUSHJ P,QHUNG  ;YES, UNHANG THE DISK
                JRST .+1 ]
IFN T300P,[
        SKIPL QSDU1             ;IF TRANSFER IN PROGRESS ON OTHER CONTROLLER
         JRST [ MOVE T,LQTM1    ;SEE IF IT'S TAKING UNREASONABLY LONG TIME
                ADDI T,5*30.
                CAMGE T,TIME
                 PUSHJ P,QHUNG1 ;YES, UNHANG THE DISK
                JRST .+1 ]
];T300P
IFN DC10P, PUSHJ P,QRCTMO       ;RECALIBRATE TIMEOUT
        CONO PI,UTCON
        PUSHJ P,QSTRTR          ;WAKE UP DISK ROUTINES
IFN NMTCS, PUSHJ P,MSTRTR       ;WAKE UP MAG TAPE ROUTINES (MUST BE SEPARATE INTR)
;DROPS THROUGH
\f
;DROPS IN
IFG NMTYS,[                     ;TRY TO UNHANG MORTON TTY CARDS
        MOVE I,[-NMTYS,,NFMTY]
        MOVE T,TIME
        SUBI T,60.      ;IF HAVEN'T TYPED FOR 2 SECONDS
SSLCM1: SKIPL TTYOAC(I) ;YET SUPPOSED TO BE TYPING
         CAMGE T,TTLTM(I)
          JRST SSLCM2
        CONO PI,TTYOFF-1
        CONO MTY,@TTYLT(I)      ;SELECT THE LINE
        DATAO MTY,[0]           ;AND BANG ON IT
        CONO PI,TTYON-1         ;MAYBE IF WE'RE LUCKY ITS DONE FLAG WILL COME ON 
SSLCM2: AOBJN I,SSLCM1
]               ;END IFG NMTYS
IFN IMPP,[
IFN KAIMP, CONI IMP,IMPCNI      ;KEEPS HOST READY ON
IFE KSIMP,[
        ;KS doesn't drop interrupts, I hope
        PUSHJ P,IMPOST          ;START UP OUTPUT
]
IFN NCPP,[
        SKIPLE IMNCS
         PUSHJ P,IMPCCL         ;CLOSE NETWORK CHANNELS
        SKIPLE IMNAS
         PUSHJ P,IMPAAA         ;WAKE UP STYS THAT NEED IT
];NCPP
        SKIPGE IMPTCU           ;IF IMP IS TRYING TO COME UP
         AOSE IMPUCT            ;AND UP-COMING TIMEOUT EXHAUSTED
          JRST SSLCK8
        BUG INFO,[NET: TIMED OUT TRYING TO COME UP]
        MOVEI A,1               ;THEN MAKE IT STAY DOWN
        MOVEM A,IMPUP           ;IF THIS IS ML-KA THE IMP CABLE PROBABLY BROKE AGAIN
SSLCK8:
];IMPP
IFN PDP6P,[
        SKIPL PDPISR
         CONO DSDEV,DSDCHN      ;ENABLE INTERRUPTS FROM 6
];PDP6P
IFN NETYS,[
        SKIPE DTEBBY
         SOSL DTEBBT
          JRST .+3
           BUG CHECK,[TTY: TIMEOUT ON OUTPUT XFER TO DTE, DTEBBY],OCT,DTEBBY
           SETZM DTEBBY
];NETYS
IFN N11TYS,[
;SEE IF THE TV PDP11 WANTS TO GO DOWN.
        SKIPN TEN11F    ;PROVIDED THE PDP11 IS THERE,
         SKIPN TT11P    ;AND WE'RE TRYING TO USE IT,
          JRST SSLCK5
        LDB A,[061600,,TT11HA]  ;DOES 11 WANT WHO LINES UPDATED?
        CAIL A,2000*NTTPG       ;RANGE CHECK SO CLOBBERED 11 MEMORY DOESN'T CAUSE ILL MEM REF
         BUG HALT,[GARBAGE POINTER IN TV-11 MEMORY]
        SKIPGE 1+400000+TTPG0*2000(A)
         JRST [ MOVEI T,SCRWHO  ;YES
                IORM T,SUPCOR
                CLEARM 1+400000+TTPG0*2000(A)
                JRST .+1]
        SKIPE TT11DN    ;IF IT IS REQUESTING TO GO DOWN,
         JRST SSLCK5
        SETZM TT11P     ;DON'T USE IT & WAIT FOR IT TO RE-INIT,
        MOVSI T,1
        MOVEM T,TT11DN  ;GIVE IT OUR PERMISSION TO GO DOWN.
        MOVEI T,SCR11D  ;CAUSE "11 DOWN" MESSAGE
        IORM T,SUPCOR
SSLCK5: SKIPN TEN11F
         SKIPG TT11P    ;WAITING FOR 11 TO BE UP?
          JRST SSLCK6
        SKIPN TT11UP    ;SKIP ON 11 UP
         JRST SSLCK6
        MOVEI T,SCR11U
        IORM T,SUPCOR   ;INIT THE TTYS
SSLCK6:
]
        SKIPLE T,AGERTE ;IF IT'S ENABLED, AGE SOME PAGES
         PUSHJ P,AGE
;DROPS THROUGH
\f
;DROPS IN
IFN DL10P,[
        SKIPN DL10F
         JRST SSLCKA
        SETOM DL10UP    ;COULD ALSO CHECK WHETHER PDP11 IS INCREMENTING THIS.
        DATAI DLC,A
        TRNE A,20       ;SEE IF PDP11 HALTED.
         JRST SSLCKA
        BUG INFO,[I/O PDP11 WENT DOWN]
        SETZM DL10F
        MOVEI T,%TYDL
        MOVSI A,-NCT
        TDNE T,TTYTYP(A)
         SETOM TTYOAC(A)
        AOBJN A,.-2
SSLCKA: ]
        AOS QACTTM              ;Bump this for benefit of QSK dir writers.
        SKIPN SWPOPR            ;If there is a request to swap out pages
         SKIPE SOLNG            ; or if there are pages now going out
          JRST SSKQ2            ; do not bother with LMEMFR, warnings.
        MOVN A,LMEMFR           ;See how many free low-memory pages.
        ADD A,MINCOR
        JUMPLE A,SSRCK          ;Okay
        AOS NCORRQ              ;Wake up core job to do some shuffling
        SUB A,MEMFR
        ADD A,LMEMFR            ;Core wanted minus high free
        SKIPLE A
         ADDM A,SWPOPR          ;Swap out to make room.
;Check to see if we are running out of various resources.
;RSWTIM is a timestamp of last warning, initialized by DATIM6 and PDDCHK.
SSRCK:  MOVE A,RSWTIM           ;Get time we last checked.
        ADDI A,2*30.
        CAML A,TIMOFF           ;If we checked less then 30 secs ago
         JRST SSKQ2             ; don't deluge the console.
        MOVE A,TIMOFF           ;Else remember that we are cheking now.
        MOVEM A,RSWTIM
        MOVEI A,5               ;There should be at least 5 free low pages.
        CAMLE A,LMEMFR          ;If there are not, print warning.
         BUG INFO,[Warning: Just ],DEC,LMEMFR,[ free pages in low core.]
        SKIPN QFCHN             ;Check disk channels.
         BUG INFO,[Warning: No free qsk channels.]
        MOVN A,USRHI            ;Check job slots.
        IDIVI A,LUBLK
        ADDI A,MAXJ
        SKIPN A
         BUG INFO,[Warning: System full - no job slots.]
SSKQ2:
IFN 340P,[
        SKIPL DISUSR
         PUSHJ P,DISCHK ;CHECK FOR 340 DEATH
]
        PUSHJ P,PDCCHK  ;CHECK ON REAL-TIME HACKS
IFN PTRP,[
        PUSHJ P,PTRCHK  ;CHECK ON PAPER TAPE READER
        PUSHJ P,PTPCHK  ;CHECK ON PAPER TAPE PUNCH
] ;PTRP
IFE KS10P,[     ; Silly KS10 doesn't have devices...
        SKIPN CCSDEV
         JRST SCDCK3
        SETZM CCSDEV
        MOVSI I,-128.
SCDCK1: SKIPGE A,DCHNTC(I)
         TLNE A,300000
          JRST SCDCK2
        AOS CCSDEV
        SUB A,[1,,]
        TLNN A,777
         TLZ A,400000
        MOVEM A,DCHNTC(I)
SCDCK2: AOBJN I,SCDCK1
SCDCK3:;        JSP E,CHECK     ;CHECK FOR CLOBBERED DEVICES
] ;IFE KS10P
IFN NLPTP,[
        CONO PI,LPTOFF
        MOVE A,NLPTBR           ;IF LPT OUTPUT BUFFER NOT EMPTY
        CAIN A,LPTBSZ
         JRST [ CONSZ NLPT,100  ;AND LPT IS READY
                 CONSZ NLPT,7   ;BUT HAS NO PIA
                  JRST .+1
                CONO NLPT,LPTCHN ;THEN IT LOST AGAIN
                AOS NTNLPL      ;COUNT NUMBER OF TIMES NEW LPT LOST
                JRST .+1 ]
        CONO PI,LPTON
]
IFN ECCMEM,[
;THIS ASSUMES THAT THE PDP-10/XBUS ADDRESS OFFSET IS ZERO
ECCLOG: MOVE B,400000+ECCPG*2000+1760
        LSH B,-32.
        CAMN B,ECCIDX           ;DID ECC HISTORY POINTER ADVANCE?
         JRST ECCLG9
        AOS A,ECCIDX            ;YES, GET NEXT WORD FROM ECC HISTORY
        MOVE B,400000+ECCPG*2000+1760-1(A)
        ANDI A,17               ;ADVANCE OUR COPY OF POINTER
        MOVEM A,ECCIDX
        LDB A,[240700,,B]       ;SYNDROME BITS
        TLZ B,777774            ;REDUCE B TO ADDRESS BITS
        BUG INFO,[MEM: ECC ERROR, ADDRESS ],OCT,B,[SYNDROME],OCT,A
        JRST ECCLOG             ;LOOK FOR MORE HISTORY

ECCLG9:
];ECCMEM
        PUSHJ P,GPDTIM          ;WHAT CALENDAR TIME IS IT?
         SETOB A,LPDTIM
        EXCH A,LPDTIM           ;REMEMBER IT FOR NEXT CLOCK TICK.
        JUMPL A,ALCR0           ;TIME NOT KNOWN THIS AND/OR LAST TICK => DO NOTHING
        SUB A,LPDTIM            ;ELSE HOW LONG HAS IT BEEN SINCE PREVIOUS TICK?
        CAML A,[-5*PDUPS]       ;MORE THAN 5 SECONDS? SHOULD ONLY BE 1/60
         JRST ALCR0             ;ONLY EXPLANATION IS ITS WAS STOPPED AND CONTINUED.
        SKIPL SYSDBG            ;SO UNLESS THAT'S NORMALLY EXPECTED
         PUSHJ P,DEATHM         ;TELL THE WORLD "ITS REVIVED"
        MOVE T,TIME             ;REMEMBER WHEN THIS LAST HAPPENED
        MOVEM T,RVVTIM

;DROPS THROUGH
\f
;DROPS IN
;DECAY VARIOUS EXPONENTIAL AVERAGES.  ON KA10, RUN IN ACS SINCE IT'S FASTER.
;ON KL10, DON'T, SINCE IT'S SLOWER.  ON KS10, DON'T, BECAUSE IT IS
;JUST AS FAST TO RUN IN THE ACS BUT IT WASTES TIME TO MOVE THE CODE
;INTO THEM.
ALCR0:  MOVSI U,-NCT
        SETZM SLOADU
IFN KA10P,[
        MOVE I,[ALCR1,,A]
        BLT I,I
        JRST A
] ;KA10P

ALCR1:  MOVN T,USRRCE(U)        ;A      ;DECAY USRRCE AVERAGES
        ASH T,-4                ;B
        ADDB T,USRRCE(U)        ;C
        CAMLE T,SLOADU          ;D      ;AND SET SLOADU TO HIGHEST USRRCE
         MOVEM T,SLOADU         ;E
IFN KA10P,[
        AOBJN U,A               ;TT
        JRST .+1                ;I
] ;KA10P
IFE KA10P, AOBJN U,ALCR1

        MOVN T,USRRCE+NCT
        ASH T,-4-2              ;DISOWNED JOBS (DECAY SLOWER)
        ADDB T,USRRCE+NCT
        IMULI T,1999.           ;MAKE COMMENSURATE WITH REGULAR USRRCE'S
        ASH T,-13.              ; (You might think that you could just
                                ; divide by 4, but in fact the ratio
                                ; between the two decay rates is
                                ; ln(64/63)/ln(16/15) = .24401474)
        ADDM T,SLOADU           ;DISOWNED TIME COULD HAVE BEEN USED BY REAL
                                ; USERS
        MOVN T,USRRCE+NCT+1
        ASH T,-4+1              ;SYS, CORE, AND SOME DAEMON JOBS (DECAY FASTER)
        ADDM T,USRRCE+NCT+1
        IRPS RCE,,LOSRCE IDLRCE
         MOVN T,RCE             ;LOST TIME AND IDLE TIME
         ASH T,-4
         ADDB T,RCE
         TERMIN
        ADDM T,SLOADU           ;IDLE TIME COULD HAVE BEEN USED BY USERS

IFE KS10P, MOVE A,[193682794.]  ; = 100. * 250000. * .5 / ln(16/15)
                                ; (100% of 250000. four usec ticks per second,
                                ; decaying by 16/15 every .5 second.)
IFN KS10P, MOVE A,[198524864.]  ; = 100. * 256250. * .5 / ln(16/15)
                                ; (256250. 3.9 usec ticks per second.)
; Used to be:
;       MOVE A,[100.*15.*125000.] ;100% DIVIDED BY MAXIMUM SINGLE TREE %
        ADD A,LOSRCE            ;WITH FUDGE FACTOR FOR LOST TIME
        IDIVM A,SLOADU          ;GIVES EFFECTIVE # OF COMPETITORS FOR MACHINE.
; It is possible for SLOADU to drop below 100. (giving a fair share greater
; than 100%).  This happens because the decay rate for disowned jobs is
; less than the decay rate for consoles.  If the load switches abruptly
; from the disowned jobs to some console, the resource word for the console
; fills up quicker than the disowned resource word decays, causing their
; sum to briefly exceed the maximum.  This would be hard to fix without
; introducing additional resource words just for better maintaining SLOADU.
;
; An additional odd effect:  If only disowned jobs are running, and a
; network server starts up, the fair share drops almost to zero.  This is
; because when such jobs are created, their resource word is zeroed to
; given them an initial priority boost.

        MOVEI T,0
IFN KA10P,[
        MOVE W,[ALCR4,,A]
        BLT W,W
        JRST A
] ;KA10P

ALCR4:  MOVN H,JTMU(T)  ;A
        ASH H,-4
        ADDM H,JTMU(T)
        MOVE H,MSKST(T)
        ANDI H,%PICLK   ;E
        SKIPE UNAME(T)  ;TT
         IORM H,PIRQC(T);I
        ADDI T,LUBLK    ;Q
        CAMGE T,USRHI   ;J
IFN KA10P,[
         JRST A         ;R
        JRST .+1        ;W
] ;KA10P
IFE KA10P, JRST ALCR4
;DROPS THROUGH
\f;DROPS IN
IFN SWPWSP,[
        MOVE U,USRHI
        SUBI U,LUBLK            ;ACCOUNT FOR I/O WAIT TIME IN USWPRI
        MOVSI T,%SWOUT+%SWPGW
IFN KA10P,[
        MOVE J,[ALCR5,,A]
        BLT J,J
        JRST A
] ;KA10P
ALCR5:  SKIPE UNAME(U)          ;A      ;IGNORE JOBS WHICH DON'T EXIST OR
         TDNE T,USWST(U)        ;B      ;ARE SWAPPED-OUT OR IN PAGE-WAIT
IFN KA10P, JRST I               ;C
IFE KA10P, JRST ALCR6
        SKIPN USTP(U)           ;D      ;CHARGE JOBS WHICH ARE STOPPED 
         SKIPE FLSINS(U)        ;E      ;OR BLOCKED
          JRST ALCR7            ;TT
ALCR6:  SUBI U,LUBLK            ;I      ;NEXT JOB
IFN KA10P,[
        JUMPG U,A               ;Q
        JRST .+1                ;J
] ;KA10P
IFE KA10P, JUMPG U,ALCR5
];SWPWSP
        SKIPGE 37       ;CHECK FOR PLANNED SYSTEM DEATH
         PUSHJ P,DEATH  ;ABOUT TO START DYING
          JFCL
        IRPS 4US,,[IDLTM1 LOSTM1 USRTM1 NULTM1]SEC,,[IDLTIM LOSTIM USRTIM NULTM3]
         MOVE A,4US     ;KEEP SYSTEM WIDE USAGES AS TWO WORDS
         IDIVI A,250000. ;ONE IN 4.069 USEC UNITS
         ADDM A,SEC     ;AND ONE IN SECONDS
         MOVEM B,4US    ;SO NO OVERFLOW
         TERMIN
        IMULI A,60.     ;CONVERT TO 60THS
        ADDM A,NULTIM   ;ADD TO 60THS USED (OBSOLETE)
        MOVEI T,SCLKI
        MOVEI C,SSLCKB
        JRST CLQREE     ;RE-ENTER RQ FOR SLOW CLOCK BREAK

IFN SWPWSP,[            ;JOB IN U NEEDS TO BE CHARGED FOR MEMORY USED WHILE BLOCKED OR STOPPED
ALCR7:  HLLO W,UWRKST(U)
        JFFO W,.+1      ;H GETS 19 - LOG(WORKING SET SIZE + 1/2)
        SUBI H,19.
        IMUL H,[-125000.] ;CHARGE FOR 1/2 SECOND OF MEMORY USAGE
        ADDM H,USWPRI(U)
IFN KA10P, JRST I
IFE KA10P, JRST ALCR6
];SWPWSP
\f
;SYSTEM IN FINAL THROES OF COMING DOWN, SEE IF IT'S OVER YET

COFFIN: MOVE T,NLOOSP           ;MUST SWAP OUT ALL LOOSE PAGES
        ADDB T,SWPOPR
        JUMPN T,CPOPJ           ;SWAPPAGE OUT STILL GOING ON
        MOVEI T,NQCHN+1+NQS-1
        SKIPGE QSGL(T)
         SOJG T,.-1
        SKIPL QSGL(T)           ;NOT OVER IF ANY DISK CHANNELS ARE ACTIVE
         POPJ P,
        MOVSI T,040000
        MOVE TT,QACTB   ;SEE IF DISK STUFF NOT OUT YET
        TDNE TT,QMDRO
         POPJ P,        ;MFD NOT OUT
        MOVSI A,-NQS
COFFI8: TDNE T,QTUTO(A)
         JRST COFFI9    ;TUT NEVER CAME IN
        TDNE TT,QTUTO(A)
         POPJ P,        ;TUT NOT OUT
COFFI9: AOBJN A,COFFI8
        MOVSI A,-QNUD
COFFI1: SKIPN QSNUD(A)
         JRST COFFI2
        TDNE TT,QSNLCN(A)
         POPJ P,        ;UFD NOT WRITTEN
COFFI2: AOBJN A,COFFI1

IFN NUNITS,[
        MOVSI A,-NUNITS
        SKIPGE UFLAPF(A)
         POPJ P,        ;TAPE STILL FLAPPING
        AOBJN A,.-2
]
        MOVE A,DTHTIM
        ADDI A,15.*30.  ;DON'T WAIT FOR CONSOLES MORE THAN 15 SECONDS
        CAMGE A,TIME    ;BECAUSE %TCHNG ISN'T NECESSARILY SET
         JRST COFFI3
        MOVEI A,NFSTTY-1        ;CHECK FOR REAL CONSOLES STILL TYPING OUT
        MOVSI T,%TCHNG  ;AND NOT HUNG (NEVER GOING TO FINISH TYPING OUT)
        TDNN T,TTYCOM(A)
         SKIPGE TTYOAC(A)
          SOJGE A,.-2
        JUMPGE A,CPOPJ  ;A CONSOLE IS STILL TYPING, DON'T GO DOWN YET
COFFI3: SKIPL A,SYSCN
         SKIPGE TTYOAC(A)
          CAIA
           POPJ P,      ;SYSTEM CONSOLE HAS A LOT OF TYPING TO DO
        MOVEI A,2*LUBLK
COFFI7: CAML A,USRHI
         JRST COFFI4
        SKIPE UNAME(A)
         POPJ P,        ;JOBS STILL EXIST
        ADDI A,LUBLK
        JRST COFFI7

;SYSTEM FULLY DOWN; GO TO DDT.
COFFI4: BUG DDT,[SHUTDOWN COMPLETE]
        SETZM SHUTDN            ;IF USER PROCEEDS, BRING SYSTEM BACK UP
        SETZM DEDTIM            ;ARRANGE TO RELOAD ATSIGN DRAGON
        SETZM FLSINS            ;BY RESTARTING SYS JOB WHERE IT DOES THAT
        MOVEI A,ISYS
        MOVEM A,UPC
        POPJ P,
\f
;ROUTINE TO AGE SOME PAGES.  THIS ROUTINE SLOWLY CIRCULATES THROUGH
;CORE.  IF IT TOUCHES A PAGE TWICE, AND NO USER HAS TOUCHED IT,
;THE PAGE GETS SWAPPED OUT.  ALSO FLUSHES PAGES NOT IN ANY USER'S MAP.
;ENTER WITH VALUE OF AGERTE IN T.

AGE:    MOVE TT,MEMFR
        CAIL TT,100
         POPJ P,        ;NO MEMORY COMPETITION, DON'T BOTHER
        ADD T,AGEREQ    ;INCREASE NUMBER OF PAGES NEEDING TO BE AGED
        CAIGE T,100     ; BUT DON'T LET IT GET INFINITELY HUGE
         MOVEM T,AGEREQ ; IF CIRPSW IS LOCKED FOR A LONG TIME
        SKIPN DLSRCH    ;IF MUSTN'T PCLSR ANYONE, OR
         SKIPL CIRPSW   ; IF CIRPSW LOCKED, HAVE TO WAIT UNTIL NEXT SLOW CLOCK
          POPJ P,
        LDB W,[121000,,HUSRAD]  ;DON'T AGE SYSTEM JOB (CIRC PNTRS NOT CONNECTED)
        MOVE A,AGEPOS   ;CONTINUE AGEING FROM WHERE LEFT OFF LAST TIME
        SKIPGE U,USER   ;CHECK FOR NULJOB
         JRST AGE0
        MOVE T,CLKBRK   ;PC FOR USER WHO MAY GET PCLSR'D
        MOVEM T,UPC(U)  .SEE SWOP2
        LPMR UPGML(U)   ;DON'T LEAVE SWAPPED OUT PAGES IN ASSOC MEM
AGE0:   CAIGE A,TSYSM
         CAMGE A,W
          MOVE A,W
        SOSGE AGEREQ
         JRST [ MOVEM A,AGEPOS ? SETZM AGEREQ ? POPJ P, ]
        AOS NAGES
        LDB T,[MUR,,MEMBLT(A)]
        CAIE T,MURUSR
         AOJA A,AGE0
        MOVE D,A
        PUSHJ P,UCPRL4
            SETZ AGE1
        MOVNI C,1       ;NO USERS ACTIVELY USING THIS PAGE, SWAP IT OUT
        PUSHJ P,SWPOPG
         JFCL
        AOJA A,AGE0

AGE1:   MOVEI C,UPGMP(U)
        MOVE T,I        ;DON'T CLOBBER I
        ROT T,-1
        ADD C,T
        HRLI C,222200
        SKIPGE T
         HRLI C,2200
        LDB T,C         ;GET PAGE MAP WORD
        TRNN T,600000
         POPJ P,        ;USER NOT CONNECTED TO THIS PAGE
        TROE T,PMAGEM
         POPJ P,        ;HASN'T TOUCHED THIS PAGE SINCE AGE BITS LAST SET
        DPB T,C         ;HAS TOUCHED PAGE, TURN AGE BITS BACK ON
        SUB P,[4,,4]    ;AND BACK OUT OF UCPRL
        AOJA A,AGE0
\f
IFN 340P,[

DISCHK: SKIPGE DISOFF
        POPJ P,
        AOSLE DISDIE
        SKIPGE CDISOFF
        POPJ P,
        MOVEI T,1
        MOVEM T,DTIME
DISZAP: MOVE T,[JSR DBLKPB]
        MOVEM T,40+2*DISCHN
        MOVEI T,DIS300-1        ;CAUSE 340 TO STOP AND INTERRUPT SOON
        MOVEM T,DBLKOP
        CLEARM DISOFF
        CONO DIS,5100+SDCHN_3+DISCHN
        POPJ P,
]

DEATH:  SKIPL SHUTLK
        POPJ P,
        SETZM 37        ;CLEAR START DYING FLAG
        MOVEI T,60.*5.*60.      ;5 MIN
        MOVEM T,DEDTIM
        LSH T,-1
        ADD T,TIME
        MOVEM T,SHUTDN
        PUSHJ P,CLQDEL
         DEDBLK
DEATHX: SKIPN T,DEDTIM
         POPJ P,
        AOS (P)
        MOVEI TT,0
        CAIGE T,40.*60.
         JRST DEATHY
        MOVE TT,T
        LSH TT,-2
DEATHY: MOVEM TT,DEDTIM
        SUB T,TT
        PUSHJ P,CLQADD
         DEDBLK
DEATHM: MOVEI A,%PIDWN
        PUSHJ P,INTALL  ;TELL THE WORLD
        MOVSI T,SCLSHD  ;CAUSE TYPE OUT ON UNLOGGED-IN CONSOLES
SUPSET: IORM T,SUPCOR
        POPJ P,

VSSLCK: MOVSI T,SCLVSK
        IORM T,SUPCOR   ;CAUSE VERY SLOW CLOCK TO RUN
        MOVEI T,VSCLKI
        MOVEI C,VSLCKB
        JRST CLQREE

IFN CCLKP,[
RCCLK:  DATAI 374,T     ;HACK CHESS CLOCK
        TRNE T,4000
         AOSA CCLK1
          AOS CCLK2
        MOVEI T,6
        MOVEI C,CCLKB
        JRST CLQREE
]

IFN N11TYS,[
WHOSET: MOVEI T,SCRWHO  ;CAUSE SYS TO UPDATE WHO LINES
        IORM T,SUPCOR
        MOVEI T,5.*60.-5  ;5 SECONDS MINUS A LITTLE SO DOESN'T SYNC WITH OTHER CLOCKS
        MOVEI C,WHOCLB
        JRST CLQREE
]
\f
SUBTTL SWAP SCHEDULER

OVHMTR SWS      ;SWAP SCHEDULER

;15 SECOND CLOCK
15SCLK:
IFN IMPP,       PUSHJ P,IMRSTO  ;RESET CONTROL LINK RFNM WAIT FOR LOSING IMP.

;RECOMPUTE SWAP BLOCK DATA.
;DECAY SWAP PRIORITIES (USWPRI AND SWRCE)
;RESET BEST-EFFORT-HAS-BEEN-MADE TO SWAP OUT BITS

        MOVSI B,%SWBEM  ;SET UP TO CLEAR "BEST EFFORT TO SWAP OUT BIT"
        SETOM SBEFLG    ;NOT YET DESPERATE ENOUGH TO TRY USERS WHOSE BEST EFFORT BITS ARE SET
IFE SWPWSP,[
        CLEARB T,NUSWB  ;# USERS LOCKED OUT
        SETOM BUSR      ;SMALLEST SWAPPED BLOCKED USER
        MOVE D,[37777,,777777]
        MOVEM D,BUSIZ   ;SIZE OF SMALLEST SWAP-BLOCKED USER.
        CLEARM ASBUM    ;REAL MEM OCC BY ACTIVE SWAPPED BLOCKED LOSERS
        MOVSI D,400000  ;TO CLEAR SWAPPED BLOCKED BIT
];SWPWSP
.ELSE   MOVEI T,LUBLK*2
15S1:   CAML T,USRHI
         JRST 15S2
        SKIPN UNAME(T)
         JRST 15S3
        MOVN C,USWPRI(T)
        ASH C,-2
        ADDM C,USWPRI(T)        ;DECAY JOB SWAP PRI'S
        MOVE C,NMPGS(T)
IFE SWPWSP,[
        SKIPE ENPZRO
         SUBI C,1       ;COMPENSATE FOR PAGE ZERO ALWAYS IN
];SWPWSP
        CAMLE C,NSWPGS(T)       ;SKIP ON NOT COMPLETELY OUT
         ANDCAM B,USWST(T) .SEE %SWBEM
IFE SWPWSP,[
        SKIPGE USWSCD(T)
         JRST 15S4      ;CLEAR SWAPPED BLOCK BIT AND MAYBE ADD TO AUSOPG AND TRUMM (IF HE WAS HUNG ON IT)
];SWPWSP
15S3:   ADDI T,LUBLK
        JRST 15S1

15S2:
IFE SWPWSP,[
        SKIPE ENSWSC
         PUSHJ P,SWSCD  ;SWAP BLOCK LOSERS IF NECESSARY
];SWPWSP
        MOVSI T,-NCT-2
15S5:   MOVN C,SWRCE(T) ;DECAY TREE SWAP PRI'S
        ASH C,-2
        ADDM C,SWRCE(T)
        AOBJN T,15S5
        MOVEI T,15.*60.
        MOVEI C,15SCLB
        JRST CLQREE

IFE SWPWSP,[
15S4:   ANDCAM D,USWSCD(T)      ;CLEAR SWAP BLOCK BIT
        SKIPN TT,FLSINS(T)      ;WAS HE HUNG TESTING IT
         JRST 15S3
        SUBI TT,(T)
        CAME TT,[SKIPGE USWSCD]
         JRST 15S3              ;HE WASN'T HUNG ON THIS
        CLEARM FLSINS(T)        ;HE WAS SO NOW HES ACTIVE
        MOVE TT,USWST(T)
        TLZE TT,%SWPGW
         SOS NPGWTU             ;FLSINS WAS SET BY PAGE FAULT, SO CONSIDERED
        TLZ TT,%SWBEM           ;TO BE WAITING FOR A PAGE
        MOVEM TT,USWST(T)
        MOVE TT,NMPGS(T)
        ADDM TT,TRUMM           ;GUY IS NOW RUNNABLE
        SUB TT,NSWPGS(T)        ;ANY PAGES HE MAY HAVE IN MEM NO LONGER BELONG TO A BLOCKED USER
        MOVNS TT
        ADDB TT,BUMPGS
        SKIPGE TT
         CLEARB TT,BUMPGS
        MOVE TT,NSWPGS(T)       ;ANY SWAPPED OUT PAGES BELONG TO AN ACTIVE USER
        ADDM TT,AUSOPG
        JRST 15S3
];SWPWSP
\f
IFE SWPWSP,[

PRVCLK: SKIPN ENPVCL
         JRST PRVCK4
        MOVSI B,%SWPRV
        SKIPL U,PRVUSR
         ANDCAM B,USWST(U)
        SETOM PRVUSR    ;TURN OFF CURRENT PRIVILEDGED USER
        MOVEI J,2*LUBLK
PRVCK1: CAML J,USRHI
         JRST PRVCK2
        SKIPN UNAME(J)
         JRST PRVCK3
        MOVE B,UTRNTM(J)        ;GET USER RUN TIME
        SUB B,LTRNTM(J)
        MOVE A,USIPRQ(J)
        SUB A,LSIPRQ(J)
        IMUL A,[NPVSEC*125000.] ;1/2 NUMBER OF 4 MICROSECOND INTERVALS IN THE PRIV INTERVAL
        SKIPE B
         IDIV A,B
        MOVE B,UPGSEC(J)
        LSH B,-1                ;DIVIDE LAST VALUE BY TWO
        ADD A,B
        MOVEM A,UPGSEC(J)       ; LAST/2 + CURRENT
        MOVE A,UTRNTM(J)
        MOVEM A,LTRNTM(J)
        MOVE A,USIPRQ(J)
        MOVEM A,LSIPRQ(J)       ;SAVE OLD VARIABLES
PRVCK3: ADDI J,LUBLK
        JRST PRVCK1

PRVCK2: PUSHJ P,NPRVUS  ;GET NEXT PRIV USR
PRVCK4: MOVEI T,NPVSEC*60.
        MOVEI C,PRVCLB
        JRST CLQREE

NPRVUS: MOVEI J,2*LUBLK
        SETOM U
        MOVNI T,30.*2   ;DON'T LET A BLOCKED OR STOPPED PERSON BE PRIVILEDGED
        ADD T,TIME
        MOVE B,PRVCUT
        HRLOI E,377777
NPVUS1: CAML J,USRHI
         JRST NPVUS2
        CAMGE T,LUBTM(J)        ;BLOCKED TOO LONG?
         SKIPN UNAME(J)
          JRST NPVUS3
        CAMG B,UPGSEC(J)
         CAMG E,LPRVTM(J)
          JRST NPVUS3
        MOVE U,J
        MOVE E,LPRVTM(J)
NPVUS3: ADDI J,LUBLK
        JRST NPVUS1

NPVUS2: MOVEM U,PRVUSR
        SKIPG U
         POPJ P,
        MOVSI B,%SWPRV
        IORM B,USWST(U)
        MOVE T,TIME
        MOVEM T,LPRVTM(U)
        POPJ P,
];SWPWSP
\f
IFE SWPWSP,[
IFNDEF MEMSYS,MEMSYS==50        ;GUESS AT AMOUNT OF MEM SYSTEM NEEDS
IFNDEF MEMSY1,MEMSY1==50        ;AMOUNT OF MEM ANY ONE USER MUST LEAVE TO "FIT".

SWSCD:  MOVE E,TRUMM    ;SEE IF NECESSARY TO SWAP BLOCK SOMEONE
        CAIGE E,TSYSM-SYSB-MEMSYS
        POPJ P, ;NO SHOULD FIT
        MOVE E,MEMFR
        SUB E,NCBCOM
        ADD E,SOLNG
        SUB E,SILNG
        SUB E,AUSOPG
        ADD E,BUMPGS    ;WILL SWAP OUT BLOCKED USERS FIRST
        ADD E,ASBUM
        SUBI E,20       ;SLOP
        JUMPGE E,CPOPJ  ;SHOULD HAVE ROOM FOR EVERYBODY
        MOVMM E,SWSCT1  ;SAVE # PGS REQ
        MOVNI E,1       ;NEED TO GRONK USER (MAYBE)
        CLEARB T,TT     ;TT SWP PRI OF PROCESS
        MOVEI R,0       ;R SWP PRI OF TREE
SWSCP1: CAML T,USRHI
        JRST SWSCP2
        SKIPE UNAME(T)
        SKIPE USTP(T)
        JRST SWSCP7
        SKIPGE USWSCD(T)
        JRST SWSCP7     ;GUY ALREADY LOCKED OUT
        SKIPE FLSINS(T)
        JRST SWSCP4     ;SEE IF REALLY BLOCKED OR JUST PAGE WAIT
SWSCP5: MOVE B,UTMPTR(T)
        CAML R,SWRCE-USRRCE(B)
        CAMG TT,USWPRI(T)
        JRST SWSCP6     ;THIS GUY A BIGGER LOSER THAT PREV BIGGEST
SWSCP7: ADDI T,LUBLK
        JRST SWSCP1

SWSCP6: MOVE E,T
        MOVE R,SWRCE-USRRCE(B)
        MOVE TT,USWPRI(T)
        JRST SWSCP7     ;GUY REALLY BLOCKED

SWSCP4: MOVE B,USWST(T)
        TLNE B,%SWPGW
         JRST SWSCP5
        JRST SWSCP7


SWSCP2: JUMPL E,CPOPJ   ;NO VICTIM
        MOVE B,NMPGS(E)
        CAIGE B,TSYSM-SYSB-MEMSY1
        JRST SWSCP9     ;"SMALL LOSER"
        SUB B,NSWPGS(E)
        CAMLE B,SWSCT1  ;SKIP ON WILL STILL NEED TO BLOCK MORE LOSERS
        POPJ P,
SWSCP9: MOVSI B,400000
        IORM B,USWSCD(E)        ;SWAP BLOCK LOSER
        AOS NUSWB
        AOS NTUSB
        MOVE TT,NMPGS(E)
        CAMLE TT,BUSIZ
        JRST SWSCP8
        MOVEM TT,BUSIZ
        MOVEM E,BUSR
SWSCP8: SUB TT,NSWPGS(E)
        SOSGE TT
        MOVEI TT,0
        ADDM TT,ASBUM   ;THIS GUY SWAPPED BLOCKED
        MOVN TT,NMPGS(E)
        ADDM TT,TRUMM   ;DOESNT COUNT ANY MORE
        SKIPGE TRUMM
        CLEARM TRUMM
        MOVN TT,NSWPGS(E)
        ADDM TT,AUSOPG  ;NOT REALLY ACTIVE ANY MORE
        JRST SWSCD      ;SEE IF THATS ENUF
];SWPWSP
\f
OVHMTR PPI      ;PPIUM

;PUT PAGE INTO USERS' MAPS (OF ALL USERS THAT ARE CONNECTED VIA CIRCULAR POINTERS)
;ALSO UPDATES THE WORKING SETS.
;CALL WITH PAGE NUMBER IN A, STARTING BYTE POINTER IN C, AND TDNE T,MMP IN D.
;SMASHES T,H,I,U,E,TT,C
PPIUM:  AOS NPPIUM
IFN SWPWSP,[
        MOVEI E,0       ;COUNT USERS OF THE PAGE
        PUSHJ P,UCPRL
            400000,,[AOJA E,CPOPJ]
        HRRM E,MMSWP(A) ;ALL THESE SHARERS WILL BE CONNECTED TO THE PAGE
        MOVSI T,1       ;COMPUTE WORKING SET ADJUSTMENT
        IDIVM T,E       ;I.E. 1 OVER NUMBER OF SHARERS
];SWPWSP
        PUSHJ P,UCPRL   ;GIVE PAGE TO ALL USERS WAITING FOR IT
            400000,,PPIUM1
        POPJ P,

;SET UP MAP TO MEMBLT INDEX IN A
PPIUM1: AOS NPPIU1
        CAIG U,LUBLK
         BUG            ;SYS JOB OR CORE JOB
        PUSH P,I
        MOVEI C,UPGMP(U)
        ROT I,-1
        ADDI C,(I)
        HRLI C,222200
        SKIPGE I
         HRLI C,2200
        LDB I,C
        JUMPE I,[JRST 4,.]      ;DOESN'T REALLY EXIST?
        MOVSI T,MMPPGA          ;DON'T REALLY PUT IN MAP IF PAGE-AHEAD PAGE.
        TDNE T,(D)              ;JUST PRE-EMPT.
         JRST QSWI2A
        TRNE I,600000           ;DO NOTHING IF ALREADY IN MAP.
IFE E.SP,[
         JRST QSWI2     ;ALREADY IN MAP, POSSIBLE AS A RESULT OF RIDICULOUS TIMING ERROR
]
IFN E.SP,[
         JRST E.SPGJ    ; CHECK E&S WANTS READ/WRITE FIRST FIX
]
        SOS NSWPGS(U)   ; NUMBER OF SWAPPED-OUT PAGES
        SOS SNSWPG      ;DECR CNT OF SWAPPED OUT FOR SYS
        SKIPN (P)       ;DON'T SET UP PG 0 AS R-W-F.
         JRST QSWI3
        TRNE I,2
         MOVEI I,2      ;SET READ/WRITE TO READ/WRITE/FIRST
QSWI3:  LSH I,16.
        IORI I,PMCSHM(A);BRING IN ADDRESS AND CACHE BITS
        DPB I,C
QSWI2:
IFE SWPWSP,[
        AOS MMSWP(A)    ;INCREMENT COUNT OF USERS IN RING
];SWPWSP
IFN SWPWSP,[
        ADDM E,UWRKST(U)        ;ADJUST WORKING SET
];SWPWSP
QSWI2A:
IFN PAGPRE,[
;IF THIS USER IS WAITING FOR THIS PAGE, MAKE HIM RUNNABLE BY PUTTING
;HIM ON THE SCHMNY LIST, AND PRE-EMPT THE CURRENTLY-RUNNING USER.
;THE IDEAS ARE TO START THIS USER'S NEXT PAGE READ AS SOON AS POSSIBLE,
;AND TO ELIMINATE THE SCHEDULING THAT WOULD OTHERWISE BE NECESSARY TO RUN THIS GUY.
        AOS NPREE1
        CONSZ PI,200_-APRCHN    ;CAN'T PREEMPT IF CLKOFF
         CONSZ PI,100000_-APRCHN        ;OR IN PROGRESS, BECAUSE
          JRST POPIJ            ;MIGHT ZERO FLSINS WHILE SCHEDULER
                                ;IS EXECUTING IT & SIMILAR NASTIES
        AOS NPREE2
        CAME D,FLSINS(U)        ;IF JOB THAT JUST GOT PAGE IS WAITING FOR IT
         JRST POPIJ
        AOS NPREE3
        SETZM FLSINS(U)         ;THEN THAT JOB PREEMPTS CURRENT ONE
        MOVSI T,%SWPGW
        TDNE T,USWST(U)
         SOS NPGWTU             ;FLSINS WAS DUE TO PAGE FAULT (MIGHT BE IN .CALL CORBLK)
        ANDCAM T,USWST(U)
        HRRZ I,U
        PUSHJ P,SCHSB
        SETOM PREEMP
        CONO PI,CLKRQ           ;REQUEST INT TO SCHEDULER
];PAGPRE
IFE PAGPRE,[
        SKIPE ENPREE
         CAME D,FLSINS(U)
          JRST POPIJ
        MOVE TT,PRVCUT
        CAME U,PRVUSR
         CAMLE TT,UPGSEC(U)
          SETZM SCHFLG
];PAGPRE
POPIJ:  POP P,I
        POPJ P,

IFN E.SP,[
E.SPGJ: SKIPE E.SPGH    ; FLAG FROM E.SPGI
         CAME U,DISUSR
          JRST QSWI2    ; LEAVE AS IS
        TRNN I,400000
         JRST QSWI2
        MOVEI I,3
        JRST QSWI3      ; GO MAKE READ/WRITE
        ; DON'T SOS NSWPGS, SINCE PAGE IS ALREADY HERE
];E.SP
\f
SUBTTL USER SCHEDULER

OVHMTR SC1      ;SCHEDULER 1 - ENTRY

IFN KL10P, IFNDEF SCCOST, SCCOST==250.  ;CHARGE 1 MILLISEC FOR SCHEDULING
IFN KA10P, IFNDEF SCCOST, SCCOST==1000. ;CHARGE 4 MILLISEC FOR SCHEDULING
IFN KS10P, IFNDEF SCCOST, SCCOST==1000. ;CHARGE 4 MILLISEC FOR SCHEDULING

SCHED:  SKIPGE U,USER
         JRST SCHED9
        MOVE T,CLKBRK
IFN KS10P,[
        ;; If user is swapped out while running in the page fail code, then
        ;; EPTPFO is used as the PC.  Either he is on his way in, in which
        ;; case he will come back when restarted, or he is on his way out,
        ;; in which case this just pushes him on his way.
        TLNE T,%PSUSR
         JRST SCHED0
        HRRZ T,T
        CAIL T,PFAIL            ; First instruction inclusive
         CAILE T,PFAILE         ; Last instruction inclusive
          SKIPA T,CLKBRK
           MOVE T,EPTPFO
SCHED0: ] ;IFN KS10P
        MOVEM T,UPC(U)
IFN SCHBLN,SETZM SCHMNY ;ENTERED FROM QUANTUM RUNOUT, TIME TO CHECK ALL USERS
SCHED2: ;ENTERED FROM UFLS OR PAGE FAULT, CHECK FOR AUXIL PERSON TO RUN
        ;IF SCHMNY IS STILL -1
        AOS NSKED
        MOVSI T,UEXIT   ;GET HERE FROM CLUFLS
        HRRI T,UUO(U)
        BLT T,SUEXND-1(U)
IFN KL10P,[
        AC7CTX
        XCTR XR,[HRRZ A,13]     ;GCSTBR
        XCTR XR,[HRL A,14]      ;STBR
        SYSCTX
        MOVEM A,ULSPBR(U)
        SKIPL MTRUSR    ;SKIP IF PERF COUNTER AVAILABLE
         JRST [ DMOVE A,MBOXCT(U)       ;COMPUTE EQV CPU TIME FROM MBOX+EBOX ACCT
                DSUB A,STMBOX           ;AS INCREMENTAL RUNTIME
                DMUL A,KLMBCC
                DADD B,EBOXCT(U)
                DSUB B,STEBOX
                DMUL B,KLEBCC
                MOVE A,D
                JRST SCHD2A ]
        RPERFC A
        DSUB A,STPERF   ;USER RUN TIME IN 80 NS UNITS LEFT 12
        DIVI A,50.*4096. ;CONVERT TO 4 MICROSECOND UNITS IN A
SCHD2A:
] ;KL10P
IFN KS10P, LDB A,[044000,,UPQUAN(U)]    ;GET TIME USED IN 3.9 USEC UNITS
IFN KA10P, LDB A,[022100,,UPQUAN(U)]    ;GET TIME USED IN 4.069 USEC UNITS
        ADDM A,USRTM1           ;SYSTEM TOTAL USER RUN TIME
        ADDM A,UTRNTM(U)        ;INCREASE RUN TIME
        ADDM A,JTMU(U)          ;DECREASE PROCEDURE PRIORITY
        MOVEI B,SCCOST(A)       ;ACCOUNT FOR OVERHEAD IN STARTING UP
        ADDM B,@UTMPTR(U)       ;DECREASE PROCEDURE TREE PRIORITY
IFE SWPWSP,[
        MOVE T,NMPGS(U)         ;USWPRI IS PAGES IN CORE X CPU TIME
        SUB T,NSWPGS(U)
];SWPWSP
IFN SWPWSP,[
        HLLO B,UWRKST(U)        ;USWPRI IS LOG(WORKING SET SIZE) X (CPU TIME + IO WAIT TIME)
        JFFO B,.+1              ;C GETS 19 - LOG(WORKING SET SIZE + 1/2)
        MOVEI T,19.
        SUB T,C
];SWPWSP
        IMUL T,A
        MOVE Q,UTMPTR(U)
        ADDM T,USWPRI(U)        ;CHARGE AGAINST SWAPPINNG PRI
        ADDM T,SWRCE-USRRCE(Q)  ;AND FOR TREE
        MOVE B,A
        LSH B,-7                ;GET RUNTIME IN 512 USEC UNITS
        CAILE B,777
         MOVEI B,777            ;TO FIT IN SCHEDULER HISTORY TBL
        MOVE C,USWST(U)
        SKIPE FLSINS(U)
         TLNN C,%SWPGW
          JRST SCHED8
        TRO B,1000              ;BLOCKAGE DUE TO PAGE FAULT
IFN SWPWSP,[
        CAML A,LODQNT           ;CHECK FOR LEAVING LOADING STATE
SCHED8:  TLZN C,%SWLOD          ;DUE TO RUNNING FOR MORE THAN LODQNT BETWEEN PAGE FAULTS
          JRST .+2              ;OR DUE TO BLOCKAGE FOR REASON OTHER THAN A PAGE FAULT
           PUSHJ P,LVLOA0       ;LEAVE LOADING STATE
];SWPWSP
.ELSE SCHED8:
        DPB B,[311200,,@SCHHP]  ;COMPLETE SCHEDULER HISTORY TBL ENTRY
        SKIPL Q,RTIMER(U)       ;SKIP UNLESS RUNTIME INT ACTIVE
         JRST SEARRT
SCHED3: SKIPGE DLSRCH
         JRST SEAREP    ;DELETE SEARCH, EXIT
IFN PAGPRE,[
        SKIPE PREEMP            ;PRE-EMPT?
         JRST SCHEDP            ;YES, AVOID DOING FULL SCHEDULE
];PAGPRE
IFN SCHBLN,[
        SKIPN SCHMNY    ;IF NOT YET TIME TO DO A FULL SCHEDULE,
         JRST SEARL0
SCHED4: HLRZ U,UREALT   ;THEN CHECK LIST OF JOBS SCHEDULED BEFORE
        JUMPE U,SEARL0  ;ALWAYS SCHEDULE IF HIGH PRIORITY REAL TIME USER ACTIVE
        PUSHJ P,SCHGB   ;POP NEXT JOB OFF LIST
        JUMPL U,SEARL0  ;EMPTY
        PUSHJ P,SCHACK
         JRST SCHED4    ;JOB CEASED TO BE RUNNABLE
        AOS NSSKED      ;OK, RUN THIS ONE
        JRST SCHED6
];SCHBLN

SEARRT: SUB Q,A
        MOVEM Q,RTIMER(U)
        JUMPGE Q,SCHED3
        MOVSI T,(%PIRUN)        ;GIVE RUNTIME INTERRUPT
        IORM T,PIRQC(U)
        JRST SCHED3
\f;
; HERE TO DO A FULL SCHEDULE (LOOK AT ALL JOBS)
;

OVHMTR SC2      ;SCHEDULER 2 - SEARCH

SEARL0: AOS NRSKED      ;1 MORE REAL SCHED (ACTUALLY SEARCHES JOBS)
        CLEARM TRUMM    ;TOTAL RUNNABLE USER MEM
        CLEARM AUSOPG   ;ACTIVE USER SWAPPED OUT PAGES
        CLEARM BUMPGS   ;PAGES IN REAL CORE BELONGING TO BLOCKED USERS
IFE SWPWSP,     CLEARM ASBUM    ;PGS IN REAL MEM OCC BY SWAPPED BLOCKED LOSERS
        SKIPN SWPOPB
         SKIPE SWPOPR
          PUSHJ P,SWPON ;SWAP OUT STUFF
IFN NSWPV,[
        SKIPGE CIRPSW
         PUSHJ P,SWPPIN ;SERVICE SWAPPING REQUESTS FROM OTHER PROCESSORS (DISPLAY)
]
        SETZB U,J       ;JOB BEING SCHEDULED
        SETZM RNABLU    ;NUM RUNABLE USERS
IFN SCHBLN,[
        SETZM SCHBNJ    ;GOT NO RUNNABLE JOBS YET
        SETOM SCHMNY    ;ALLOW ALL THE RUNNABLES WE FIND TO RUN
];SCHBLN
.ELSE   SETOM I         ;BEST USER SO FAR
        MOVNI T,7
        MOVEM T,SCHFLG  ;DONT SCHED AGAIN FOR 1/7.5 SEC
        JRST SEARL1

;HERE IF NULL JOB HAD BEEN RUNNING

SCHED9: AOS NNSKED      ;1 MORE TIME NULL JOB WAS RUN
IFN KA10P, LDB C,[022100,,UPQUAN] ;GET TIME NULL JOB RAN IN 4.069 USEC UNITS
IFN KS10P, LDB C,[044000,,UPQUAN] ;GET TIME NULL JOB RAN IN 3.9 USEC UNITS
IFN KL10P,[
        CAMN U,MTRJOB   ;IF METERING ONLY NULL JOB, STOP METERS NOW
         WRPAE PAEOFF
        CAMN U,MTRJOB
         CONO MTR,4001  ;TIME-BASE OFF, INTERVAL PIA=1
        REBOXC A        ;COMPUTE NULL JOB'S EQUIVALENT RUNTIME IN 4 USEC UNITS
        DSUB A,NULEBC
        RMBOXC C
        DSUB C,NULMBC
        DMUL C,KLMBCC   ;CONVERT MBOX COUNT TO EBOX COUNTER UNITS,
        DADD A,D        ;ADD TO EBOX COUNT
        DMUL A,KLEBCC   ;CONVERT TO 4 USEC UNITS.
        SKIPGE MTRUSR
         JRST [ RPERFC C        ;PERFORMANCE METER AVAILABLE, USE IT INSTEAD
                DSUB C,NULPRF 
                DIVI C,50.*4096. ;CONVERT TO 4 MICROSECOND UNITS
                JRST .+1 ]
];KL10P
        ADDM C,NULTM1   ;ACCUMULATE TOTAL NULL TIME IN 4 USEC UNITS
        SKIPE NPGWTU    ;IF SOMEONE WOULD HAVE BEEN RUNNING IF THEY
         ADDM C,LOSTM1  ; WEREN'T WAITING FOR A PAGE, THIS WAS LOST TIME
        SKIPN NPGWTU    ;BUT OTHERWISE
         ADDM C,IDLTM1  ;IT WAS COMPLETE IDLE TIME
        SKIPE NPGWTU    ;NOW COMPUTE % TIME IDLE AND LOST
         ADDM C,LOSRCE
        SKIPN NPGWTU
         ADDM C,IDLRCE
IFN PAGPRE,SKIPN PREEMP ;CHECK FOR PRE-EMPT
         JRST SEARL0    ;NOW GO DO A FULL SCHEDULE
IFN PAGPRE,[
SCHEDP: SETZM PREEMP
        AOS NPREEL
        PUSHJ P,SCHGB   ;U GETS USER TO PRE-EMPT THIS ONE (LAST INTO SCHMNY LIST)
        JUMPL U,SCHDP1  ;NO ONE TO PRE-EMPT, RUN SAME USER AGAIN
        PUSHJ P,SCHACK  ;MAKE SURE PRE-EMPTING JOB IS RUNNABLE
         JRST SCHEDP    ;AFRAID NOT
        AOS NPREEM      ;OK, RUN THIS ONE
        SKIPL I,USER
         PUSHJ P,SCHSB  ;PRE-EMPTED JOB IS STILL A CANDIDATE FOR RUNNING
        JRST SCHED6

SCHDP1: SKIPGE U,USER   ;TRY TO RUN SAME USER AGAIN
         JRST SCHED1    ;RUN NULL JOB AGAIN
        PUSHJ P,SCHACK  ;MAKE SURE THIS JOB IS STILL RUNNABLE (COULD HAVE UFLSED)
         JRST SEARL0    ;FOO, BETTER DO A FULL SCHEDULE
        JRST SCHED6     ;OK, RUN THIS GUY
];PAGPRE
\f
;MAIN SEARCH LOOP, RETURN HERE TO EXAMINE NEXT PROCEDURE
SEARL:  MOVEI U,LUBLK   ;LENGTH OF USER VAR BLOCK
        ADDB U,J        ;STEP TO NEXT USER
        CAML U,USRHI    ;SKIP IF EXISTS
         JRST SEAREN    ;ALL PROCEDURES HAVE BEEN EXAMINED
SEARL1: SKIPE T,USTP(U)
         JRST SEARS1    ;EMPTY OR STOPPED JOB SLOT
        SKIPE A,PIRQC(U)
         JRST SEAR2A    ;FIRST WORD INTERRUPT PENDING
SEARL2: SKIPE B,IFPIR(U)
         JRST INTWD2    ;SECOND WORD INTERRUPT PENDING
SEARL3: SKIPN FLSINS(U)
         JRST SEARC     ;NOT BLOCKED
SEARL4: MOVE T,EPDL2(U)
        XCT FLSINS(U)   ;TEST BLOCKING CONDITION (MAY SKIP ONCE OR TWICE)
         JRST SEARLB    ;UNRUNABLE
         JRST SEARC     ;LOW PRIORITY UNBLOCK
         SKIPA Q,[-1]   ;HIGH PRIORITY UNBLOCK
          MOVEI Q,3     ;EXTRA LOW PRIORITY
        JRST SEARC2

SEARC:  SETZM Q         ;SET TO NORMAL PRIORITY
        PUSHJ P,UPRIVL  ;COMPUTE PRIVELEGE LEVEL (MAY SKIP ONCE OR TWICE)
         SOJA Q,SEARC2  ;HIGH-PRIORITY
         JRST SEARC2
        SKIPGE APRC(U)
         ADDI Q,2       ;DISOWNED JOB IN USER MODE
SEARC2: AOS RNABLU      ;ANOTHER RUNABLE USER
        MOVE T,TIME
        MOVEM T,LUBTM(U)        ;RECORD LAST TIME UNBLOCKED
IFE SWPWSP,[
        SKIPGE USWSCD(U)
         JRST SEARC7    ;HE'S SWAPPED BLOCKED SO HE DOESNT COUNT
];SWPWSP
        JUMPE U,SEARC4  ;DON'T FIGURE SYSTEM JOB.
        MOVSI T,%SWDSO
        ANDCAM T,USWST(U)       ;RUNNABLE SO NOT DESIRED OUT
        MOVE T,NMPGS(U)
        ADDM T,TRUMM    ;TOTAL RUNNABLE USER MEM
        MOVE T,NSWPGS(U)
        ADDM T,AUSOPG   ;TOTAL PAGES OF RUNNABLE USERS SWAPPED OUT
SEARC4: CAMN U,UREALT           ;IF THIS IS REAL TIME USER IN HIGH PRIORITY
         JRST [ MOVEI A,0       ; PHASE, SCHEDULE WITH INFINITE PRIORITY
                JRST SEARP2 ]
        SKIPLE T,URTIME(U)      ;NON SKIP IF POSSIBLE REAL TIME BLOCK
         TLNN T,1       ;SKIP IF REAL TIME BLOCK UNLESS PI IN PROGRESS
          JRST SEARC6
        SKIPGE PICLR(U) ;SKIP IF PI IN PROGRESS
         JRST SEARL     ;REAL TIME BLOCKED
SEARC6: MOVE A,@UTMPTR(U)       ;GET AMOUNT OF MACHINE TIME USED RECENTLY BY TREE PROCEDURE IS IN
        LSH A,3         ;COMBINE WITH TIME FOR JUST THIS PROCEDURE
        ADD A,JTMU(U)   ;TO GET PRIORITY FIGURE (SMALLER NUMBER IS HIGHER PRI)
        LSH A,(Q)       ;ADJUST PRIORITY BY MULTIPLICATIVE FACTOR IN Q
;THE EFFECT OF THIS PRIORITY COMPUTATION IS THAT JOBS IN THE SAME TREE
;ARE COMPARED BY JTMU, WHILE JOBS IN DIFFERENT TREES ARE COMPARED MAINLY
;BY USRRCE, ALTHOUGH A MUCH SMALLER JTMU CAN OVERRIDE A SOMEWHAT LARGER
;USRRCE.  THIS IS SOMEWHAT DIFFERENT THAN THE COMPUTATION THAT WAS HERE
;BEFORE MAY 1980, BUT THAT COMPUTATION'S RESULTS EVEN DEPENDED ON THE
;ORDER THAT JOBS HAPPENED TO BE INSPECTED, AND ALLOWED A TREE WITH
;A LARGE NUMBER OF RUNNING JOBS TO GET AN UNFAIR SHARE OF THE MACHINE.
SEARP2:
IFN SCHBLN, PUSHJ P,SCHSJB      ;INSERT JOB INTO PRIORITY-SORTED LIST
.ELSE [ JUMPL I,SEARP5
        CAML A,U0P      ;SKIP IF IS BETTER THAN BEST SO FAR
         JRST SEARL
SEARP5: MOVEM U,I       ;I GETS NEW BEST USER SO FAR
        MOVEM A,U0P     ;U0P GETS PRIORITY OF THAT USER
];SCHBLN
        JRST SEARL      ;TRY NEXT

IFE SWPWSP,[
SEARC7: MOVE T,NMPGS(U) ;RUNNABLE AND SWAPPED BLOCKED
        SUB T,NSWPGS(U)
        SOSL T
         ADDM T,ASBUM
        JRST SEARC4
];SWPWSP

;JOB IS NOT RUNNABLE
SEARLB: JUMPE U,SEARL   ;DON'T FIGURE SYSTEM JOB
        MOVE T,USWST(U)
IFE SWPWSP,     SKIPL USWSCD(U) ;IF LOCKED OUT, DONT COUNT
IFN SWPWSP,     TLNN T,%SWSB
         TLNN T,%SWPGW
          JRST SEARB1   ;NOT WAITING FOR PAGE
        MOVE T,NMPGS(U) ;USER IS WAITING FOR PAGE SO COUNT FOR ACTIVE
        ADDM T,TRUMM
        MOVE T,NSWPGS(U)
        ADDM T,AUSOPG
        JRST SEARL

SEARB1: TLNE T,%SWBEM
         JRST SEARL     ;HAVE MADE BEST SWAPOUT EFFORT
        MOVE T,NMPGS(U)
        SUB T,NSWPGS(U)
        SOSL T
         ADDM T,BUMPGS  ;REAL MEM PGS BELONGING TO BLOCKED USERS
        JRST SEARL

SEARS1: SKIPN UNAME(U)
         JRST SEARL
        MOVE T,USWST(U) ;GUY STOPPED, DOES HE HAVE PAGES IN REAL MEM?
        TLNE T,%SWBEM
         JRST SEARL     ;HAVE TRIED BEST EFFORT TO SWAP OUT
        MOVE T,NMPGS(U)
        SUB T,NSWPGS(U)
        ADDM T,BUMPGS
        JRST SEARL

IFN SCHBLN,[
;TEST ALL THINGS THAT MAKE A PERSON UNRUNNABLE, OR AT LEAST
;REQUIRE THE ATTENTION OF THE SCHEDULER
;SKIP-RETURN IF JOB IS RUNNABLE, BASHES T, A
SCHACK: CAMGE U,USRHI           ;NON-EXISTENT
         SKIPE USTP(U)          ;STOPPED
          POPJ P,
        SKIPE T,PIRQC(U)
         JRST [ TDNE T,[BADBTS]
                 JRST SCHACI    ;NON-DEFERRABLE
                SKIPN PICLR(U)
                 JRST .+3       ;ALL INTERRUPTS DEFERRED
                ANDCM T,IDF1(U)
                TDNE T,MSKST(U)
                 JRST SCHACI
                JRST .+1 ]
        SKIPE T,IFPIR(U)
         JRST [ SKIPN PICLR(U)
                 JRST .+1       ;ALL INTERRUPTS DEFERRED
                ANDCM T,IDF2(U)
                TDNE T,MSKST2(U)
                 JRST SCHACI
                JRST .+1 ]
        SKIPE FLSINS(U)         ;FLUSH INSTRUCTION NOT SATISFIED
         JRST [ MOVE T,EPDL2(U)
                XCT FLSINS(U)   ;IT MAY BE SATISFIED BUT NOT CLEARED YET
                 POPJ P,        ;STILL BLOCKED
                JRST .+1        ;CAN SKIP VARIOUS RANDOM NUMBERS OF TIMES
                JRST .+1
                JRST .+1 ]
SCHAC1: SKIPLE T,URTIME(U)      ;REAL-TIME BLOCKED
         TLNN T,1
          SKIPA
           SKIPLE PICLR(U)
            AOS (P)
        POPJ P,

SCHACI: MOVE T,UPC(U)           ;TRYING TO INTERRUPT, NEEDS SCHEDULER
        TLNN T,%PCUSR           ;ATTENTION UNLESS RUNNING IN EXEC MODE
         SKIPE FLSINS(U)        ;IN WHICH CASE NEED TO LET IT FINISH
          POPJ P,               ;SO IT CAN BE PCLSRED
        JRST SCHAC1

;PUT JOB IN U, PRIORITY IN A, INTO STACK IN PRIORITY ORDER.  BASH T,TT,B.
SCHSJB: SKIPG T,SCHBNJ  ;FIRST SEARCH FOR SLOT IN WHICH TO INSERT
         JRST SCHSJ1    ;BUFFER NOW EMPTY, SKIP SEARCH
        MOVE TT,T
        CAML A,SCHBPR-1(T)
         SOJG T,.-1     ;LOOP TERMINATES WITH T SLOT WHERE IT BELONGS
        CAIL TT,SCHBLN
         SOJA T,SCHSJ3  ;BUFFER FULL, WORK DIFFERENTLY
SCHSJ0: MOVE B,SCHBTB-1(TT)     ;MOVE STUFF UP TO ADD ANOTHER ENTRY
        MOVEM B,SCHBTB(TT)
        MOVE B,SCHBPR-1(TT)
        MOVEM B,SCHBPR(TT)
        CAILE TT,1(T)
         SOJA TT,SCHSJ0
SCHSJ1: AOS SCHBNJ
SCHSJ5: MOVEM U,SCHBTB(T)
        MOVEM A,SCHBPR(T)
        POPJ P,

SCHSJ3: AOS NSCHOV      ;BUFFER NOT BIG ENOUGH FOR ALL RUNNABLE JOBS
        JUMPL T,CPOPJ   ;THIS JOB IS LOWEST PRIORITY, FORGET IT
        JUMPE T,SCHSJ5  ;THIS JOB IS SECOND-LOWEST PRIORITY, FORGET LOWEST
        MOVE TT,[SCHBTB+1,,SCHBTB]
        BLT TT,SCHBTB-1(T)      ;MOVE LOWER PRIORITY JOBS DOWN, FORGET LOWEST
        MOVE TT,[SCHBPR+1,,SCHBPR]
        BLT TT,SCHBPR-1(T)
        JRST SCHSJ5

;PUSH JOB IN I ONTO STACK OF RUNNABLE JOBS
SCHSB:  AOS T,SCHBNJ
        CAILE T,SCHBLN
         JRST [ SOS SCHBNJ      ;BUFFER OVERFLOW
                AOS NSCHOV      ;MOVE LOWER PRIORITY JOBS DOWN, FORGET LOWEST
                MOVE T,[SCHBTB+1,,SCHBTB]
                BLT T,SCHBTB+SCHBLN-2
                MOVEM I,SCHBTB+SCHBLN-1
                POPJ P, ]
        MOVEM I,SCHBTB-1(T)
        POPJ P,

;POP STACK OF RUNNABLE JOBS INTO U (RETURNS -1 IF STACK EMPTY)
SCHGB:  SOSL U,SCHBNJ
         SKIPA U,SCHBTB(U)
          SETZM SCHBNJ  ;BUFFER EMPTY, U HAS -1
        POPJ P,
];SCHBLN
\f
.ALSKF==0
DEFINE ALTSKP A
IFE .ALSKF,[
        DEFINE .ALSKS
A TERMIN
]
IFN .ALSKF,[
        CAME U,.ALSKS
         CAMN U,A
          POPJ P,
]
.ALSKF==.ALSKF#1
TERMIN

;DETERMINES USER PRIVILEGE LEVEL FOR SCHEDULING AND SWAPPING
UPRIVL: SKIPN RPCL(U)   ;BEING RPCLSR'ED?
         CAMN U,UMASTER ;MASTER?
          POPJ P,       ;HIGHLY PRIVILEGED
        AOS (P)         ;SKIP AT LEAST ONCE
IFN 340P\E.SP,  ALTSKP DISUSR
IFN VIDP,       ALTSKP NVDUSR
IFN TABP,       ALTSKP TABUSR
IFN ARMP,       ALTSKP ARMUSR
IFN LPTP,       ALTSKP LPTUSR
IFG LPTP-1,     ALTSKP OLPUSR
IFN PLTP,       ALTSKP PLTUSR
IFN .ALSKF,[
        CAMN U,.ALSKS
         POPJ P,        ;DON'T FIGURE DISOWNED IF USING ABOVE DEVICES
]
        MOVE T,UPC(U)
        TLNE T,%PCUSR
         AOS (P)        ;SKIP TWICE
        POPJ P,
\f
OVHMTR SC3      ;SCHEDULER 3 - EXIT

;SEARCH END (EXIT)
SEAREN:
IFE SWPWSP,[
        SKIPE NUSWB
         PUSHJ P,SSWC1  ;SEE IF ENUF CORE TO UNBLOCK A SWAPPED BLOCKED LOSER
];SWPWSP
IFE SCHBLN,[
        SKIPGE U,I      ;SKIP IF NON-NULL JOB BEST
         JRST SCHED1
        AOS NSCHDU
];SCHBLN
IFN SCHBLN,[
        MOVE T,SCHBNJ
        ADDM T,NSCHDU
        PUSHJ P,SCHGB   ;GET HIGHEST-PRIORITY JOB
        JUMPL U,SCHED1  ;NONE, RUN NULL JOB
];SCHBLN
SCHED6: SKIPE FLSINS(U)
         JRST SCHED5
SCHED1: EXCH U,USER
        JUMPL U,SCHDN   ;JUMP IF SWITCHING FROM NULL JOB
        CAMN U,USER     ;SKIP UNLESS RUNNING SAME JOB AGAIN
         JRST SEAREP    ;JUMP ON SAME JOB
IFN KL10P,[
        CAMN U,MTRJOB           ;IF LEAVING JOB BEING METERED, STOP METER AND
         WRPAE PAEOFF
        CAMN U,MTRJOB
         CONO MTR,4001          ;TIME-BASE OFF, INTERVAL PIA=1
]
;SWAP OUT THE OLD JOB'S CONSOLE REGISTER, AND CLEAR ITS BLINKER.
IFN N11TYS,[
        SKIPGE TT11P
         SKIPE TEN11F
          JRST SSTVR1           ;DONT HACK 11
        SKIPL TVCREG(U)         ;DO WE WANT TO SAVE TV CONSOLE REG FOR THIS GUY?
         SKIPN T,400000+TTR10*2000 ;0 IS NOT A (VERY) LEGITIMATE CONSOLE REG FCN
          JRST SSTVR2           ;SO ASSUME 11 STOPPED, DONT CLOBBER PREV THING
        MOVEM T,TVCREG(U)
SSTVR2: SKIPGE T,TVVBN(U)       ;DID WE SET RUNNING BLINKER FOR THIS GUY?
         JRST SSTVR1            ;NO
        MOVEM T,400000+TTR10*2000       ;SET TO VIDEO BUFFER WE SET IT IN
        MOVE A,TVBLAD           ;ADDR IN VIDEO BUFFER WE FLASHED
        CLEARM 400000+TTR0*2000(A)      ;CLEAR IT
SSTVR1:]
IFN KA10P,[
        MOVE T,40
        MOVEM T,SV40(U) ;SAVE LAST UUO EXECUTED FOR THIS USER
        MOVE T,UPC(U)   ;IF USER HAS JUST TRAPPED TO 60,
        TLNE T,%PCUSR
         JRST SCHDN
        ANDI T,-1
        CAIL T,60H0
         CAILE T,60HE
          JRST SCHDN
        MOVNI T,60H0-UUOH0
        ADDM T,UPC(U)   ;THEN MOVE HIM INTO UUOH INSTEAD
        MOVE T,60       ;AND MOVE 60H'S VARIABLES INTO UUOH'S VARS
        MOVEM T,SV40(U) ;(THAT'S ALL 60H DOES ANYWAY).
        MOVE T,60H
        MOVEM T,SUUOH(U)
] ;KA10P
;DROPS THROUGH.
\f;DROPS IN
;COME HERE TO SET UP A JOB THAT WASN'T ALREADY RUNNING.

SCHDN:  MOVE A,U
        SKIPGE U,USER
         JRST SCHDN2    ;JUMP IF SWITCHING TO NULL JOB
IFN KA10P,[
        MOVE T,SV40(U)  ;LOAD NEW KRUFT
        MOVEM T,40
] ;KA10P
IFN N11TYS,[
        SKIPGE TT11P    ;DONT HACK 11 IF ITS DOWN (MOSTLY IN CASE ITS BEING HACKED
                        ;HARDWARILY
         SKIPE TEN11F
          JRST SLTVR1   ;DONT HACK 11
        SKIPGE T,TVVBN(U)       ;BLINK RUNNING FROB?
         JRST SLTVR2
        MOVEM T,400000+TTR10*2000
        MOVE A,TVBLAD
        MOVNI T,20
        MOVEM T,400000+TTR0*2000(A)
        SKIPA T,TVVBN(U)
SLTVR2:  MOVSI T,12_<8+4+16.-18.>       ;ALU NOP
        SKIPL TVCREG(U)
         MOVE T,TVCREG(U)
        MOVEM T,400000+TTR10*2000
SLTVR1:]        
IFN KL10P,[
        CAMN U,MTRJOB   ;IF THIS JOB'S BEING METERED, TURN ON METER AND TIME BASE.
         WRPAE PAEON
        CAMN U,MTRJOB
         CONO MTR,2001  ;TIME-BASE ON, INTERVAL PIA=1
];KL10P
        SOS NRESKED     ;COMPENSATE FOR EXTRA AOS ON NEXT PAGE

;DROPS THROUGH
\f;DROPS IN
;COME HERE TO START UP A JOB EVEN IF IT WAS ALREADY RUNNING BEFORE THIS SCHEDULE.

SEAREP: AOS NRESKED
IFN KA10P,[
        HRLOI T,1
        ANDCAM T,UPQUAN(U)      ;RESET QUANTUM TIMER
] ;KA10P
IFN KL10P,[
        RPERFC STPERF           ;SAVE PERF METERS FOR LATER USE
        DMOVE A,EBOXCT(U)       ;COMPUTING RUN TIME EFFECTIVELY RESETS
        DMOVEM A,STEBOX         ;QUANTUM TIMER 
        DMOVE A,MBOXCT(U)
        DMOVEM A,STMBOX
] ;KL10P
IFN KS10P, SETZM UPQUAN(U)      ;RESET QUANTUM TIMER
        PUSHJ P,PGLDU
        MOVN A,U
        IDIVI A,LUBLK
        SKIPE B
         BUG
IFE KS10P,[     ; KS has no lights.
        MOVSI B,400000
        LSH B,(A)
        SKIPN MIPGDS
         DATAO LIGHTS,B ;LIGHTS HAVE ONE BIT, SHOWING WHICH JOB IS RUNNING.
] ;IFE KS10P
        MOVN B,A        ;GET JOB'S NUMBER IN B
        MOVE T,UPC(U)   ;USER'S PC WORD
        MOVEM T,CLKBRK
        AOS A,SCHHP     ;SET UP SCHEDULER HISTORY TBL
        CAIL A,SCHHB+SSCHDB
         MOVEI A,SCHHB
        MOVEM A,SCHHP
        HRRM T,(A)      ;STORE PC
        TLNN T,%PCUSR
         TRO B,400000
        HRLM B,(A)      ;STORE USER INDEX AND USER BIT
        MOVSI T,UUO(U)
        HRRI T,UEXIT
        BLT T,UEXND-1   ;BLT IN UEXIT BLOCK
IFN KL10P,[
        MOVE T,ULSPBR(U)
        AC7CTX
        XCTR XW,[HRRZM T,13]    ;GCSTBR
        XCTR XW,[HLRZM T,14]    ;STBR
] ;KL10P                ;CONTEXT WILL BE RESTORED AT CLKB5 BELOW
IFN KA10P, CONO @APRC(U)

;
; THIS IS THE ONE PLACE WHERE CLOCK LEVEL RETURNS TO THE USER JOB
;
CLKB5:
IFE KA10P, DATAO PAG,@CLCXSV    ;RESTORE CONTEXT
        MOVE U,USER
        MOVSI U,AC0S(U)         ;RESTORE AC BLOCK 0
        BLT U,U
        JRST 12,@CLKBRK         ;RESTORE PC, FLAGS, AND PI
\f
;HERE WHEN STARTING A USER WHO HAD BEEN FLSING

SCHED5: MOVE T,USWST(U)
IFN SWPWSP,[
        TLNN T,%SWPGW   ;PAGE WAITS DON'T COUNT AS BLOCKING
         TLNN T,%SWOUT  ;IF SWAPPED-OUT, UNBLOCKING BUMPS SWAP-IN PRIORITY
          JRST SCHD5A
        MOVE TT,USWPRI(U)       ; (A SOMEWHAT QUESTIONABLE FEATURE)
        LSH TT,-1
        MOVEM TT,USWPRI(U)
SCHD5A:
];SWPWSP
        TLNE T,%SWPCL
         JRST SCHED7            ;JUMP IF PAGES SWAPPED OUT WHILE BLOCKED IN EXEC MODE
        TLNE T,%SWPGW
         SOS NPGWTU             ;NOT WAITING FOR A PAGE ANY MORE
        MOVSI T,%SWPGW+%SWRUN+%SWINT    ;NOT WAITING FOR PAGE,NOT UNBLOCKED SWAPOUT,
        ANDCAM T,USWST(U)       ;NOT WAITING FOR INTERRUPT PAGE
        SETZM FLSINS(U)         ;NOT WAITING FOR ANYTHING
        JRST SCHED1

SCHED7: PUSHJ P,PCLSR           ;PAGES WERE SWAPPED OUT WHILE BLOCKED IN EXEC MODE
         BUG                    ;SO PCLSR JOB SINCE IT MIGHT BE COUNTING ON THOSE PAGES
        JRST SCHED1             ;PCLSR MUST SUCCEED.  JOB WAS BLOCKED WITH EMPTY LSWPR.


;COME HERE TO RUN THE NULL JOB.

SCHDN2: SKIPL A         ;WERE RUNNING IT ALREADY?
         AOS NNULBK     ;NO, INCREMENT # CONSECUTIVE BLOCKS OF NULLTIME.
        MOVSI T,(JFCL)
        MOVEM T,CLUSAV  ;AVOID LOSSAGE AT CLKBRK+1 NEXT CLOCK INT
IFE KA10P, MOVEM T,CLCXSV
IFE KS10P,[     ; KS has no lights.
        SKIPN MIPGDS
         DATAO LIGHTS,[0] ;LOAD LIGHTS WITH JOB RUNNING (NONE)
] ;IFE KS10P
IFN KA10P,[
        HRLOI T,1
        ANDCAM T,UPQUAN
] ;KA10P
IFN KL10P,[
        CAMN U,MTRJOB
         WRPAE PAEON
        CAMN U,MTRJOB
         CONO MTR,2001  ;TIME-BASE ON, INTERVAL PIA=1
        REBOXC NULEBC
        RMBOXC NULMBC
        RPERFC NULPRF
] ;KL10P
IFN KS10P, SETZM UPQUAN
        CLEARM SCHFLG   ;RESCHEDULE ON NEXT CLK INT
        LPMR UPGML
        JRST 12,@[%PSPCU,,NULJOB]       ;DISMISS INT AND GO TO NULL JOB

NULJOB: MOVSI (JRST 4,)
        MOVEI 17,1              ;SET ACS 0 TO 16 TO JRST 4,0
        BLT 17,16               ;TO CATCH SPURIOUS TRANFERS TO ACS
        MOVE 17,[AOJA 17]       ;RUNS IN ACS TO FREE MEMORY FOR OTHER PROCESSORS
        JRST 2,@[%PCUSR,,17]    ;RUNS IN USER MODE FOR SAKE OF RANDOMNESS
\f
IFE SWPWSP,[
OVHMTR SC4      ;SCHEDULER 4 - UNSWAPBLOCKER

;SEE IF THERE IS ENOUGH CORE TO UNBLOCK A SWAP-BLOCKED JOB.
SSWC1:  SKIPGE U,BUSR
         POPJ P,
        MOVN T,NSWPGS(U)
        ADD T,MEMFR
        SUB T,NCBCOM
        ADD T,SOLNG
        SUB T,SILNG
        SUB T,AUSOPG
        ADD T,ASBUM
        ADD T,BUMPGS
        CAIGE T,20
         POPJ P,                ;THERE ISN'T ENOUGH ROOM.
        MOVSI T,400000
        ANDCAM T,USWSCD(U)      ;CLEAR SWAP BLOCKED
        SETOM BUSR
        MOVE T,[-1_-1]
        MOVEM D,BUSIZ   ;SIZE OF SMALLEST SWAP-BLOCKED USER.
        AOS NTSBUU
        SOSN NUSWB
         JRST SSWSC3
        MOVEI U,0
        MOVNI R,1
        MOVSI T,200000
SSWSC4: CAML U,USRHI
         JRST SSWSC6
        SKIPGE USWSCD(U)
         SKIPN UNAME(U)
          JRST SSWSC5
        CAMGE T,NMPGS(U)
         JRST SSWSC5
        MOVE R,U
        MOVE T,NMPGS(U)
SSWSC5: ADDI U,LUBLK
        JRST SSWSC4

SSWSC6: MOVEM R,BUSR    ;STORE NEW SMALLEST SWAPPED BLOCKED LOSER
        SKIPGE R
         MOVEI T,0
        MOVEM T,BUSIZ
SSWSC3: JUMPL I,SEARL0  ;MAYBE CAN RUN THIS GUY NOW
        POPJ P,
];SWPWSP
\f
OVHMTR SWU      ;SWAP USER

;SWAP OUT N PAGES (N IS IN SWPOPR)
SWPON:  MOVE C,SOLNG
        SKIPGE CIRPSW           ;CAN'T DO ANYTHING WITHOUT CIRPSW
         CAILE C,2*NQS
          POPJ P,               ;ALREADY STUFF ON WAY OUT
        SKIPL U,PSWOUS          ;SEE IF CONTINUING TO SWAP OUT A USER
         CAML U,USRHI
          JRST SWPON1
        MOVE C,PSWCLS
        SKIPE LSWPR(U)          ;PREFER NOT TO SWAP OUT
         JRST SWPON1            ;USER WHO HAS SWITCHES LOCKED
        SKIPE UNAME(U)          ;SKIP ON USER KILLED
         SKIPL USWST(U) .SEE %SWDSO     ;OR NOT DESIRED OUT ANY MORE
SWPON1:   PUSHJ P,SWPON2        ;FIND NEW USER TO FLUSH
        JUMPL U,SWUP8
SWPON6: MOVSI A,%SWDSO          ;THIS USER NOW DESIRED OUT
        IORM A,USWST(U)
        MOVEM C,PSWCLS
        MOVEM U,PSWOUS
        MOVE T,UPC(U)
        TLNE T,%PCUSR
         JRST SWPU1             ;OK TO SWAP USER
        SKIPN LSWPR(U)          ;PCLSR IF HAS LOCKS, OR AT JBFLS,
         SKIPN FLSINS(U)        ;OR IF NOT BLOCKED
          JRST SWPON8
        MOVSI T,%SWPCL          ;OTHERWISE, DON'T PCLSR NOW, BUT
        IORM T,USWST(U)         ;WHEN IT UNBLOCKS
        JRST SWPU1              ;AND START SWAPPING OUT ITS PAGES

SWPON8: PUSHJ P,PCLSR           ;GET OUT OF SYS BEFORE SWAPPING OUT
         POPJ P,
        JRST SWPU1

;FOUND NO USER TO SWAP OUT
SWUP8:  SKIPE NLOOSP
         JRST SWOL1     ;SWAP OUT SOME LOOSE PAGES
        AOSE SBEFLG     ;HAVE WE COME HERE TWICE?
         JRST SWUP6     ;YES, GIVE UP
        MOVSI B,%SWBEM  ;NO, TURN OFF EVERYONE'S BEST EFFORT BIT
        MOVEI J,2*LUBLK ;AND LOOK AT EVERYONE AGAIN SINCE WE'RE DESPERATE
SWUP9:  CAML J,USRHI    ;TO FIND A PAGE TO SWAP OUT
         JRST SWUP7
        ANDCAM B,USWST(J)
        ADDI J,LUBLK
        JRST SWUP9

SWUP7:  PUSHJ P,SWPON2          ;HAVING TURNED OFF %SWBEM, FIND A USER TO SWAP OUT
        JUMPG U,SWPON6          ;GO SOMEONE, GO DO
SWUP6:  SETZM SWPOPR            ;CAN'T FIND ANYONE TO SWAP OUT, GIVE UP
        SETOM PSWOUS
        POPJ P,

SWOL1:  SKIPN A,FLOOSP          ;SWAP OUT SOME LOOSE PAGES
         BUG                    ;NLOOSP WAS TOO HIGH?
        MOVNI C,1
        PUSHJ P,SWPOPG
         BUG                    ;CIRPSW, EXEC PAGE COUNT ALREADY CHECKED
        SETOM SBEFLG            ;WE FOUND A PAGE TO SWAP OUT, NOT DESPERATE
        MOVE C,SOLNG
        SOSLE SWPOPR            ;ENOUGH
         CAIL C,20.             ;ENOUGH FOR NOW
          POPJ P,
        SKIPE NLOOSP            ;SWAP OUT MORE PAGES
         JRST SWOL1
        JRST SWPON
\f;START SWAPPING OUT THIS USER'S PAGES
SWPU1:  AOS NSOUSR
        MOVSI A,%SWRUN
        CAILE C,1               ;CLASS
         IORM A,USWST(U)        ;INDICATE USER WAS RUNNABLE AT TIME OF SWAP OUT
IFE SWPWSP,[
        SETZM SWUPC
        SKIPN ENUPC
         JRST SWPU1B
        MOVE T,UPC(U)           ;CALCULATE WHAT PAGE HIS PC IS ON
        LDB C,[121000,,UPC(U)]
        ROT C,-1
        ADDI C,UPGMP(U)
        MOVE A,[222200,,(C)]
        SKIPGE C
         IBP A
        LDB A,A
        TRNN A,600000
         SETZM A
        ANDI A,PMRCM            ;MASK TO REAL CORE ADR BITS
        SKIPN USTP(U)           ;ONLY IF RUNNING
         TLNN T,%PCUSR          ;AND IN USR MODE
          CAIA
           MOVEM A,SWUPC        ;THEN DON'T ALLOW UPC PAGE TO BE SWAPPED OUT
SWPU1B:
];SWPWSP
        MOVE B,PSWLC
        AOSE PSWSFL
         JRST SWPU3A            ;PICK UP FROM WHERE LEFT OFF
IFE SWPWSP,[
        SKIPE ENPZRO
         SETOM SWPP0F
];SWPWSP
        MOVEI C,UPGMP(U)        ;ADDRESS OF PAGE MAP (START FROM PG 0)
        MOVEI J,UPGCP(U)
        HRLI C,442200           ;CNVRT TO BYTE PNTR TO MAP
        HRLI J,442200
        MOVEM C,SWPMBP
        MOVEM J,SWPCBP
        LDB B,[121100,,HUSRAD(U)]       ;DO ALL PAGES THAT MIGHT EXIST
SWPU2:  ILDB D,SWPCBP           ;CIRC PNTR ENTRY
        ILDB A,SWPMBP           ;PAGE MAP ENTRY
        AOS NSOPGS
        JUMPE D,SWPU3A          ;DOESN'T HAVE PAGE
IFE SWPWSP,[
        AOSN SWPP0F
         SKIPE USTP(U)          ;DON'T SWAP OUT PAGE 0 IF NOT STOPPED
          CAIN D,-1             ;PAGE IS ABSOLUTE
           JRST SWPU3A
        TRNN A,600000           ;NO ACCESS
         JRST SWPU3A
        SKIPN ENAGE
         JRST SWPU2A
        TRON A,PMAGEM           ;HAS PAGE BEEN REFERENCED? (AGE MASK)
         JRST [ DPB A,SWPMBP
                AOS NAGEAB
                JRST SWPU3A ]
SWPU2A: ANDI A,PMRCM            ;MASK TO REAL CORE PAGE #
        CAMN A,SWUPC            ;DON'T SWAP OUT PAGE WHERE PC IS IF RUNNING
         JRST SWPU3A
];SWPWSP
IFN SWPWSP,[                    ;I DOUBT THAT MOST OF THAT NONSENSE DOES ANYTHING
        TRNE A,600000           ;NO ACCESS
         CAIN D,-1              ;OR PAGE IS ABSOLUTE
          JRST SWPU3A           ;MEANS DON'T SWAP OUT
        ANDI A,PMRCM            ;MASK TO REAL CORE PAGE #
];SWPWSP
        HRRZ D,MMSWP(A)         ;NUMBER OF USERS WHO HAVE THIS PAGE MAPPED
        SOJN D,SWPU4            ;PAGE IS SHARED
SWPU6:  MOVEM B,PSWLC           ;SAVE HOW FAR SWAP-OUT SCAN GOT
        MOVE C,PSWOUS
        PUSHJ P,SWPOPG          ;SWAP OUT THIS PAGE
         JRST SWPU3
        SETOM SBEFLG            ;FOUND A PAGE TO SWAP OUT, NOT DESPERATE
        MOVE C,SOLNG
        SOSLE SWPOPR            ;ENOUGH
         CAIL C,20.             ;ENOUGH FOR NOW
          POPJ P,
SWPU3:  MOVE B,PSWLC
        MOVE U,PSWOUS
SWPU3A: SOJG B,SWPU2
        SETOM PSWOUS
        MOVSI B,%SWBEM
        IORM B,USWST(U)         ;SET BEST EFFORT BIT
IFN SWPWSP,[
        SKIPL APRC(U)           ;IF DISOWNED,
         JRST SWPON
        MOVE B,USWPRI(U)        ;DECREASE PRIORITY TO COME BACK IN
        LSH B,2
        MOVEM B,USWPRI(U)
];SWPWSP
        JRST SWPON
\f;TRYING TO SWAP OUT A SHARED PAGE
SWPU4:  MOVEM B,PSWLC           ;SAVE HOW FAR SWAP-OUT SCAN GOT
        AOSE CIRPSW
         BUG            ;CIRPSW LOCKED IN SWAP OUT CODE
        MOVE C,[2200,,MEMPNT(A)]
        MOVEM A,SWOBK
        PUSHJ P,UCPRL
            400000,,SWPU5       ;CONSULT THE OTHER USERS OF THE PAGE
        SETOM CIRPSW
        MOVE A,SWOBK
        JRST SWPU6      ;OK TO SWAP IT OUT

SWPU5:  SKIPGE TT,USWST(U) .SEE %SWDSO
         POPJ P,        ;USER DESIRED OUT, CAN'T HOLD PAGE IN
IFN SWPWSP,     TLNN TT,%SWLOD  ;IF USER IS LOADING, HOLDS PAGE IN
         SKIPN AGERTE
          JRST SWPU5A
        MOVE TT,I
        LSH TT,-1
        ADDI TT,UPGMP(U)
        HRLI TT,2200
        TRNN I,1
         HRLI TT,222200
        LDB TT,TT
        TRNE TT,600000  ;SKIP IF NO ACCESS, IGNORE AGE
         TRNE TT,PMAGEM ;HAS SHE USED THIS PAGE?
          POPJ P,       ;NO, CAN'T HOLD PAGE IN
SWPU5A: SUB P,[4,,4]
        SETOM CIRPSW    ;SHARED W/USER WHO IS WANTED IN CORE
        AOS NSHRAB      ;SO DON'T SWAP IT OUT
        JRST SWPU3

;COME HERE WITH BEST USER TO SWAP OUT IN U, CLASS IN C
SWPONX: JUMPL U,CPOPJ   ;NO SWAP OUTTABLE LOSER
IFN SWPWSP,[
        CAILE C,1
         SKIPN NLOOSP
          JRST SWPNX2
        SETO U,         ;WOULD RATHER SWAP OUT LOOSE PAGES
        POPJ P,

SWPNX2: MOVSI T,%SWOUT  ;MAKE USER SWAPPED OUT
        TDNE T,USWST(U)
         JRST SWPNX3    ;ALREADY IS?
        IORM T,USWST(U)
        MOVE T,UWRKST(U)
        MOVEM T,USVWRK(U)
        MOVE T,TIME
        MOVEM T,USWTIM(U)       ;DROPS INTO SWPNX3
];SWPWSP
IFE SWPWSP,[
        CAILE C,1
         SKIPN NLOOSP
          SKIPA B,USWST(U)
           JRST [ SETO U, ? POPJ P, ]   ;WOULD RATHER SWAP OUT LOOSE PAGES
        SKIPGE USWSCD(U)
         JRST SWPNX3    ;HE'S ALREADY SWAP BLOCKED
        TLNN B,%SWPGW   ;IS HE RUNNABLE?
         SKIPN FLSINS(U)
          SKIPE USTP(U)
           JRST SWPNX3
        MOVE B,NMPGS(U) ;HE'S RUNNABLE
        CAIGE B,TSYSM-SYSB-MEMSY1
         JRST SWPNX1    ;SMALL, NO THRASH
        SUB B,NSWPGS(U)
        ADD B,MEMFR
        SUB B,NCBCOM
        ADD B,SOLNG
        SUB B,SILNG
        SUB B,AUSOPG
        JUMPG B,SWPNX3  ;LET THIS GUY THRASH
SWPNX1: SKIPN ENSWBK
         JRST SWPNX3
        MOVSI B,(SETZ)  ;SWAP BLOCK THIS LOSER
        IORM B,USWSCD(U)
        AOS NTUSB
        AOS NUSWB
        MOVE B,NMPGS(U) ;SMALLEST SWAP BLOCKED LOSER?
        CAML B,BUSIZ
         JRST SWPNX3
        MOVEM U,BUSR    ;YES
        MOVEM B,BUSIZ           ;DROP INTO SWPNX3
];SWPWSP
;HAVING DECIDED TO SWAP OUT JOB IN U, MAKE SWAP HISTORY TABLE ENTRY
SWPNX3: MOVSI T,2_16.
;GENERAL SWAP HISTORY TABLE KEEPER.  ENTER WITH JOB IN U, EVENT IN T, BASHES TT,I,T
SWPKHT: HRLZ TT,U
        IDIVI TT,LUBLK          ;TT 3.1-3.8 GETS JOB NUMBER, BASHES I
        IOR TT,T
        HRR TT,TIME
IFN SWPWSP, HLRZ T,UWRKST(U)
IFE SWPWSP,[
        MOVE T,NMPGS(U)
        SUB T,NSWPGS(U)
];SWPWSP
        SOSL T
         DPB T,[321000,,TT]
        MOVEM TT,@SWPHTP
        AOS T,SWPHTP
        MOVE TT,UTRNTM(U)
        MOVEM TT,SWPHTL-1(T)
        MOVEI TT,SWPHTB
        CAIL T,SWPHTB+SWPHTL
         MOVEM TT,SWPHTP
        POPJ P,
\f
OVHMTR SWF      ;SWAP FIND USER

;FIND A USER TO SWAP OUT, RETURN IN U, -1 IF NONE
SWPON2: SETOM PSWSFL    ;START FROM BEG OF USER
IFE SWPWSP,[
        SKIPL U,PRVUSR
         PUSHJ P,CKPRUS ;MAKE SURE PRIV USER EXISTS AND HAS NOT BEEN BLOCKED FOR A LONG TIME
];SWPWSP
        MOVNI T,30.*60.
        ADD T,TIME      ;A MINUTE AGO
        MOVNI U,1
        MOVEI J,2*LUBLK
        MOVEI C,NSSCDC  ;# SWAP OUT CLASSES
SWPON4: CAML J,USRHI    ;C HAS INDEX OF MAX CLASS INTERESTED IN
         JRST SWPONX    ;LOOKED AT ALL USERS, GO PONDER RESULTS
        SKIPE UNAME(J)  ;SEE IF FOR REAL
         SKIPN NMPGS(J) ;DON'T BOTHER IF HAS NO MEMORY
          JRST SWPON3
IFN SWPWSP,[
        MOVE B,USWST(J)
        TLNE B,%SWBEM+%SWLOD    ;DON'T SWAP OUT IF BEST EFFORT ALREADY MADE, 
         JRST SWPON3    ; OR STILL LOADING IN
        MOVEI I,7
        MOVE TT,USWTIM(J)
        CAMLE TT,TIME   ;IF PROTECT TIME HASN'T ELAPSED YET, GETS HIGHER PRIORITY
         JRST SWPTK     ;TO PREVENT THRASHING
];SWPWSP
IFE SWPWSP,[
        MOVE B,USWST(J)
        TLNE B,%SWBEM
         JRST SWPON3    ;BEST EFFORT ALREADY MADE
];SWPWSP
        SKIPE LSWPR(J)
         JRST SWPON7    ;PREFER NOT TO SWAP OUT LOSER WITH SWITCHES LOCKED
        MOVEI I,1
        TLNE B,%SWPGW
         JRST SWPON5    ;FLSINS IS WAITING FOR A PAGE (NOT REALLY BLOCKED)
        CAML T,LUBTM(J)
         SOJA I,SWPTK   ;BLOCKED FOR A LONG TIME (CLASS 0)
        SKIPN FLSINS(J)
SWPON5:  SKIPE USTP(J)
          JRST SWPTK    ;CLASS 1 (BLOCKED)
IFE SWPWSP,[
        TLNE B,%SWPRV
         JRST [ MOVEI I,7       ;CLASS 7 (PRIV USER)
                JRST SWPTK ]
];SWPWSP
        JUMPL B,[AOJA I,SWPTK] .SEE %SWDSO      ;DESIRED OUT (CLASS 2)
        MOVEI I,4
        SKIPGE APRC(J)
         SOJA I,SWPTK   ;DISOWNED (CLASS 3)
IFE SWPWSP,[
        SKIPGE USWSCD(J)
         JRST SWPTK     ;SWAP BLOCKED (CLASS 4)
];SWPWSP
        SKIPGE TTYTBL(J)
         AOJA I,SWPTK   ;DOESNT HAVE TTY (CLASS 5)
SWPON7: MOVEI I,6       ;OTHERWISE....

SWPTK:  CAMGE C,I
         JRST SWPON3    ;THIS GUY IN MORE WINNING CLASS
IFE SWPWSP,[
        MOVE A,NMPGS(J)
        SUB A,NSWPGS(J)
];SWPWSP
.ELSE   MOVE A,UWRKST(J)
        CAME C,I
         JRST SWPTK2
        XCT SWPTT(C)    ;IN SAME CLASS, COMPARE CLASS-DEPENDENT PRIORITY MEASURES
         JRST SWPON3
SWPTK2: MOVE E,@SWPTT(I)        ;MAKE THIS GUY BEST VICTIM
        MOVE C,I
        MOVE U,J
SWPON3: ADDI J,LUBLK
        JRST SWPON4
\f
;SKIP IF THIS GUY (J) IS BETTER LOSER TO FLUSH THAN PREV BEST (IN E)
SWPTT:  CAMG E,LUBTM(J) ;BLOCKED FOR A LONG TIME (0) - LATER LUBTM WINS
        CAMG E,LUBTM(J) ;BLOCKED (1)                 - LATER LUBTM WINS
        CAML E,A        ;DESIRED OUT (2)             - SMALLER WORKING SET WINS
        CAML E,A        ;DISOWNED (3)                - SMALLER WORKING SET WINS
        CAML E,A        ;RUNNABLE, SWAP BLOCK SET (4) - SMALLER WORKING SET WINS
        CAML E,USWPRI(J)        ;RUNNABLE, W/O TTY (5) - GO BY PRIORITY
        CAML E,USWPRI(J)        ;OTHERWISE (6)       - GO BY PRIORITY
IFE SWPWSP,     BUG             ;PRIVELEGED USER (7) - SHOULD ONLY BE ONE
IFN SWPWSP,     CAMG E,USWTIM(J);PROTECTED (7)       - LATER UNPROTECT TIME WINS
NSSCDC==.-SWPTT

IFE SWPWSP,[
CKPRUS: MOVSI B,%SWPRV
        CAMGE U,USRHI
         ANDCAM B,USWST(U)      ;TURN OFF PRIV USER BIT
        MOVNI TT,30.*2
        ADD TT,TIME     ;TWO SECONDS AGO
        SKIPE UNAME(U)
         CAML TT,LUBTM(U)
          PUSHJ P,NPRVUSR
        SKIPG U,PRVUSR
         POPJ P,
        MOVSI B,%SWPRV
        IORM B,USWST(U)
        POPJ P,
];SWPWSP
\f
OVHMTR UUO      ;RANDOM UUOS

;AC: A.9 =>1  SWAP OUT USER
;4.8 => 1 ALL PAGES
;4.7=1 => LOOP FOR A WHILE
;3.9-3.1 USER # SELF IF 0
;RH => USER VIRTUAL PG # 
;OR 4.9=0, 4.8=0, 4.7=0 SWAP OUT RH # OF PAGES
;IF 4.9=0, 4.8=1 AND 4.7=0, HACK PCLSR TEST FEATURE ON CURRENT USER
;RH =0 LEAVE PCLSR TEST MODE =1 ENTER IN ADVANCE MODE =-1 ENTER IN HOLD MODE
;   =2 ENTER IN ADVANCE BUT DON'T ^Z

ASWAP:  SKIPN SYSDBG
         JRST ILUUO
        UMOVE A,(J)
        TLNE A,100000
         JRST ASWAP3
        JUMPL A,ASWAP1
        TLNE A,200000
         JRST ASWPCL    ;PC LSR TEST MODE.
        HRRZM A,SWPOPR  ;CLOBBER CLOBBER
        POPJ P,

ASWAP1: HLRZ B,A
        ANDI B,777      .SEE MAXJ ;FIELD SHOULD BE BIG ENOUGH
        IMULI B,LUBLK
        SKIPE B
         MOVE U,B
        TLNN A,200000
         JRST ASWAP2
        MOVE D,NMPGS(U)
        SUB D,NSWPGS(U)
        JUMPL D,[JRST 4,.]
        JUMPE D,CPOPJ
        CONO PI,CLKOFF
        MOVEM U,PSWOUS
        SETOM PSWSFL
        ADDM D,SWPOPR
        MOVSI D,%SWDSO
        IORM D,USWST(U)
        CONO PI,CLKON
        POPJ P,

ASWAP2: PUSHJ P,CWAIT   ;RETURNS WITH CLKOFF AND CIRPSW AVAILABLE
            SKIPL CIRPSW
        HRRZS A         ;A HAS VIRTUAL PAGE #
        PUSHJ P,UPLC    ;RETURN POINTERS IN T AND Q
        LDB A,T         ;GET MAP ENTRY
        LDB C,Q         ;GET CIRC PNTR
        CAIE C,-1       ;DON'T SWAP OUT ABS PAGE
         TRNN A,600000
          POPJ P,       ;ALREADY OUT OR DOESN'T HAVE PAGE
        ANDI A,PMRCM    ;MASK TO REAL CORE PAGE #
        MOVNI C,1
        PUSHJ P,SWPOPG
         JFCL
        JRST CLKONJ

ASWAP3: MOVE B,[1250000.]
        SOJG B,.
        UMOVE A,2000
        JRST ASWAP3

ASWPCL: MOVEM U,PCLUSR
        CLEARM PCLL
        CLEARM PCLHSH
        SETOM PCLNXT
        HRRES A
        MOVEM A,PCLDBM
        POPJ P,
\f
;.CALL PGWRIT
; ARG 1 - A <JOB>
; ARG 2 - PAGE NUMBER IN <JOB>'S ADDRESS SPACE
;IF ONLY ONE ARGUMENT IS GIVEN, IT IS ARG 2, AND ARG 1 DEFAULTS TO CURRENT USER

;THE PAGE IS SWAPPED OUT.  THE CALL DOESN'T RETURN UNTIL THE SWAP IS COMPLETED.
; THIS ALLOWS USER TO BE SURE THAT THE COPY ON DISK IS UP TO DATE.
;CONTROL BIT 1.1 => RETURN IMMEDIATELY, NO WAITING.  TO WAIT LATER, JUST DO
; ANOTHER PGWRIT WITHOUT SETTING 1.1.
;CONTROL BIT 1.2 => UNLOCK PAGE.  IF YOU CALL THIS ON A LOCKED PAGE,
; WITHOUT SETTING BIT 1.2, THE PAGE WILL BE SWAPPED OUT, BUT THE NEXT
; TIME IT IS SWAPPED IN IT WILL BE LOCKED AGAIN.  THIS IS USEFUL FOR
; CONTROLLING EXACTLY WHEN A DATA BASE PAGE GETS WRITTEN TO DISK.

NPGWRT: CAIGE W,2
         JRST [ MOVE J,U ? JRST NPGWR1 ]
        MOVE J,A
        JSP T,NCORUI    ;DECODE THE JOB SPEC
         JRST NPGWR0
        JSP T,NCORWR    ;WHICH MUST BE WRITABLE
         JRST OPNL31
NPGWR0:
IFN PDP6P,[
        CAIN J,-1       
         JRST OPNL34    ;CAN'T HACK PDP6
];PDP6P
        MOVE A,B        ;NOTE: SWPOPG TAKES CARE OF THE PCLSR'ING
        PUSHJ P,NPGWR1  ;CALL MAIN ROUTINE
         POPJ P,        ;LOST, OPNL CLEARED LSWPR
        JRST LSWPJ1     ;WON, UNLOCK DIELOK

;USER INDEX IN J, PAGE NUMBER IN A
NPGWR1: TDNE A,[-1,,-400]
         JRST OPNL32    ;PAGE NUMBER NOT VALID
        PUSHJ P,CWAIT   ;DON'T ALLOW PAGE MAPS TO CHANGE, AND TURN CLK OFF
           SKIPL CIRPSW ;DON'T NEED UTCOFF BECAUSE UTC LEVEL CAN ONLY PUT PAGES INTO MAPS
        EXCH U,J
        PUSHJ P,UPLC
        EXCH U,J
        LDB D,Q         ;D GETS CIRC PNTR
        JUMPE D,OPNL32  ;NO PAGE THERE
        CAIN D,-1
         JRST OPNL12    ;ABSOLUTE PAGE
        PUSH P,U
        MOVE C,Q        ;STARTING FROM UPGCP, FIND MMP
        PUSHJ P,UCPRL
            200000,,.+2
         BUG            ;IF NONE FOUND
        SUB P,[4,,4]    ;FOUND MMP, C POINTS TO IT
        MOVSI T,MMPTMP  ;IF PAGE IS IN TRANSIT
        TDNE T,(C)
         JRST [ POP P,U
                TDNE T,(C)      ;AWAIT COMPLETION
                 PUSHJ P,UFLS
                JRST NPGWR1 ]   ;THEN TRY AGAIN
        MOVE E,C        ;SAVE ADDRESS OF MMP ENTRY
        PUSHJ P,UCPRL   ;SEE IF PAGE IS IN MEMORY
            100000,,NPGWR3
        POP P,U         ;NOT SWAPPED IN, BYPASS SWAP-OUT CODE
        JRST NPGWR2

NPGWR3: SUB P,[4,,4]    ;IT'S SWAPPED-IN TO CORE PAGE IN T
        POP P,U
        HLRZ D,MMSWP(T)
        JUMPN D,OPNL12  ;POINTED TO BY AN EXEC PAGE, E.G. 340, SHOULDN'T MESS.
        PUSH P,A        ;SAVE USER'S VIRTUAL PAGE #
        PUSH P,J        ;SAVE WHAT JOB THAT IS
        PUSH P,E        ;SAVE ADDRESS OF MMP ENTRY
        MOVE A,T        ;PHYSICAL PAGE # TO SWAP OUT
        MOVE C,USER     ;DON'T PCLSR ME
        PUSHJ P,SWPOPL  ;SWAP OUT, EVEN IF LOCKED
         JRST NPGWR4    ;NO DISK SPACE, OR SOME JOB NOT PCLSRABLE
        POP P,E
        POP P,J
        POP P,A
NPGWR2: MOVE T,CTLBTS(U)
        MOVSI D,MMPLOK
        TRNE T,2        ;CONTROL BIT 1.2 UNLOCKS
         ANDCAM D,(E)
        TRNE T,1        ;CONTROL BIT 1.1 INHIBITS WAITING FOR SWAP TO FINISH.
         JRST CLKOJ1
        MOVSI T,MMPTMP  ;PAGE IN TRANSIT BIT
        TDNE T,(E)      ;WAIT FOR BIT TO TURN OFF
         PUSHJ P,UFLS
        JRST CLKOJ1

;COULDN'T SWAP OUT, WAIT A WHILE AND TRY AGAIN
NPGWR4: PUSHJ P,UDELAY  ;UDELAY TURNS CLKON
        POP P,E
        POP P,J
        POP P,A
        JRST NPGWR1
\f
EBLK

;SWAP IN RQ BLOCKS
SWIRQB:
IFN 340P\E.SP,  DISSWI: -1      ;USER
IFN VIDP,       VIDSWI: -1
IFN IMXP,       POTSWI: -1
IFN NSWPV-.+SWIRQB,.ERR NSWPV ERR

SWIVPN:
IFN 340P\E.SP,  DISSPG: 0       ;VIRTUAL PAGE NUMBER
IFN VIDP,       VIDSPG: 0
IFN IMXP,       POTSPG: 0

SWPNTB:         ;SIGNAL BITS IN LH OF W TO CFHSW1
IFN 340P\E.SP,  400000  ;DISPLAY
IFN VIDP,       400000  ;VID
IFN IMXP,       400000  ;POTS

SWILMT:         ;PIRQC BIT TO SET ON ILM
IFN 340P\E.SP,  %PIDIS
IFN VIDP,       %PIMPV
IFN IMXP,       %PIMPV

PSWOUS: -1      ;INDEX OF PARTIALLY SWAPPED OUT USER
PSWCLS: 0       ;CLASS OF PARTIALLY SWAPPED OUT USER
PSWSFL: 0       ;-1 START FROM BEG OF USER, ELSE PICK UP WHERE LEFT OFF
SWPMBP: 0       ;PNTR TO MAP
SWPCBP: 0       ;PNTR TO CIRC DESC SPACE
PSWLC:  0       ;LOOP COUNT
SBEFLG: -1      ;0 => ALREADY ONCE WANTED TO CLEAR ALL "BEST EFFORT" BITS.
SWPOPR: 0       ;NUMBER OF PAGES DESIRED TO BE SWAPPED OUT
SWPOPB: 0       ;SWAP OUT REQUEST BUT ONLY SWAP OUT NON-RUNNING USERS TO MEET (UNUSED?)
SILNG:  0       ;TOTAL LENGTH OF SWAP IN LISTS
SOLNG:  0       ;TOTAL LENGTH OF SWAP OUT LISTS
                ;SINLST AND SOUTLS ARE IN DISK CODE.  VARIATION ON QBFP.
SWODSK: NQS-1   ;UNIT TO SWAP OUT ON NEXT
SWOBK:  0       ;MEMBLT BEING SWAPPED OUT
SWOMMP: 0       ;MMP ADDRESS (NOT INDEX)
SPGNMF: 0       ;-1 => PAGE NOT MODIFIED
CFHAS:  0       ;TEMP FOR A AT CFH
SWPIQS: 0       ;SAVE Q AT SWPPIN
CFHUVP: 0       ;USER'S VIRTUAL PAGE NUMBER TOOK FAULT ON
LUMPS:  0       ;UMAPS USED FOR CURRENT USER, MAY DIFFER FROM
                ;UMAPS(U) IF TOOK FAULT TRYING TO CAUSE INTERRUPT
TRUMM:  0       ;TOTAL USER MEM ACTIVE USERS
NPGSWO: 0       ;NUMBER OF CURRENTLY SWAPPED OUT PAGES
AUSOPG: 0       ;ACTIVE USER SWAPPED OUT PAGES
BUMPGS: 0       ;REAL CORE PAGES OCC BY BLOCKED + STOPPED LOSERS
NUSWB:  0       ;# LOSERS SWAP BLOCKED
SWPOPU: 0       ;USER PG "BELONGS" TO (IE NOT NECC TO PCLSR THIS GUY,
                        ;BUT PCLSR ANYONE ELSE LINKED TO PG.)
AGEREQ: 0       ;NUMBER OF PAGES BEING AGED AT SLOW CLOCK
AGEPOS: 0       ;LAST PAGE # AGED

IFE SWPWSP,[
PRVUSR: -1      ;PRIV USR
PRVCUT: 1500    ;CUT OFF FOR PRIV USR
SWUPC:  0       ;ABSOLUTE PAGE NUMBER OF USER MODE PC DURNING SWAP OUT
SWPP0F: -1      ;-1 IF CONSIDERING PAGE 0
ASBUM:  0       ;REAL MEM OCC BY ACTIVE "SWAPPED BLOCKED" LOSERS
SWSCT1: 0       ;TEM AT SWSCD
BUSR:   0       ;INDEX OF SMALLEST SWAP BLOCKED LOSER
BUSIZ:  0       ;SIZE OF BUSR
];SWPWSP

IFN PAGPRE,[
PREEMP: 0       ;IF NON-ZERO, A PRE-EMPT IS IN PROGRESS (WHEN WE NEXT GET TO CLK LVL)
NPREEL: 0       ;NUMBER OF LOOPS AT SCHEDP (ATTEMPTED PREEMPTS)
NPREEM: 0       ;NUMBER OF SUCCESSFULL PREEMPTS
NPREE1: 0       ;NUMBER OF TIMES A PAGE CAME IN AND WE STARTED TO THINK ABOUT PREEMPTION
NPREE2: 0       ;NUMBER OF TIMES WE DIDN'T PUNT BECAUSE OF CLKOFF OR IN PROGRESS
NPREE3: 0       ;NUMBER OF TIMES WE DIDN'T PUNT BECAUSE FLSINS WAS WRONG
];PAGPRE

;COUNTS OF REASONS FOR ENTRY TO SCHED
;THESE METERS MAY BE TEMPORARY - SOME OF THEM ARE REDUNDANT
;REASONS NOT COUNTED - VARIOUS PARITY, NXM, AND OTHER ERROR CASES
NLPPRE: 0       ;NUMBER OF TIMES LOST PROCESSOR DUE TO PREEMPT
NLPCLK: 0       ;NUMBER OF TIMES LOST PROCESSOR DUE TO CLOCK
NLPUFL: 0       ;NUMBER OF TIMES LOST PROCESSOR DUE TO UFLS
NLPPAG: 0       ;NUMBER OF TIMES LOST PROCESSOR DUE TO PAGE-IN
NLPPGT: 0       ;NUMBER OF TIMES LOST PROCESSOR DUE TO PAGE FAULT AND TUT LOCKED
NLPPGC: 0       ;NUMBER OF TIMES LOST PROCESSOR DUE TO PAGE FAULT AND CIRPSW LOCKED
NLPPGM: 0       ;NUMBER OF TIMES LOST PROCESSOR DUE TO PAGE FAULT AND MEMFRZ LOCKED
NLPPG3: 0       ;NUMBER OF TIMES LOST PROCESSOR DUE TO PAGE FAULT AND CALLED CFHPO3 (NO MEM)
NLPPGB: 0       ;NUMBER OF TIMES LOST PROCESSOR DUE TO PAGE FAULT AND SWAP-BLOCKED
NPPIUM: 0       ;NUMBER OF TIMES PAGE PUT INTO BUNCHA USERS' MAPS
NPPIU1: 0       ;NUMBER OF USERS PAGES PUT INTO MAPS OF  (RATIO OF THESE 2 IS SHARING)

IFN SWPWSP,[
LODQNT:         ;RUN TIME IN 4-USEC UNITS BETWEEN PG FAULTS TO LEAVE
                ;LOADING STATE 
 IFN KL10P, 3000.  ;12 MS
 IFN KA10P, 9000.  ;36 MS
 IFN KS10P, 3000.       .ERR Guessed LODQNT on KS10?
LODFCT: 3,,0    ;MULTIPLY LOADING TIME BY THIS TO GET PROTECT TIME (INT,,FRAC)
NUPTAW: 0 .SEE SWOP6 ;NUMBER OF USERS PAGE TAKEN AWAY FROM

;METERS

NPLBLJ: 0       ;NUMBER OF PAGE LOADS BY LOADING JOBS
NPLBNL: 0       ;NUMBER OF PAGE LOADS BY NON-LOADING JOBS

;Still to be done
;       1-, 5-, 15- minute average population of each state,
;               also avg of NPGWTU and RNABLU (for load avg)
;       avg of core occupied by jobs in each state,
;               i.e. UWRKST for load, pro, sw in.
;       Relationship of sum of UWRKST's of loading and swapped in
;               versus total core occupied by user pages.
;       Average time spent in each state before moving on,
;               versus size of job.  Maybe cpu time as well as
;               real time?

];SWPWSP
BBLK

\f
OVHMTR SWP      ;SWAP PAGE

;SWAP OUT PAGE WHOSE MEMBLT INDEX IS IN A
;SKIP IF SUCCESSFUL
;C IS USER WHO DOESN'T NEED TO BE PCLSRED BEFORE HIS PAGES CAN BE SWAPPED.
SWPOPL: TDZA B,B        ;THIS ENTRY IGNORES LOCK BIT
SWPOPG:  MOVSI B,MMPLOK ;THIS ENTRY RESPECTS LOCK BIT
        MOVEM C,SWPOPU
        MOVEM A,SWOBK
        CAIGE A,TSYSM
         CAIGE A,SYSB
          BUG           ;DON'T SWAP OUT PART OF SYSTEM
        AOSE CIRPSW
         POPJ P,
        LDB C,[MMMPX,,MEMBLT(A)]
        ADDI C,MMP
        HRRZM C,SWOMMP  ;STORE ADDRESS OF FIRST WORD OF MMP ENTRY
        TDNE B,(C) .SEE MMPLOK  ;LOCKED IN CORE?
         JRST [ CAIGE A,256.    ;IF SO, DON'T SWAP OUT UNLESS IN "LOW" MEMORY
                 CAIGE A,LIOBLK ;IN WHICH CASE MUST GO OUT TO AVOID SYSTEM DEADLOCK
                  JRST SCRPSJ   ;SEE CODE AT CIMEMR
                CAIGE A,128.
                 JRST .+1
                CAIL A,128.+NEXPGS ;SHADOWS OF EXEC PAGES
                 SKIPN USEMDM
                  JRST SCRPSJ
                JRST .+1 ]
        SOS CIRPSW      ;RELEASE SWITCH
        HLRZ B,1(C)
        JUMPN B,SWOP1   ;JUMP IF DISK SPACE ALREADY ASSIGNED
SWODF3: MOVSI B,-NQS
SWODF6: AOS I,SWODSK
        CAIL I,NQS
         SUBI I,NQS     ;WRAP AROUND
        MOVEM I,SWODSK  ;CURRENT SWAPPING DSK
        CONO PI,UTCOFF-1        ;DON'T CHANGE STATE OF CLOCK CHNL.
        SKIPGE QTUTO(I) ;TUT LOCKED
         JRST SWODF7
        SKIPL QACT(I)
        SKIPG QSFTS(I)  ;DSK FULL IN SWAPPING AREA
         JRST SWODF7
        MOVSI A,(SETZ)
        IORM A,QTUTO(I)
        CONO PI,UTCON-1 ;DON'T TURN ON CLOCK CHNL.
        MOVEI A,NQCHN+1(I)      ;QMFTP(A) CONTAINS TRACK TO START FROM
        PUSHJ P,QGTK4   ; RETURNS TRACK IN D
        SOS QSFTS(I)
SWODF5: MOVSI A,(SETZ)
        ANDCAM A,QTUTO(I)
        MOVE A,SWOMMP
        HRLM D,1(A)             ;STORE DISK ADDRESS IN MMP ENTRY        
        DPB I,[$MMPUN,,(A)]
        JRST SWOP1

SWODF7: AOBJN B,SWODF6  ;TRY NEXT DSK FOR SWAPPING AREA
        CONO PI,UTCON-1 ;NON FOUND FIND FILE SPACE
        MOVNI D,1
        MOVNI I,1
        MOVSI E,-NQS
SWODF2: SKIPL QTUTO(E)  ;FIND WHICH DISK HAS MOST FREE SPACE
        SKIPGE QACT(E)
         JRST SWODF4
        CAMGE D,QSFT(E)
         HRRZ I,E
        CAMGE D,QSFT(E)
         MOVE D,QSFT(E)
SWODF4: AOBJN E,SWODF2
        JUMPL I,CPOPJ   ;NO DSK SPACE AVAIL
        HRRZM I,SWODSK  ;LAST DSK HACKED
        JUMPLE D,CPOPJ  ; NO ROOM ANYWHERE
        CONO PI,UTCOFF-1
        SKIPGE QTUTO(I)
         JRST UTCNJ     ;TUT LOCKED
        MOVSI A,(SETZ)
        IORM A,QTUTO(I)
        CONO PI,UTCON-1
        MOVEI D,NBLKS/2 ;STARTING POINT
        MOVEI A,NQCHN+1(I) ;DISK CHANNEL
        MOVEM D,QMFTP(A)
        PUSHJ P,QGTK4   ;RETURNS TRACK IN D
        MOVEI E,NUDSL
        MOVEM E,QMFTP(A);DON'T LEAVE SWAPPING CHNL POINTING INTO FILE SPACE
        SOS QSFT(I)
        JRST SWODF5

SCRPSJ: SETOM CIRPSW
        POPJ P,
\f
SWOP1:  AOSE CIRPSW
         POPJ P,
        AOS NPGSO

;COME HERE FROM SWPOPG AND MMPRTN TO SWAP OUT A PAGE.
;CLOCK OFF OR IN PROGRESS AND ARGUMENTS IN SWOBK AND SWOMMP.
;PUTS BLOCK ON SWAPOUT LIST IF DISK COPY NEEDS TO BE UPDATED, ELSE
;JUST DELETES MEMORY.  IF NO USERS ARE USING THE PAGE,
;RETURNS THE MMP ENTRY OR ARRANGES FOR THE DISK ROUTINES TO.

SWOP1A: CONO PI,UTCOFF-1        ;DON'T CHANGE STATE OF CLOCK CHNL.
        MOVE A,SWOBK            ;CORE BLOCK # CONTAINING PAGE TO BE SWAPPED OUT
        HLRZ C,MMSWP(A)         ;NUMBER OF EXEC PAGES POINTING TO THIS PAGE
        JUMPN C,SWOP5           ;POINTED TO BY EXEC PAGE, CAN'T SWAP OUT
IFN 340P,[
        MOVSI C,-N340PB-2
SWOPT2: LDB I,DPEP(C)
        TRZN I,600000
         JRST SWOPT1
        ANDI I,PMRCM    ;MASK TO REAL CORE PAGE #
        CAIN I,(A)
         BUG            ;DISPLAY STILL SET UP TO PAGE BEING SWAPPED OUT
SWOPT1: AOBJN C,SWOPT2
]
        MOVSI C,MMPPGA
        ANDCAM C,@SWOMMP
        MOVSI C,(SETZ)
        IORM C,MEMBLT(A)        ;PREVENT NEW EXEC PAGES FROM BEING SET UP POINTING HERE
        CONO PI,UTCON-1
        MOVE C,[2200,,MEMPNT]
        ADD C,SWOBK
        SETOB B,SPGNMF  ;INITIALIZE PAGE NOT MODIFIED FLAG, AND COUNT USERS IN B
IFN SWPWSP,[
        LDB I,C
        PUSH P,I
        SETZM NUPTAW
        MOVSI D,-1      ;COMPUTE WORKING SET CONTRIBUTION TO BE TAKEN AWAY
        IDIV D,MMSWP(A) ;LH(MMSWP) KNOWN TO BE ZERO!
        PUSHJ P,UCPRL   ;CHECK ALL USERS, TAKE PAGE AWAY FROM SOME
            400000,,SWOP6       ;ALSO COUNTS USERS IN B
        POP P,I
        AOJE B,SWOP7    ;JUMP IF NO USERS USING PAGE, RETURN MMP ENTRY
        CAMN B,NUPTAW   ;ANY USERS STILL MAPPED TO PAGE?
         JRST SWOP8     ;NO, GO SWAP IT OUT
        MOVSI D,1       ;YES, COMPUTE WORKING SET ADJUSTMENT
        IDIV D,MMSWP(A) ;TO BE ADDED BACK IN TO THEM
        PUSHJ P,UCPRL   ;GO BACK AND FIX WORKING SETS
            400000,,SWOP6B
        JRST SWOP6E     ;ABORT SWAP OUT
];SWPWSP
IFE SWPWSP,[
        LDB I,C
        PUSH P,I        ;NOTE: CAN BACK OUT OF THIS PUSH AT SWOP2B
        PUSHJ P,UCPRL
            400000,,SWOP2       ;RETURN ON USERS (CAN BACK OUT AT SWOP2B)
        POP P,I
        JUMPGE B,SWOP8
];SWPWSP
SWOP7:  MOVSI B,MMPGON  ;NO USERS USING PAGE, SO MMP ENTRY WILL BE RETURNED
        IORM B,@SWOMMP  ;FLAG THAT MMP ENTRY WILL SOON GO AWAY
        MOVEI A,0       ;REMOVE FROM LOOSE PAGE LIST
        MOVE T,FLOOSP
SWOP7A: MOVE B,A        ;B PREDECESSOR
        SKIPN A,T       ;T SUCCESSOR
         BUG            ;NOT IN LIST?
        LDB T,[MLO,,MEMBLT(A)]
        CAME A,SWOBK
         JRST SWOP7A
        SKIPE B         ;FOUND, PATCH OUT OF LIST
         DPB T,[MLO,,MEMBLT(B)]
        SKIPN B
         MOVEM T,FLOOSP
        SKIPN T
         MOVEM B,LLOOSP
        SOSL NLOOSP
         JRST SWOP8
        BUG             ;NLOOSP TOO LOW.
\f
IFN SWPWSP,[

;THIS UCPRL ROUTINE SCANS ALL USERS, COUNTS THEM IN B,
;USES D TO ADJUST WORKING SETS OF USERS WHICH ARE MAPPED TO
;THE PAGE, AND TAKES THE PAGE AWAY FROM ANY USERS IT CAN,
;COUNTING THEM IN NUPTAW.
SWOP6:  AOS B           ;COUNT USERS OF THIS PAGE
        CAIG U,LUBLK
         BUG            ;SYS JOB OR CORE JOB?
        PUSH P,I
        MOVEI C,UPGMP(U)        ;MAKE C POINT TO UPGMP ENTRY (PTW)
        ROT I,-1
        ADDI C,(I)
        HRLI C,222200
        SKIPGE I
         HRLI C,2200
        LDB I,C
        SKIPN I
         BUG            ;NO ACCESS?
        TRNE I,600000
         ADDM D,UWRKST(U)       ;IS MAPPED TO PAGE, ADJUST WORKING SET
        CAMN U,SWPOPU
         JRST SWOP6A    ;DON'T CONSIDER PCLSRING SWPOPU
        MOVE T,UPC(U)
        TLNE T,%PCUSR
         JRST SWOP6A
        SKIPN LSWPR(U)  ;PCLSR IF HAS SWITCHES LOCKED
         SKIPN FLSINS(U)
          JRST SWOP6D
        MOVSI T,%SWPCL  ;DONT PCLSR NOW, BUT WHEN UNBLOCKS
        IORM T,USWST(U)
        JRST SWOP6A

SWOP6D: PUSH P,D
        PUSH P,C
        PUSH P,I
        PUSHJ P,PCLSR   ;BETTER NOT CLOBBER U OR H OR A
         JRST [ SUB P,[2,,2]
                POP P,D
                JRST SWOP6C ]
        POP P,I
        POP P,C
        POP P,D
;WHEN WE GET HERE, THIS JOB CAN'T HOLD THIS PAGE IN
SWOP6A: TRNN I,600000
         JRST SWOP6C    ;NOT SET UP SINCE PREV SWAPPED OUT
        AOS NUPTAW      ;TAKE IT AWAY
        LSH I,-16.      ;SAVE ACCESS MODE IN LOW ADR BITS
        CAILE I,2       ;SKIP ON READ ONLY OR READ/WRITE/FIRST
         CLEARM SPGNMF  ;PAGE HAS BEEN MODIFIED
        CAIN I,2        ;FLUSH R.W.F.
         MOVEI I,3
        DPB I,C         ;STORE PROTECTION BITS BACK IN LOWER TWO BITS OF ENTRY
        AOS NSWPGS(U)   ;INCR COUNT OF SWAPPED OUT PGS OF USER
        AOS SNSWPG      ;INCR CNT OF SWAPPED OUT FOR SYS
        SOS MMSWP(A)    ;DECR COUNT OF PAGE SHARERS
IFN E.SP,[
        CAMN U,DISUSR   ;IF USER OF E&S
         PUSHJ P,E.SLPM ;LOAD ITS MAP
]
SWOP6C: POP P,I
        POPJ P,

SWOP6F: CAMN U,-4(P)            ;DON'T LOOK AT USER TAKING PAGE AWAY FROM
         POPJ P,                ;ELSE DROP INTO SWOP6B
;THIS UCPRL ROUTINE ADJUSTS WORKING SETS OF JOBS THAT
;ARE MAPPED TO THE PAGE USING D.
SWOP6B: PUSH P,I
        MOVEI C,UPGMP(U)        ;MAKE C POINT TO UPGMP ENTRY (PTW)
        ROT I,-1
        ADDI C,(I)
        HRLI C,222200
        SKIPGE I
         HRLI C,2200
        LDB I,C
        SKIPN I
         BUG                    ;NO ACCESS?
        TRNE I,600000
         ADDM D,UWRKST(U)       ;IS MAPPED TO PAGE, ADJUST WORKING SET
        POP P,I
        POPJ P,
];SWPWSP
\f
IFE SWPWSP,[
;COME HERE VIA UCPRL FOR ALL USERS OF PAGE BEING SWAPPED OUT

SWOP2:  AOS B   ;COUNT USERS OF THIS PAGE
        CAIG U,LUBLK
         BUG            ;SYS JOB OR CORE JOB?
        PUSH P,I
        CAMN U,SWPOPU
         JRST SWOP2A
        MOVE T,UPC(U)
        TLNE T,%PCUSR
         JRST SWOP2A
        SKIPN LSWPR(U)  ;PCLSR IF HAS SWITCHES LOCKED
         SKIPN FLSINS(U)
          JRST SWOP2D
        MOVSI T,%SWPCL  ;DONT PCLSR NOW, BUT WHEN UNBLOCKS
        IORM T,USWST(U)
        JRST SWOP2A

SWOP2D: PUSHJ P,PCLSR
         JRST SWOP2B
SWOP2A: MOVEI C,UPGMP(U)
        ROT I,-1
        ADDI C,(I)
        HRLI C,222200
        SKIPGE I
         HRLI C,2200
        LDB I,C
        SKIPN I
         BUG            ;NO ACCESS?
        TRNN I,600000
         JRST SWOP2C    ;NOT SET UP SINCE PREV SWAPPED OUT
        LSH I,-16.      ;SAVE ACCESS MODE IN LOW ADR BITS
        CAILE I,2       ;SKIP ON READ ONLY OR READ/WRITE/FIRST
         CLEARM SPGNMF  ;PAGE HAS BEEN MODIFIED
        CAIN I,2        ;FLUSH R.W.F.
         MOVEI I,3
        DPB I,C         ;STORE PROTECTION BITS BACK IN LOWER TWO BITS OF ENTRY
        AOS NSWPGS(U)   ;INCR COUNT OF SWAPPED OUT PGS OF USER
        AOS SNSWPG      ;INCR CNT OF SWAPPED OUT FOR SYS
        MOVE I,SWOBK
        SOS MMSWP(I)    ;KEEP ACCURATE COUNT OF UPGMP'S POINTING AT THIS PAGE
IFN E.SP,[
        CAMN U,DISUSR   ;IF USER OF E&S
         PUSHJ P,E.SLPM ;LOAD ITS MAP
]
SWOP2C: POP P,I
        POPJ P,

SWOP2B: SUB P,[6,,6]    ;2 PUSHES OF I AND 4 FOR UCPRL
];SWPWSP
SWOP6E: MOVE A,SWOBK    ;ABORT SWAP-OUT
        MOVSI I,(SETZ)
        ANDCAM I,MEMBLT(A)
        SOS CIRPSW
        POPJ P,

SWOP8:  DPB I,C         ;DELINK MEMPNT
        MOVEI I,3 .SEE MMPOUT .SEE MMPTMP
        DPB I,[410200,,@SWOMMP] ;INDICATE ON THE WAY OUT
        MOVSI I,MMPBAD
        ANDCAM I,@SWOMMP
        MOVE A,SWOBK
        MOVSI B,(SETZ)
        CONO PI,UTCOFF-1
        ANDCAM B,MEMBLT(A)
        MOVE C,@SWOMMP
        TLNN C,MMPGON   ;UNLESS PAGE WILL BE FORGOTTEN AFTER SWAP OUT,
         AOS NPGSWO     ; KEEP COUNT OF PAGES CURRENTLY SWAPPED OUT
        TLNE C,MMPWRT   ;IF WAS WRITTEN BY USER WHO LATER DELETED IT,
         JRST SWOP3
        SKIPGE SPGNMF   ;OR IF PAGE MODIFIED,
         TLNN C,MMPWOD
          JRST SWOP3    ;OR IF HASN'T BEEN WRITTEN TO DISK, MUST WRITE OUT.
        MOVEI I,2       ;NO NEED TO WRITE OUT.  INDICATE OUT.
        DPB I,[410200,,@SWOMMP]
        PUSHJ P,IMEMR   ;RETURN THE MEMORY
        MOVE A,SWOMMP
        TLNE C,MMPGON
         PUSHJ P,RETMMP ;ALSO RETURN THE MMP ENTRY IF NECESSARY
        JRST SWOP4
\f
SWOP5:  SOS CIRPSW
UTCNJ:  CONO PI,UTCON-1 ;DON'T TURN ON CLOCK CHNL
        POPJ P,

SWOP3:  CAIGE A,TSYSM           ;HAVE TO WRITE THIS PAGE OUT
        CAIGE A,SYSB
         BUG
        HRRZ B,SWOMMP
        LDB I,[$MMPUN,,(B)]
        CAIL I,NQS
         BUG                    ;DISK NUMBER NOT LEGITIMATE
        MOVEI C,.BM MLO
        ANDCAM C,MEMBLT(A)      ;SET END OF LIST IN THIS BLOCK
        HLRZ C,SOUTLS(I)        ;GET PREV BLOCK
        SKIPE C
         DPB A,[MLO,,MEMBLT(C)] ;CHAIN TO PREV BLOCK
        SKIPN C
         MOVEM A,SOUTLS(I)      ;OR TO HEADER IF FIRST
        HRLM A,SOUTLS(I)        ;AND SET NEW LAST BLOCK
        AOS SOLNG
        HLRZ C,1(B)
        HRLM C,MEMPNT(A)        ;STORE DISK ADDRESS
        MOVEI B,MUSWPG
        DPB B,[MUR,,MEMBLT(A)]
        PUSHJ P,QSTRT1
SWOP4:  SOS CIRPSW
UTCNJ1: CONO PI,UTCON-1
        JRST POPJ1

IFN NSWPV,[
SWPPIN: MOVSI Q,-NSWPV          ;# OF DEVICES THAT CAN SWAP IN PAGES
SWPPI4: SKIPGE W,SWIRQB(Q)      ;USER INDEX
         JRST SWPPI6
        MOVE E,SWIVPN(Q)        ;VIRTUAL PAGE NUMBER
        HRL W,SWPNTB(Q)
        CLEARB TT,D
        MOVEM Q,SWPIQS
        PUSHJ P,CFHSW1
        MOVE Q,SWPIQS
        SETOM SWIRQB(Q)
SWPPI6: AOBJN Q,SWPPI4
        POPJ P,
]

SWIILM:
IFN E.SP,[
        TRNN Q,-1       ; IS DEVICE DIS? (E&S IS INDEX 0 IN SWIRQB)
         SETZM E.SPGW   ; IF SO, CLEAR PAGE WAIT.
]
        SKIPGE E,SWILMT(Q)
         BUG
        IORM E,PIRQC(W)
        MOVEI A,0
        POPJ P,
\f
SUBTTL LOAD USER PAGE MAP

OVHMTR UUO      ;RANDOM UUOS (WELL, SOME MINOR SCHED STUFF, TOO)

;SET PAGE MAP AT M.P. LEVEL, ASSUMING UMAPS HAS BEEN ALTERED.
;UMAPS EXISTS SO SCHEDULER CAN RESTORE THE MAP AFTER OTHER JOBS RUN.
;FORMAT OF A MAP SPECIFICATION IS:
%UM==1,,525252
%UMMPL==200000  ;1 => MAP LOWER HALF TO SPEC'D JOB'S; 0 => USE LOWER OF JOB IN U.
%UMMPU==100000  ;1 => MAP UPPER HALF TO SPEC'D JOB'S; 0 => USE UPPER OF JOB IN U. 
%UMALL==300000  ;SET => SELECT WHOLE MAP OF SPEC'D JOB.
%UMUTL==40000   ;IGNORED IF %UMMPU=0. IF %UMMPU=1, MEANS USE SPEC'D JOB'S LOWER
                ;INSTEAD OF ITS UPPER, AS OUR UPPER HALF. READ "%UM UPPER-TO-LOWER".
%UMLTU==20000   ;"%UM-LOWER-TO-UPPER". WITH %UMMPL, MAKES LOWER -> SPEC'D JOB'S UPPER.
%UMSOA==4000    ;1 => USE AC0S AS THE USER'S ACS, INSTEAD OF UUOACS.
                ;NOTE IF %UMLTU=1, OR IF LOWER -> PDP6, THE GARBAGS ACS ARE USED.
                ;ELSE, THE ACS COME FROM THE JOB WHICH OUR LOWER HALF COMES FROM.
;RH             ;JOB INDEX OF THE "SPECIFIED JOB". -1 => PDP6.
                ;NOT NEEDED IF %UMMPL=%UMMPU=0.

PGLDU:  MOVE R,UMAPS(U)
;SET PAGE MAP AT INT. LEVEL, NOT CLOBBERING JOB'S UMAPS. ARG IN R.
PGLD:   MOVEM R,LUMPS   ;LAST UMAPS ACTUALLY USED
        AOS NPGLD       ;COUNT # CALLS TO PGLD
        PUSH P,A        ;R HAS UMAPS CODE
        PUSH P,B
        PUSH P,C
        HRRZ C,U
IFN KA10P, MOVSI B,NUVPG/2      ;SET UP NORMAL DBL, MIGHT BE CHANGED IF PDP6
IFE KA10P, MOVSI B,0            ;ONLY KA10 HAS DBL
        TLNN R,%UMMPL
         JRST PGLD3A    ;USE NORMAL LOW SEG
IFN PDP6P,[
        TRNE R,400000
         JRST PGLD3B    ;USE PNTR TO PDP6
]
        HRRZ C,R
        TLNE R,%UMLTU   ;SKIP ON USE HIS LOWER
         JRST PGLD3D    ;USE HIS UPPER
PGLD3A: HRRI B,UDBR1A(C)
        TLNE R,%UMSOA
         JRST PGLD3G    ;MAKE AC'S POINT AT SWAP OUT AC'S
        MOVEI A,UUOACS(C)
PGLD3F: MOVEM B,UPDBR1(U)
IFN KA10P, DPB A,[2300,,UPACP(U)]       ;STORE AC PNTR
IFE KA10P,[
        CAMN A,AC1PTR   ;IF CHANGING AC BLOCK 1
         JRST PGLD3H
        EXCH A,AC1PTR   ;STORE OLD BLOCK 1
        MOVE B,A
        XCTR XBR,[BLT B,17(A)]
        MOVS A,AC1PTR   ;AND LOAD NEW BLOCK 1
        XCTR XBW,[BLT A,17]
PGLD3H: ] ;IFE KA10P
IFN KA10P, MOVSI B,NUVPG/2      ;SET UP DBL FOR DBR2
IFE KA10P, MOVSI B,0
        HRRI B,UDBR2A(U)
        TLNN R,%UMMPU
         JRST PGLD6     ;USE NORMAL UPPER SEG
        HRRI B,UDBR2A(R)
        TLNE R,%UMUTL
         HRRI B,UDBR1A(R)
IFN PDP6P,[
        TRNE R,400000
         MOVE B,PDP6MP
]
PGLD6:  MOVEM B,UPDBR2(U)
PGLDR1: LPMR UPGML(U)
        POP P,C
        POP P,B
        POP P,A
        POPJ P,

IFN PDP6P,      PGLD3B: SKIPA B,PDP6MP
PGLD3D: HRRI B,UDBR2A(R)
        MOVEI A,GACS
        JRST PGLD3F

PGLD3G: MOVEI A,AC0S(C)
        JRST PGLD3F

GACS:   BLOCK 20        ;GARBAGE AC'S POINTED TO BY ACPNTR WHEN ITS REALLY POINTING
                ;AT UPPER PAGES OR PDP6  SHOULD HOPEFULLY NEVER GET REFERENCED

;MAIN PROGRAM MAP-SETTING ROUTINES.
IFN PDP6P,[
MP6LD:  SKIPA J,[%UMMPU,,-1]    ;LOAD UPPER DBR TO PNT TO 6
];PDP6P
MPLDZ:   MOVEI J,0              ;SET NORMAL MAP - OUR OWN CORE.
MPLD1:  CAMN J,UMAPS(U)         ;SET UMAPS AS SPEC'D
         JRST CLKONJ
        MOVEM J,UMAPS(U)
MPLD:   CONO PI,CLKOFF
        PUSHJ P,PLD
        JRST CLKONJ

;SET MAP TO JOB # IN J; MIGHT OR MIGHT NOT BE THE CURRENT JOB. SAVES RH(J)
MPLDJ:  CAME J,USER
         TLOA J,%UMSOA+%UMALL   ;OTHER JOB'S ACS ARE IN ITS AC0S.
          TLO J,%UMALL          ;THIS JOB => WANT UUOACS.
        JRST MPLD1

;SIMILAR ROUTINES, BUT FOR USE WHEN CLKCHN IS OFF AND SHOULD STAY OFF.
IFN PDP6P,[
PLD6:   SKIPA J,[%UMMPU,,-1]    ;MAKE UPPER DBR POINT TO PDP6.
];PDP6P
PLDZ:    MOVEI J,0              ;NORMAL MAP
PLD1:   MOVEM J,UMAPS(U)
PLD:    SPM UPGML(U)    ;IF ANY INHIBITED FAULT PRESENT, CAUSE IT TO GET STORED AWAY
        PUSH P,R
        PUSHJ P,PGLDU   ;CAUSE ACTUAL PG LOAD TO HAPPEN
        POP P,R
        POPJ P,
\f
SUBTTL GIVING THE USER INTERRUPTS

SEAR2E: MOVE A,PIRQC(U)

;ROUTINE TO HANDLE FIRST WORD (PIRQC) INTS
SEAR2A: JUMPL A,SEAR2B  ;REQUEST TO PCLSR
        SKIPN PICLR(U)
         JRST SEAR2C    ;PI IN PROG, ONLY LOOK FOR FATAL INTS.
        SETCM Q,IDF1(U)
        AND Q,MSKST(U)  ;ENABLED UNDEFERRED INTS.
        TDNN A,Q        ;ANY OF THOSE PENDING,
         TDNE A,[BADBTS]        ;OR ANY CLASS 1 OR 2 => INTERRUPT.
          CAIA
           JRST SEARL2
        ANDCA Q,A       ;GET DISABLED OR DEFERRED PENDING INTS.
        TDNN Q,[BADBTS] ;ANY CLASS 1 OR 2 DISABLED OR DEFERRED
         JRST INTWD1     ;NO, INT. THIS JOB.
        JRST SEAR2D     ;YES, INT. SUPERIOR.

SEAR2C: TDNN A,[BADBTS] ;PI IN PROG: ANY CLASS 1 OR 2 ?
         JRST SEARL2     ;NO, NOTHING TO DO.
SEAR2D: PUSHJ P,PCLSR   ;INT. THE SUPERIOR: PCLSR FIRST.
         JRST SEARC     ;CAN'T STOP THIS JOB IN EXEC MODE.
        SETZ B,         ;OK, HANDLE FATAL 1ST WORD INTS IN A, AND NO 2ND WORD INTS.

;HANDLE A FATAL INTERRUPT BY INTERRUPTING THE SUPERIOR.
;FATAL 1ST WORD INTERRUPTS IN A,  FATAL 2ND WORD INTS IN B.
INTSUP: MOVEM A,SRN4(U) ;.FTL1
        MOVEM B,SRN5(U) ;.FTL2 ;PUT THE FATAL INTERRUPTS WHERE SUPERIOR CAN READ THEM.
        MOVSI T,BUSRC
        IORM T,USTP(U)  ;STOP INFERIOR
IFN SWPWSP, PUSHJ P,LVLOAD
        MOVSI T,BULGOS  ;IF LOST TRYING TO LOG OUT, ABORT LOGOUT
        ANDCAM T,APRC(U)
        MOVE Q,U        ;SAVE USER INTERRUPTING
        SKIPGE U,SUPPRO(U)      ;SKIP UNLESS TOP LEVEL
         JRST INTTOP    ;REALLY TOP LEVEL
        HLLZ T,U        ;GET INT BIT
        IORM T,IFPIR(U) ;TURN ON INTERRUPT BIT IN SUPERIOR
        HRRZS U         ;CLEAR LEFT HALF OF U
        CAIL J,(U)      ;SKIP IF SUPERIOR HAS NOT YET BEEN SCHEDULED
         JRST SEARL1    ;RESCHEDULE SUPERIOR
        JRST SEARL      ;HAVEN'T GOT TO HIM YET SO CONTINUE

INTTOP: MOVEI T,SCRDET
        SKIPL APRC(Q)   ;IF JOB ISN'T ALREADY DISOWNED
         IORM T,SUPCOR  ;SAY SOMEONE WANTS TO BE DETACHED.
        JRST SEARL      ;LEAVE STOPPED, SYS JOB WILL DETACH SOMEDAY.

SEAR2B: PUSHJ P,PCLSR   ;PCLSR THE JOB, E.G. SO IT CAN GET AN IOC ERROR
         JRST SEARC     ;RUNNING IN EXEC MODE, GO RUN IT
        MOVSI A,(SETZ)  ;CLEAR REQUEST
        ANDCAM A,PIRQC(U)
        JRST SEARL1     ;INSPECT THIS JOB AGAIN
\f
;IFPIR IS NONZERO BUT PIRQC IS ZERO.
INTWD2: SKIPN PICLR(U)
         JRST SEARL3    ;IGNORE 2ND WD INTS IF PI IN PROG.
        AND B,MSKST2(U)
        ANDCM B,IDF2(U) ;GET ENABLED UNDEFERRED INTS.
        JUMPE B,SEARL3  ;ALL DISABLED OR DEFERRED.
        JSP T,INTPAG    ;MAKE SURE NOT WAITING FOR PAGE NEEDED FOR INT.
        PUSHJ P,PCLSR   ;DON'T INT. EXCEPT IN USER MODE.
         JRST SEARC
        SETZ A,         ;1ST WD INTS TO GIVE = 0.
        JRST INTSRC     ;2ND WD INTS TO GIVE ALREADY IN B.

;PIRQC WAS NONZERO BUT NO FATAL INTS.
INTWD1: JSP T,INTPAG    ;IF TRIED BEFORE & WENT TO INTPFL, WAIT FOR PAGE.
        PUSHJ P,PCLSR   ;CAN INT. ONLY IN USER MODE.
         JRST SEARC
        MOVE B,IFPIR(U)
        AND B,MSKST2(U) ;GET PENDING ENABLED UNDEFERRED 2ND WD INTS IN B.
        ANDCM B,IDF2(U)
        AND A,MSKST(U)
        ANDCM A,IDF1(U) ;PENDING ENABLED UNDEFERRED 1ST WD INTS IN A.
INTSRC: AOS NAUINT      ;ELSE 1 MORE ATTEMPT TO INTERRUPT.
        MOVSI R,%UMSOA  ;LOAD ORDINARY MAP FOR THIS USER.
        PUSHJ P,PGLD    ;BUT ACS -> SWAP OUT ACS.
        HRRZ T,40ADDR(U) ;GET ADDR OF USER'S LOCATION "40"
        XCTRI XR,[MOVE T,2(T)] ;TRY TO GET CONTENTS OF "42" (..I SO STOP ON EXEC PG FAULT DOESNT)
         SKIPA R,T
          JRST INTPFL   ;PAGE FAULT IN XCTR, GIVE UP & WAIT FOR PAGE.
        ANDI R,-1
        JUMPE R,INTBAD  ;42 POINTS TO 0 => BADPI ERROR.
        MOVE TT,OPTION(U)
        TLNN TT,%OPINT  ;NEW STYLE INTERRUPTS?
         JRST INTOLD     ;NO, OLD STYLE.
        XCTRI XR,[MOVE R,(R)] ;GET ADDR OF HIS INT PDL PTR.
         CAIA
          JRST INTPFL
        JUMPGE T,INTBAD
        CAMGE T,[-72.*5-1,,]
         JRST INTBAD
        XCTRI XR,[MOVE H,(R)] ;GET CONTENTS OF INT PDL PTR.
        JRST INTSR2     ;ADVANCE T PAST INT PDL PTR ADDR.
         JRST INTPFL

INTSR0: XCTRI XR,[MOVE C,(T)] ;GET THE INTS NEXT INT TABLE ENTRY
         SKIPA D,B
          JRST INTPFL   ;APPLIES TO.
        XCTRI XR,[AND D,1(T)]
         CAIA
          JRST INTPFL
        AND C,A         ;WHICH OF THEM ARE WE TRYING TO GIVE?
        JUMPN C,.+2
         JUMPE D,INTSR1 ;NOT GIVING ANY OF THEM, TRY NEXT ENTRY.
        MOVE Q,IDF1(U)  ;GET CURRENT SETTINGS OF DEFER WORDS.
        XCTRI XW,[MOVEM Q,3(H)]
         SKIPA Q,IDF2(U)        ;AND PUT INTO NEXT INT PDL FRAME.
          JRST INTPFL
        XCTRI XW,[MOVEM Q,4(H)]
         SKIPA Q,UPC(U) ;ALSO PUT CURRENT PC IN FRAME.
          JRST INTPFL
        XCTRI XW,[MOVEM Q,5(H)]
         CAIA
          JRST INTPFL
        XCTRI XR,[MOVE E,2(T)] ;NOW SEE WHICH DEFER BITS TO TURN ON NOW.
         CAIA
          JRST INTPFL
        XCTRI XR,[MOVE TT,3(T)]
         CAIA
          JRST INTPFL
        XCTRI XR,[MOVE Q,4(T)] ;AND THE NEW PC.
         TLOA Q,%PCUSR
          JRST INTPFL
        TLZ Q,BADPC
        SKIPGE IOTLSR(U)
         TLO Q,%PCUIO   ;DON'T CHANGE HIS IOTLSR STATUS.
        XCTRI XW,[MOVEM C,1(H)]
         CAIA           ;PUT INTS BEING GIVEN IN
          JRST INTPFL   ;INT. PDL FRAME.
        XCTRI XW,[MOVEM D,2(H)]
         TDZA B,D
          JRST INTPFL
        MOVE W,H        ;REMEMBER PDL PTR BEFORE INCREMENT, FOR PDL OV TESTING
        ADD H,[5,,5]
        LDB J,[220500,,R]       ;HOW MANY ACS SHOULD WE SAVE?
        JUMPE J,INTSR5          ;NONE?
        HRLS J
        ADD H,J                 ;ADVANCE THE PDL PTR OVER WHERE THEY'LL GO.
        SUBM H,J                ;GET BACK THE OLD UN-ADVANCED PDL PTR IN J.
        ROT R,14
        HRLI J,(R)              ;PUT 3.7-4.1 OF R INTO LH(J) CIRCUITOUSLY
        TLZ J,777760
        ROT R,-14
        AOS J                   ;MAKE J POINT AT 1ST UNUSED PDL WORD.
        XCTRI XBRW,[BLT J,(H)]
         CAIA
          JRST INTPFL
INTSR5: JUMPGE R,INTSR4 ;SAVE DEBUGGING INFO ON INT PDL IF USER WISHES
        HRRZ J,UPJPC(U)
        XCTRI XW,[MOVEM J,1(H)]
         SKIPA J,SUUOH(U)
          JRST INTPFL
        XCTRI XW,[MOVEM J,2(H)]
         SKIPA J,LSPCL(U)
          JRST INTPFL
        XCTRI XW,[MOVEM J,3(H)]
         CAIA
          JRST INTPFL
        ADD H,[3,,3]
INTSR4: MOVE J,U        ;MAYBE? SCHED LOOP WANTS USER IDX IN J?
        XCTRI XW,[MOVEM H,(R)]  ;STORE BACK THE PDL POINTER, THUS FINALIZING ALL
         TDZA A,C       ;INTS HAVE BEEN GIVEN; NOW WE CAN CHANGE THE USER VARS.
          JRST INTPFL
        ANDCAM C,PIRQC(U)
        ANDCAM D,IFPIR(U)
        IORM E,IDF1(U)  ;SET THE DEFER BITS SPEC'D IN TABLE ENTRY.
        IORM TT,IDF2(U)
        MOVEM Q,UPC(U)  ;START USER AT INT HANDLER.
        JUMPL H,INTSR3  ;NOW CHECK FOR INT PDL OVFLO.
        JUMPGE W,INTSR3
        MOVEI TT,%PIPDL ;THERE WAS OVFLO, SET PDL OV INT
        TDNN TT,MSKST(U) ;IF ENABLED.
         JRST INTSR3
        IORM TT,PIRQC(U)
        JRST SEAR2E     ;RE-TRY THE INTERRUPT.

INTSR3: JUMPN A,SEAR2E  ;MORE INTS TO GIVE => RETRY.
        JUMPN B,SEAR2E
INTSRX: AOS NUINT       ;1 MORE INT GIVEN SUCESSFULLY.
        SPM UPGML(U)
        JRST SEARC      ;SCHEDULE.

INTSR1: ADD T,[4,,4]    ;NO INTS GIVEN, TRY NEXT ENTRY.
INTSR2: AOBJN T,INTSR0
        JRST INTSUP     ;ENABLED INTS BUT NO ENTRIES FOR THEM.

;GIVE INTS THE OLD WAY.
INTOLD: SKIPN C,A       ;GIVE INTS OF 1 WD AT A TIME.
         SKIPA C,B       ;(NO 1ST WD, GIVE ALL 2ND WD)
        TDZA B,B        ;(SOME 1ST WD INTS, GIVE NO 2ND WD INTS)
         TLO C,4^5       ;(GIVING 2ND WD, SET SIGN TO SAY SO)
        XCTRI XW,[MOVEM C,(T)]
         SKIPA Q,UPC(U) ;STORE INTS BEING GIVEN,
          JRST INTPFL
        MOVEI T,2(T)    ;ADVANCE -> PLACE TO START USER.
        XCTRI XW,[MOVEM Q,-1(T)]
         TLOA T,%PCUSR  ;OLD PC STORED, SET UP NEW.
          JRST INTPFL
        ANDCAM A,PIRQC(U) ;SAY THESE INTS NOW GIVEN.
        ANDCAM B,IFPIR(U)
        SKIPGE IOTLSR(U)
         TLO T,%PCUIO
        MOVEM T,UPC(U)  ;SET HIS PC -> TSINT+2
        SETZM PICLR(U)
        JRST INTSRX
\f       
;IF WE ARE WAITING FOR A PAGE NEEDED FOR TAKING AN INTERRUPT,
;GIVE UP ON TRYING TO TAKE TE INT. UNLESS PAGE HAS COME IN SINCE LAST TRY.
INTPAG: MOVSI E,%SWPGW
        SKIPE FLSINS(U)
         TDNN E,USWST(U)
          JRST (T)      ;JOB NOT WAITING FOR PAGE
        MOVSI E,%SWINT
        TDNN E,USWST(U)
         JRST (T)       ;NOT WAITING FOR INTERRUPT PAGE
        MOVE E,T
        MOVE T,EPDL2(U)
        XCT FLSINS(U)
         JRST SEARL     ;PAGE NOT IN
        MOVSI T,%SWPGW+%SWINT   ;PAGE IN
        ANDCAM T,USWST(U)
        SETZM FLSINS(U)
        SOS NPGWTU
        JRST (E)

;COME HERE WHEN AN XCTRI TAKES FAULT WHILE TRYING TO STORE AN INTERRUPT.
INTPFL: MOVE J,U        ;MAYBE? SCHED MAIN LOOP WANTS USR IDX IN J.
        SPM UPGML(U)    ;STORE MAP IN INTERRUPTING STATE
IFN KA10P, LDB T,[221000,,UPJPC(U)]     ;FAULT ADDRESS
IFN KL10P, LDB T,[$PFPNO,,UPFW(U)]
IFN KS10P, LDB T,[$PFPNO,,EPTP7W]       ; Fault happened at PI level 7.
        ROT T,-1
        ADDI T,UPGCP(U)
        SKIPL T
         TLOA T,222200
          HRLI T,2200
        LDB E,T
        JUMPE E,INTBAD  ;DON'T HAVE PAGE
IFN KA10P,[
        HLLZ T,UPQUAN(U)
        TLNE T,100
         JRST INTBAB    ;WRITE IN RD ONLY
INTBAC: HLLZ T,UPC(U)   ;SIMULATE SETUP OF OPC
        LSH T,-5
        HRR T,UPC(U)
        MOVEM T,UPOPC(U)        ;FAULT STATUS
        MOVSI T,1000
        IORM T,UPQUAN(U)        ;BIT NOT SET BY XCTRI
        MOVSI T,%SWINT
        IORM T,USWST(U) ;PAGE FAULT RESULT OF INTERRUPT ATT
        LPMRI UPGML(U)  ;SET MPV FLAG, WILL CAUSE INT. LATER LPMR'S WON'T
                        ; CLEAR IT.
        JRST SCHED6     ;"RUN" USER, TAKING PAGE FAULT IMMEDIATELY

INTBAB: TLNE T,50       ;NO ACCESS OR W IN RWF
         JRST INTBAC    ;PAGING BOX BUG? IGNORE RD ONLY
        JRST INTBAD     ;REALLY IS READ-ONLY.
] ;KA10P
IFN KL10P,[
        SUBI T,UPGCP-UPGMP
        LDB E,T
        TRNE E,600000
         LSH E,-20
        CAIN E,2        ;RWF
         JRST INTBAB
        MOVS T,UPFW(U)
        ANDI T,%PFCOD
        CAIE T,%PFPNA
         JRST INTBAD    ;REAL VIOLATION
;DROPS THROUGH
\f;DROPS IN
;KL10P  ;PF OR RWF, TAKE THE FAULT, READ IN THE PAGE, THEN TRY TO INTERRUPT AGAIN

INTBAB: MOVSI T,%SWINT
        IORM T,USWST(U) ;PAGE FAULT RESULT OF INTERRUPT ATTEMPT
        SETOM DLSRCH    ;DON'T INTERRUPT AT INTBA1, SCHEDULE, TRY TO PCLSR
                        ; WITH WRONG PC
        MOVEI T,INTBA1
        EXCH T,UPC(U)   ;HACK USER'S PC
        MOVEM T,EPDL3(U)
        JRST SCHED6     ;RUN USER, RETURNING IMMEDIATELY TO INTBA1

INTBA1: CONO PI,PIOFF
        SETZM DLSRCH
        MOVEM U,PFAILU  ;SIMULATE A PAGE FAULT ON THE INTERRUPT WORD
        MOVE U,USER
        MOVE U,EPDL3(U)
        MOVEM U,PFOPC1  ;RESTORE USER'S PC
        MOVNI U,2
        MOVEM U,PFAILF  ;FLAG FAULT FROM INTPFL
        MOVE U,PFAILU   ;RESTORE U SO CLKSAV CAN RE-SAVE IT
        CONO PI,CLKRQ   ;TURN PI SYSTEM ON AND CAUSE CLOCK BREAK
        JRST .          ;TAKES A WHILE TO GO OFF
] ;KL10P
IFN KS10P,[
        MOVE T,EPTP7W
        TLNE T,%PF2.8           ; Write in read only?
         JRST INTBAD            ; Yes:  %PIB42
        MOVEM T,UPFW(U)         ; No:  Set up for a simulated fault
        MOVSI T,%SWINT
        IORM T,USWST(U)         ; Signal fault as result of interrupt attempt
        SETOM PFAILF            ; Cause CLK level to go to PFLU2 at
                                ; first opportunity.
        MOVEI T,CCLKRQ          ; Make sure that happens real fast
        EXCH T,UPC(U)           ; by setting his PC thusly.
        MOVEM T,EPTPFO          ; Save old PC as location of fault.
        JRST SCHED6             ; Go run this user.
] ;KS10P

INTBAD: MOVEI A,%PIB42  ;TURN ON BAD PI LOC INT BIT
        IORB A,PIRQC(U) ;GIVE USER INTERRUPT(MUST IORM TO AVOID TIMING ERR)
        JRST SEAR2A     ;RE-PERFORM ACTIONS FOR NON-ZERO PIRQC
                ;WILL CAUSE AN INTERRUPT TO SUPERIOR

;INTERRUPT ALL USERS THAT WANT IT
;  C(A) IS BIT IN PIRQC TO TURN ON
DBGINT: MOVSI A,(%PIDBG)        ;"SYS BEING DEBUGGED" INT
INTALL: MOVEI U,0       ;ENTRY INITIALIZE
INTA2:  ADDI U,LUBLK    ;ADVANCE TO NEXT BLOCK OF USER VARIABLES
        CAML U,USRHI    ;SKIP UNLESS AT END
        POPJ P,         ;THROUGH, RETURN
        SKIPN UNAME(U)  ;SKIP IF BLOCK IN USE
        JRST INTA2      ;IDLE, IGNORE
        LDB T,[410100,,USTP(U)] ;GET BUCSTP OF USERS STOP WORD
        JUMPN T,INTA2   ;IF USER CONTROL STOPPED, JUMP TO IGNORE
        MOVE B,MSKST(U) ;PICK UP INTERRUPT MASK
        AND B,A         ;MASK C(B) TO APPROPRIATE BIT
        IORM B,PIRQC(U) ;GIVE INT TO USER
        JRST INTA2      ;LOOP
\f
SUBTTL PCLSR ROUTINES

; PUT PC OF USER WHOSE INDEX IS IN U IN USER MODE
;  (CALL ONLY WITH CLOCK OFF OR CLOCK BREAK IN PROGRESS)
;SKIPS IF SUCCESSFUL, FAILS IF USER RUNNING IN EXEC CODE OR HAS TO BE FINALIZED
;
PCLSR:  AOS NPCLSR
        CAIG U,L
         BUG                    ;PCLSR'ING NULL, SYS OR CORE JOB?
        MOVEI T,L
        IDIVM U,T
        IMULI T,L
        CAMN T,U                ;IS U REALLY A MULTIPLE OF LUBLK?
         SKIPN UNAME(U)         ;SHOULD NOT HAPPEN TO NONEXTANT JOB
          BUG
        SKIPE USTP(U)
         JRST POPJ1             ;USER STOPPED (MUST ALREADY BE IN USER MODE)
        AOS NEPCLS
        SKIPLE T,RPCL(U)
         JRST PCLSR2            ;LOSER IS RPCLSR'ING SOMEONE
PCLSR3: MOVE T,SUEXIT(U)
IFE KA10P,SUB T,U
        CAME T,[JRST 2,@XUUOH]
         JRST PCLSR5            ;EXIT ALREADY CLOBBERED
        MOVE T,UPC(U)           ;PICK UP PROGRAM COUNTER (FLAGS IN L.H.)
        TLNN T,%PCUSR           ;SKIP IF USER MODE ON
         JRST PCLSR8            ;JOB CURRENTLY IN EXEC MODE
        SOS NEPCLS              ;WAS WRONGLY AOS'ED
        CLEARM FLSINS(U)        ;IN CASE HE WAS WAITING FOR A PAGE OR CIRPSW
        MOVE T,USWST(U)
        TLNE T,%SWPGW
         SOS NPGWTU
        MOVSI T,%SWPGW+%SWRUN+%SWINT
        ANDCAM T,USWST(U)
        AOS (P)
        POPJ P,

PCLSR8: SKIPE FLSINS(U)         ;SKIP IF UNBLOCKED
         JRST PCLSR1            ;HUNG, TRY TO BACK UP TO UUO
PCLSR4: MOVE T,[JRST ONEFLS]
        MOVEM T,SUEXIT(U)       ;MUNG EXIT OF UUO, COME BACK LATER
PCLSRF: AOS NFPCLS
        POPJ P,

PCLSR2: SETZM RPCL(U)           ;CLEAR OUT POINTERS IN BOTH DIRECTIONS
        SETZM RPCL(T)
        JRST PCLSR3

PCLSR5: SKIPN FLSINS(U)
         JRST PCLSRF            ;NOT HUNG, LET RUN TO COMPLETION
IFN KA10P,[                     ;HUNG, UNCLOBBER EXIT AND BACK UP TO UUO
        CAME T,[JRST ONEPROC]   ;SKIP IF ONE PROCEEDING A SYS CALL
         JRST PCLSR6
        MOVSI T,%PC1PR
        IORM T,SUUOH(U)         ;RESET SINGLE INSTRUCTION PROCEED
PCLSR6:] ;KA10P
IFN KS10P,[                     ;HUNG, UNCLOBBER EXIT AND BACK UP TO UUO
        CAME T,[JRST ONEPR4]    ;SKIP IF ONE PROCEEDING A SYS CALL
         JRST PCLSR6
        MOVSI T,OIPBIT
        IORM T,XUUOH(U)         ;RESET SINGLE INSTRUCTION PROCEED
PCLSR6:] ;KS10P
        MOVE T,UPC(U)
        TLNE T,%PCUSR
         BUG
IFN KA10P,      MOVE T,[JRST 2,@UUOH]
IFE KA10P,[
        MOVSI T,(JRST 2,@)
        HRRI T,UUOH
] ;IFE KA10P
        MOVEM T,SUEXIT(U)       ;UNCLOBBER EXIT
PCLSR1: HLRZ T,LSPCL(U)         ;SAVE LAST TWO DISTINCT LOCS PCLSR'ED FROM
        CAIN T,@UPC(U)
         JRST PCLSR9
        HRL T,UPC(U)
        MOVEM T,LSPCL(U)
PCLSR9: SOS T,SUUOH(U)          ;GET USER LOCATION OF HIS CURRENT UUO
UFL5:
IFN KL10P,[
        TLC T,%PS1PR-%PSINH
        TLCN T,%PS1PR-%PSINH
         TLO T,%PSINH           ;ONE PROCEEDING AND INSTR NOT COMPLETE
] ;KL10P
        MOVEM T,UPC(U)          ;SET USERS PROGRAM COUNTER
IFE KA10P,[
        MOVSI T,701100          ;RESTORE PAGE-CONTEXT TO USER MODE
        HLLM T,CLCX(U)
] ;IFE KA10P
        CLEARM UMAPS(U)         ;RESTORE TO NORMAL MAP
        SETZM FLSINS(U)         ;CLEAR OUT ANY BLOCKING CONDITION
        MOVE T,USWST(U)
        TLNE T,%SWPGW
         SOS NPGWTU
        MOVSI T,%SWPGW+%SWRUN+%SWPCL+%SWINT     ;NOT BLOCKED ON PAGE, NOT UNBLOCKED SWAPOUT,
        ANDCAM T,USWST(U)       ; NOT INTERRUPT PAGE, NOT SWAPPED OUT WHILE BLOCKED
        SKIPE T,LSWPR(U)
         JRST LSWZAP            ;REQUIRED TO UNLOCK SWITCHES
PCLSR7:
IFE KA10P,[
        MOVEI T,UUOACS(U)       ;IF JOB U'S ACS ARE IN HARDWARE AC BLOCK 1,
        CAMN T,AC1PTR           ;COPY THEM INTO UUOACS WHERE THEY BELONG.
         XCTR XBR,[BLT T,UUOACS+17(U)]
] ;IFE KA10P
        MOVEI T,AC0S(U)
        HRLI T,UUOACS(U)
        BLT T,AC17S(U)
        JRST POPJ1              ;EXIT AFTER BACKING UP TO UUO
\f;
; AOS USTP OF USER IN A
;
NJRPCL: CAIE A,-1       ;ENTRY TO IGNORE IF NULL JOB
RPCLSR: CAMN A,USER     ;NORMAL ENTRY
        POPJ P,         ;TRYING TO RPCLSR SELF OR NULL JOB
        PCLT
        PUSH P,U        ;SAVE U
        MOVE U,A        ;GET INDEX OF RPCLSRED JOB IN U
        MOVE A,USER     ;GET RPCLSRING USER INDEX IN A
        CONO PI,CLKOFF  ;TURN OFF CLOCK BREAKS
        PUSHJ P,PCLSR   ;PUT USER IN USER MODE
        JRST RPCLOS     ;JUMP IF CAN'T DO IT RIGHT NOW
        AOS USTP(U)     ;WIN,STOP USER
        CONO PI,CLKON   ;RE-ENABLE CLOCK BREAKS
RPCLS1: MOVE A,U        ;RESTORE A
        POP P,U         ;RESTORE U
        POPJ P,
;
RPCLOS: SKIPE RPCL(U)   ;SKIP IF ZERO RPCL FOR USER BEING RPCLSRED
        JRST RPCLS2     ;SOMEONE GOT THERE FIRST
        SKIPE RPCL(A)   ;SKIP IF ZERO RPCL FOR RPCSRING USER
        JRST UDELAY     ;YOU ARE BEING RPCLSR'ED, SURRENDER
        HRROM A,RPCL(U) ;SET UP RPCL IN VARS OF RPCLSRED USER
        HRRM U,RPCL(A)  ;" OF RPCLSRING USER
        PCLT
        SKIPE RPCL(A)   ;WILL NOT SKIP AT FIRST
        PUSHJ P,UFLS    ;WAIT FOR PERSON BEING RPCLSRED TO GET TO ONEFL2
        JRST RPCLS1
;
RPCLS2: MOVE A,U        ;RESTORE A AND U
        POP P,U
        PCLT
        SKIPE RPCL(A)   ;WAIT FOR OTHER GUY TO WIN
        PUSHJ P,UFLS
        JRST RPCLSR     ;THEN TRY AGAIN

;
; UNDO AN RPCLSR
;
NJUPCL: CAIE A,-1       ;ENTRY TO IGNORE IF NULL JOB
UPCLSR: CAMN A,USER     ;REGULAR ENTRY
        POPJ P,         ;TRYING TO UPCLSR SELF OR NULL JOB
        SOSGE USTP(A)
         BUG
        POPJ P,

IFN KA10P,[
;
; RETURN FROM SYSTEM CALL IN ONE PROCEED MODE
;
ONEPROC:CONO PI,CLKOFF  ;TURN OFF CLOCK BREAKS
        MOVE U,USER     ;BE SURE U HAS RUNNING USER INDEX IN IT
        MOVEI T,%PI1PR
        IORM T,PIRQC(U) ;GIVE USER INTERRUPT
        JRST ONEPR2
]
\f
SUBTTL KS-10 ONE-PROCEED

IFN KS10P,[
ONEPRO: SYSCTX                  ;SWITCH TO SYSTEM AC BLOCK
        SKIPGE U,USER
         BUG AWFUL,[ONE-PROCEED IN NULL JOB]
        MOVE T,1PROPC(U)        ;PC OF NEXT INSTRUCTION TO EXECUTE
        TLNE T,%PSUSR           ;NORMALLY USER MODE IS EXPECTED
         JRST ONEPR3
        HRRZ T,T                ;SEE IF IT'S FIRST INSTRUCTION OF EXEC ENTRY
        CAIE T,UUOH0
         CAIN T,MUUOTR
          SKIPA TT,[JRST ONEPR4]
           BUG AWFUL,[ONE-PROCEED IN EXEC MODE],OCT,1PROPC(U)
        MOVEM TT,UEXIT          ;CLOBBER EXIT TO RUN SYS CALL TO COMPLETION
        CAIE T,UUOH0            ;AND RESUME PROCESSING UUO
         JRST [ USRCTX
                JRST MUUOTR ]
        USRCTX
        JRST UUOH0

ONEPR3: MOVEM T,UUOH            ;PUT USER PC WHERE ONEFLS WANTS IT
ONEPR4: SYSCTX                  ;COME HERE WHEN ONE-PROC'D UUO FINISHES
        MOVE U,USER             ;BE SURE U HAS RUNNING USER INDEX IN IT 
        MOVEI T,%PI1PR
        IORM T,PIRQC(U)         ;GIVE USER INTERRUPT
        JRST ONEFLS
];KS10P
\f
SUBTTL USER START ROUTINES
;
; CALLED EVERY SLOW CLOCK TICK WHEN TTY WANTING TOP PROCEDURE LOADED
;
USTART: PUSH P,U
USTRT1: SKIPL T,@UTTYO  ;GET TTY TO BE STARTED
         JRST [ MOVE U,MMPFR    ;WHEN STARTING A HACTRN, MAKE SURE CORE IS AVAILABLE
                CAIGE U,100
                 JRST USTRTL    ;IT'S NOT, SAY SYSTEM FULL
                JRST .+2 ]      ;T HAS INITIAL TTYTBL
         MOVSI T,%TBNOT+%TBDTY+%TBNVR   ;NOT A REAL TTY, INITIALIZE TTYTBL TO NO TTY
        PUSHJ P,USTRA   ;CREATE NEW USER SLOT ENTRY
         JRST USTSC1    ;LOSE, HAVE TO WAIT
        SKIPGE T,@UTTYO ;SKIP IF REALLY A TTY
         JRST USTRTS    ;DONT LOAD A HACTRN
        MOVE T,[SIXBIT /HACTRN/]        ;LOAD HACKTRN
USTRT2: MOVEM T,JNAME(U)        ;SET JOB NAME
        MOVEM T,XJNAME(U)
        HRLZI T,%PCUSR
        HRRI T,1
        MOVEM T,UPC(U)
        MOVEI T,AC0S(U)
        HRLI T,NUSTCD
        BLT T,AC17S(U)
        MOVE T,JNAME(U)
        MOVEM T,AC0S+11(U)
        SETZM @UTMPTR(U)        ;GIVE TEMPORARY HIGH PRIORITY
        SETZM USTP(U)   ;START UP
USTSC2: AOS T,UTTYO     ;AOS RING BUFF
        CAIL T,UTTYS+MXCZS
         MOVEI T,UTTYS
        MOVEM T,UTTYO
        SOSE UTTYCT
         JRST USTRT1    ;MORE JOBS TO SET UP
        JRST POPUJ

USTRTS: MOVEM U,1(T)    ;STORE USER'S INDEX IN SECOND WORD
        MOVE T,(T)      ;GET JNAME FROM FIRST WORD (POINTED TO BY RH OF @UTTYO)
IFN DEMON,[
        CAME T,[SIXBIT /LDRDEM/]
         CAMN T,[SIXBIT /UNSPOO/]
          AOS UTMPTR(U)         ;LOADER, UNSPOOLER -> SYSTEM TREE
]
        JRST USTRT2

USTSC1: MOVE U,USRHI    ;IF A USER IS ^Z'ING AND THERE IS NO POSSIBILITY
        SKIPL T,@UTTYO  ;OF GETTING MORE JOB SLOTS,
         CAIGE U,LUBLK*MAXJ
          JRST POPUJ
USTRTL: MOVSI U,%TANJS  ;THEN MARK THE TTY AS IN NEED OF A "SYSTEM FULL" MESSAGE
        IORM U,TTYSTA(T)
        MOVEI U,SCRCFM  ;AND WAKE UP THE SYS JOB.
        IORM U,SUPCOR
        JRST USTSC2     ;REMOVE THIS TTY FROM LIST OF THOSE NEEDING A ^Z.
\f
;GOBBLE NEW USER SLOT, RESET VARIABLES (SKIPS IF IT WINS)
;RETURNS INDEX IN U.  IF FAILS, CLOBBERS U!
USTRA:  MOVEI U,0
USTR3:  CAML U,USRHI
         JRST USTR1     ;ASSIGN MORE CORE TO USER STORAGE
        SKIPN UNAME(U)
         JRST USTR2     ;HAVE FOUND FREE USER SLOT (IN U)
        ADDI U,LUBLK
        JRST USTR3

USTR1:  SKIPGE SJCFF
         POPJ P,        ;SYSTEM JOB FLUSHING CORE, WAIT UNTIL IT STABILIZES
        MOVEI U,LUBLK   ;MOVE UP USRHI IF SYS HAS ENOUGH CORE
        ADD U,USRHI
        PUSH P,T
        MOVE T,HUSRAD   ;LENGTH OF SYS
        CAIGE T,USRSTG(U)
         JRST MORCOR    ;SYS NEEDS MORE CORE FOR USER VARIABLES
        POP P,T
USSINI: SETOM USTP-LUBLK(U)     ;SYS INITIALIZATION ENTRY
        EXCH U,USRHI
USTR2:  PUSHJ P,USTR4   ;RESET USER VARIABLES
        MOVEI T,SIOCHN-1(U)
        MOVEM T,SIOCP(U)
        CLEARM IOCHNM(U)
        HRLI T,IOCHNM(U)
        HRRI T,IOCHNM+1(U)
        BLT T,IOCHNM+17(U)      ;CLEAR ALL I/O CHANNELS
USRST4: HRLI T,AC0S(U)
        HRRI T,AC0S+1(U)
        SETZM AC0S(U)
        BLT T,AC17S(U)  ;CLEAR AC'S & RETURN HAPPY
        JRST POPJ1

MORCOR: SUB P,[1,,1]
        MOVSI T,SCLDEC
        ANDCAM T,SUPCOR ;CLEAR ANY SYS CORE DECREASE REQ
        MOVSI T,SCLEX
        JRST SUPSET     ;REQUEST MORE CORE FROM SYS JOB
\f;
; INITIALIZE A SET OF USER VARIABLES
;  T HAS INITIAL TTYTBL, POSITIVE IT IS TTY # ELSE NO TTY
USTR4:  MOVEM T,TTYTBL(U)
        JUMPL T,USTR4B
        PUSH P,U
        HRRM U,TTYSTS(T) ;TELL TTY IT NOW BELONGS TO NEW JOB,
        MOVSI U,%TSCNS  ;AND IS NOW A CONSOLE.
        IORM U,TTYSTS(T)
        MOVSI U,%TSFRE
        ANDCAM U,TTYSTS(T)      ;AND IS NO LONGER FREE
        MOVSI U,%TACFM+%TACTZ
        ANDCAM U,TTYSTA(T)      ;AND WILL NEED CONSOLE FREE MESSAGE
        POP P,U
        ADDI T,USRRCE
USTR4A: MOVEM T,UTMPTR(U)
        HRROI T,'000
        MOVEM T,UNAME(U)
        PUSH P,U
        MOVE T,U
        IDIVI T,LUBLK
        POP P,U
        DPB T,[000300,,UNAME(U)]
        LSH T,-3
        DPB T,[060300,,UNAME(U)]
        LSH T,-3
        DPB T,[140300,,UNAME(U)]
        MOVE T,UNAME(U)
        MOVEM T,XUNAME(U)
        MOVEM T,HSNAME(U)
        MOVE T,JNAME(U)
        MOVEM T,XJNAME(U)
        MOVEI T,(U)
        HRLI T,%TSCNS
        MOVEM T,TTSTSV+2(U)
        SETZM USWST(U)
IFN SWPWSP,[    
        SETZM UWRKST(U)
        SETZM USVWRK(U)
        MOVE T,TIME
        ADDI T,2*30.    ;PROTECT FROM SWAPOUT FOR 2 SECONDS (RANDOMLY)
        MOVEM T,USWTIM(U)
];SWPWSP
        SETZM NSWPGS(U)
        SETZM NMPGS(U)
        SETOM JBI(U)            ;NOT JOB DEVICE HANDLER (NOT YET, ANYWAY)
        SETZM OPTION(U)
        SETZM STTYOP(U)
        SETOM TRNLST(U)         ;INIT TRANSL LISTS TO NIL
        SETOM TRNLS1(U)
        SETZM HUSRAD(U)
        JUMPE U,.+5             ;SYSTEM JOB DOESN'T HAVE A MAP
                CLEARM UPGMP(U)
                MOVSI T,UPGMP(U)
                HRRI T,UPGMP+1(U)
                BLT T,UPGCP+NUVPG/2-1(U)
        MOVSI T,(MOVEM U,)
        HRRI T,AC17S(U)
        MOVEM T,SCLUSV(U)
IFE KA10P,[
        MOVSI T,(DATAI PAG,)
        HRRI T,CLCX(U)
        MOVEM T,SCLCXS(U)
        MOVEI T,USRSTG(U)
IFN KL10P, LSH T,-9
        HRLI T,701100
        MOVEM T,CLCX(U)
        MOVSI T,(JRST 2,@)
        HRRI T,XUUOH(U)
        MOVEM T,SUEXIT(U)
        MOVSI T,(CAI)           ;INITIALLY IGNORE TRAPS 1 AND 2
        MOVEM T,TR1INS(U)
        MOVEM T,TR2INS(U)
IFE KS10P,MOVEI T,%PI1PR        ;TRAP 3 IS IGNORED TOO ON KS
        MOVEM T,TR3INS(U)       ;TRAP 3 GIVES ONE-PROCEED INTERRUPT ON KL
] ;IFE KA10P
IFN KL10P,[
        SETZM ULSPBR(U)
        MOVSI T,MUUOKN          ;UUO NEW PC'S ARE SAME AS SYS JOB'S,
        HRRI T,MUUOKN(U)        ; EXCEPT THAT UUO IN EXEC MODE IS AN ERROR
        BLT T,MUUOPT(U)
        MOVEI T,MUUOEX
        HRRM T,MUUOKN(U)
] ;KL10P
IFN KS10P,[
        MOVE T,[%PSPCU,,MUUOEX]
        MOVEM T,MUUOKN(U)       ; UUO in Exec mode is an error
        MOVEM T,MUUOKT(U)       ; (either case)
        HRRI T,UUOH0
        MOVEM T,MUUOCN(U)       ; Normal UUO
        HRRI T,MUUOTR
        MOVEM T,MUUOCT(U)       ; UUO as trap instruction
        HRRI T,ONEPRO
        MOVEM T,1PRNPC(U)       ; One-proceed jumps to ONEPRO
] ;KS10P
IFN KA10P,[
        MOVE T,[JRST 2,@UUOH]
        MOVEM T,SUEXIT(U)
] ;KA10P
        MOVSI T,BUSRC
        MOVEM T,USTP(U)
        SETOM SUPPRO(U)
        SETZM UCLBLK(U)
        SETOM UCLBLK+1(U)
        MOVE T,[JRST UREALB]
        MOVEM T,UCLBLK+2(U)
        CLEARM UPGML(U)         ;CLEAR USER PG MAP VARIABS
        MOVEI T,UPGML+1(U)
        HRLI T,-1(T)
        BLT T,UPGMLE(U)
IFN KA10P,[
        MOVSI T,1+EXPGNG        ;DONT ENABLE QUAN COUNTER FOR NOW (BUT SET
                                ; EXEC PAGING)
        MOVEM T,UPQUAN(U)
        MOVE T,EXECMP
        MOVEM T,UPDBR3(U)       ;SET UP EXEC DBR
        MOVSI T,IFN MCOND DM,[1040] .ELSE [0] ;ON DM, B+C MEMORIES DON'T WORK
        MOVEM T,UPACP(U)        ;SET UP B+C MEMORY PTRS
] ;KA10P
IFN KS10P, SETZM UPQUAN(U)      ; Clear quantum counter.

;DROPS THROUGH
\f
;DROPS THROUGH, AND .RESET OF USR DEVICE COMES HERE.
USRST2: MOVE T,UNAME(U)
        MOVEM T,USYSNM(U)       ;CLOCK MUST BE OFF OR PI IN PROG ON 7
        MOVE T,TIME             ;DON'T SWAP JOB OUT RIGHT AWAY
        MOVEM T,LUBTM(U)
        PUSH P,A
        PUSH P,B
        PUSH P,C
        PUSH P,E
        MOVEI C,UCLBLK(U)
        SKIPL 1(C)
         JSP E,CLQCLR
        SETOM SERVER(U)
        SETZM PAGAHD(U)
        SETZM PAGRAN(U)
        SETZM UWHO1(U)
        SETZM UWHO2(U)
        SETZM UWHO3(U)
IFN N11TYS,[
        SETZM NVDBA(U)  ;0 VIDEO BUFFERS ASSIGNED BY JOB.
        SETOM TVCREG(U)
        SKIPL T,TTYTBL(U)
         PUSHJ P,USTTV0
          SETOM TVVBN(U)
USTTV1: ];N11TYS
        POP P,E
        POP P,C
        POP P,B
        POP P,A
        SETZM URTIME(U)
        SETZM UTIME(U)
        SETOM RTIMER(U)
        MOVSI T,%PCUSR
        MOVEM T,UPC(U)
        HRLI T,-LUPDL
        HRRI T,UPDL-1(U)
        MOVEM T,USRPDL(U)
        SETZM MSKST(U)
        SETZM MSKST2(U)
        MOVE T,[20,,40]
        MOVEM T,40ADDR(U)
        MOVEI T,APRCHN+440
        MOVEM T,APRC(U)
        SETZM USTYN(U)
        SETZM PIRQC(U)
        SETZM IFPIR(U)
        SETZM IDF1(U)
        SETZM IDF2(U)
        SETOM PICLR(U)
        SETZM FLSINS(U)
        SETZM UTRNTM(U)
IFN KL10P,[
        SETZM EBOXCT(U)
        SETZM EBOXCT+1(U)
        SETZM MBOXCT(U)
        SETZM MBOXCT+1(U)
]
        SETZM USIPRQ(U)
        SETZM TRUNTM(U)
        SETZM TSIPRQ(U)
IFE SWPWSP,[
        SETZM LTRNTM(U)
        SETZM LSIPRQ(U)
        SETZM UPGSEC(U)
];SWPWSP
        SETZM IOTLSR(U)
        MOVSI T,%OPOJB          ;USR RESET DOESN'T CLEAR OJB OPTION BIT
        ANDM T,OPTION(U)
        SETOM CORRQ(U)
        POPJ P,

USTR4B: MOVEI T,USRRCE+NCT
        JRST USTR4A

IFN N11TYS,[
;SET UP THE BLINKER FOR THE JOB IN U.
USTTV0: SKIPN TEN11F
         SKIPL TT11P
          POPJ P,
        HRL T,TTYTYP(T)
        TLNN T,%TY11T
         POPJ P,        ;NOT A TV
        MOVE A,TT11HD   ;11 HEADER ADR
        ADDI A,-NF11TY(T)
        LDB B,[141000,,1(A)]    ;VIDEO BUFFER #
        TRO B,17_8      ;CSET ALU FCTN
        LSH B,4+16.     ;INTO POSITION FOR MOVEMING INTO CONSOLE REG
        MOVEM B,TVVBN(U)
        JRST POPJ1
] ;END IFN N11TYS
\f
;       USER START CODE

NUSTCD: JFCL            ;0
        .OPEN 1,7
         .LOGOUT        ;2
        .CALL 12
         .LOGOUT
        .IOT 1,2
        JRST (2)
        .UII,,(SIXBIT/SYS/)     ;7
        SIXBIT /ATSIGN/
        SIXBIT /HACTRN/
        SETZ            ;12
        SIXBIT /LOAD/
        16
        SETZ 17
        -1              ;16
        1               ;17

USTCDR: SYSCTX          ;GOT HERE FROM ULEAVE WHICH SELECTED THE USER ACS,
        MOVE U,USER     ; SELECT SYSTEM ACS INSTEAD.
        MOVEI A,USTCDR+1        ;COME BACK HERE IN CASE OF PCLSR
        MOVEM A,UUOH
        MOVE P,USRPDL(U)
        PUSHJ P,UBLAM
        MOVE U,USER
        MOVSI T,NUSTCD
        XCTR XBW,[BLT T,17]
        MOVE T,JNAME(U)
        UMOVEM T,11
        MOVE T,[%PCUSR,,1]
        MOVEM T,UUOH
        JRST URET
\f
SUBTTL USER KILL ROUTINES

;
; CLOSE ALL DEVICES AND INFERIOR PROCEDURES OF A JOB (INDEX IN U)
;
IODCL:  MOVNI I,1       ;SET TO STOP
        PUSHJ P,IODCL3  ;STOP ALL INFERIOR JOBS (RECURSIVE)
        MOVEI I,0       ;THEN KILL.
IODCLA: PUSH P,I
        MOVE A,OPTION(U)
        TLNE A,%OPLOK   ;IF USER HAS ENABLED THE SWITCH-UNLOCK FEATURE,
         PUSHJ P,IODCSW ;UNLOCK HIS LOCKED SWITCHES.
IFN 340P\E.SP,  PUSHJ P,ADCLOSE ;FLUSH DISPLAY
IFN IMXP,       PUSHJ P,POTCLS  ;DISCONNECT HIS POTS
IFN VIDP,[
        CAMN U,SCNUSR
         PUSHJ P,SCNSTP ;KILL SCANNER IF HIS
]
IFN ARMP,       PUSHJ P,AARMOFF ;FLUSH ARM
IFN DEMON,      PUSHJ P,DEMOUT  ;FLUSH EXISTANCE (CURRENT OR FORMER) AS DAEMON.
IFN N11TYS,[
        SKIPE NVDBA(U)
         PUSHJ P,VBDFLS ;DEASSIGN ALL VIDEO BUFFERS.
]
IFN KL10P,[
        CAMN U,MTRUSR   ;DEASSIGN THE PERFORMANCE COUNTER
         PUSHJ P,PRFOFF
];KL10P
        PUSHJ P,CLQDEL  ;RELEASE AND STOP CLOCK QUEUE BLOCK
         UCLBLK(U)
        HRRZ A,UREALT
        CAMN A,U
         SETOM UREALT   ;UN REAL TIME
        CAMN U,UMASTER  ;UNMASTER
         SETOM UMASTER
        PUSHJ P,AIOPDL  ;POP UP ALL OF IO PDL (CLOSING CHNLS POPPED INTO)
        MOVEI R,IOCHNM(U)
IODCL1: PUSHJ P,CCLOSE  ;CLOSE ALL CHANNELS
        CAIGE R,IOCHNM+NIOCHN-1(U)
         AOJA R,IODCL1
        PUSH P,U
        SKIPGE T,JBI(U) ;IF THIS JOB IS A JOB-DEVICE,
         JRST IODCL2
        HRROS JBCJUI(T) ;TELL THE JOB CHANNEL THAT THE HANDLER IS GONE.
        CONO PI,CLKOFF
        SKIPGE JBCG(T)  ;IF OUR CREATOR STILL HAS A JOB CHANNEL,
         JRST IODCL6
        MOVE A,JBCUI(T) ;FLUSH THE CREATOR'S JOB CHANNELS,
        CONO PI,CLKON
        PUSHJ P,RPCLSR  ;STOPPING THE CREATOR IN CASE HE'S USING THEM NOW.
        MOVE T,JBI(U)   ;RPCLSR CLOBBERS T.
        MOVSI C,%CLSJ
        PUSHJ P,CHSCAA
            PUSHJ P,[HRRZ B,(R)
                     TDNN C,CLSTB(B)
                      POPJ P,
                     HLRZ B,(R)
                     CAMN B,T
                      SETZM (R)
                     POPJ P,]
        PUSHJ P,UPCLSR  ;ALLOW THE CREATOR TO CONTINUE AND GET IOC ERROR OR RETRY OPEN
IODCL6: CONO PI,CLKON
        SETOM JBCUI(T)  ;FLUSH THE JOB-DEVICE SLOT.
        SETOM JBI(U)    ;SAY THIS JOB NO LONGER A JOB-DEVICE.
        JRST IODCL2

IODCL3:  PUSH P,I       ;I=0 KILL I=-1 STOP I=1 JUST CLOSE CHANNELS.
        PUSH P,U
IODCL2: MOVEI A,0
IODCL4: HRRZ E,SUPPRO(A)
        SKIPE UNAME(A)  ;SKIP IF VARIABLES BLOCK IDLE
        CAIE E,(U)      ;SKIP ONLY IF IT IS A DIRECT INF.
        JRST IODCL5     ;TRY NEXT SET OF VARS
        PUSH P,A
        MOVE U,A
        PUSHJ P,1USTOP  ;STOP (WITH BUSRC BIT)
        MOVE R,P
        MOVE P,USRPDL(U)
        PUSH P,R
        SKIPGE I,-2(R)
        JRST IODCL8     ;STOP
        PUSHJ P,IODCLA  ;KILL OR CLOSE CHNLS, RECURSE
IODCL9: MOVE P,(P)
        SKIPE -2(P)     ;KILLING?
        JRST IODCL7     ;JUST CLOSING CHNLS.
        MOVE A,U        ;KILLING; WAIT TILL NO OTHER JOB
        PUSHJ P,AUCL3   ;IS LOOKING AT THE ONE THAT WE'RE KILLING.
        PUSHJ P,UBLST2  ;FLUSH CORE
        SETZ R,
        PUSHJ P,ZUSLOG  ;ACCOUNT FOR USAGE THEN FLUSH LAST VESTIGES
        CONO PI,CLKON
IODCL7: POP P,A
        HRRZ U,(P)
IODCL5: ADDI A,LUBLK
        CAMGE A,USRHI
        JRST IODCL4     ;LOOP FOR ALL SETS OF USER VARIABLES
        POP P,U
        SUB P,[1,,1]
        POPJ P,

IODCL8: PUSHJ P,IODCL3
        JRST IODCL9
\f
;SYSTEM CALL UNLOCK.  1 ARG, A JOB SPEC.
;THAT JOB'S LOCKS ARE ALL UNLOCKED.
NUNLOCK:
        MOVE J,A
        JSP T,NCORUI    ;DECODE THE JOB SPEC.
         JRST NUNLO1     ;WE'RE CERTAINLY ALLOWED TO WRITE THIS JOB.
        JUMPE U,NUNLO1  ;SYSTEM JOB CAN DO IT TO ANYBODY
        JSP T,NCORWR    ;NOT SURE, SO CHECK.
         JRST OPNL31     ;NO, NOT ALLOWED.
NUNLO1:
IFN PDP6P,[
        CAIN J,-1
         JRST OPNL34
];PDP6P
        ;THE CALL IS ALLOWED, SO UNLOCK THAT JOB'S LOCKS
        CAMN J,USER
         JRST NUNLO2
        MOVE A,J                ; If not self,
        PUSHJ P,RPCLSR          ; assure a User mode PC
        PUSHJ P,SOSSET
         USTP(A)
        JRST NUNLO3

NUNLO2: MOVE A,UUOH             ; If we are asked to unlock
        SUBI A,1                ; our own locks, put our PC in
        MOVEM A,SRN3(U)         ; SRN3 where IODCSW will look for it
NUNLO3: MOVE U,J
        MOVE A,OPTION(U)
        TLNE A,%OPLOK           ; Provided it is using locks at all...
         PUSHJ P,IODCSW
        CAME U,USER
         PUSHJ P,LSWPOP         ; USTP
        JRST LSWPJ1             ; DIELOK
        ; Returns with U clobbered, which seems to be OK for .CALL's?


;CALL HERE TO UNLOCK THE SWITCHES A JOB HAS LOCKED (USER IDX IN U).
;LOCATION 43 (ACTUALLY, 3+C(40ADDR)) HAS THE LIST POINTER. 0 IS NIL.
;ANYTHING ELSE POINTS TO 2-WORD BLOCK; THE 1ST WORD IS THE SWITCH OR THE
;ADDRESS OF THE SWITCH. THE RH OF THE SECOND IS THE CDR OF THE LIST.
;THE LH OF THE SECOND IS THE UNLOCK INTRUCTION. THE INDEX FIELD IS IGNORED,
;ONE LEVEL OF INDIRECTION IS PERMITTED, AND THE INSN MUST BE EITHER
;AOS OR SOS WITH 0 IN AC FLD, A LOGICAL INSTRUCTION (TOP 3 BITS = 4),
;A HALFWORD INSTRUCTION, OR A MOVE,MOVN,MOVS,MOVN,ADD OR SUB SERIES INSN,
;OR 0 WHICH MEANS SETOM. ONLY INSNS THAT MODIFY MEMORY ARE USEFUL.
;44 IS AN AOBJN POINTER TO THE CRITICAL RTNS TABLE, OF 2-WORDS ENTRIES.
;THE 1ST WORD EACH IS <BEGINNING OF RANGE>,,<END OF RANGE>+1.
;THE SECOND IS THE UNLOCK INSTRUCTION, WITH THE ADDRESS OF THE SWITCH
;IN THE RH (AGAIN, 1 LEVEL OF INDIRECTION IS PERMITTED).
;IF THE PC IS IN THAT RANGE, THE UNLOCK INSN IS EXECUTED.
;43 AND 44 ARE UPDATED DURING PROCESSING TO PREVENT PCLSR LOSSAGE.
;SEE .INFO.;ITS LOCKS


;MACRO TO DO XCTR, OR POPJ IF THAT WOULD CAUSE INTERRUPT.
DEFINE XCTRIJ
        JSP TT,IODCXC
        XCTR!TERMIN

; IODCSW: Unlock locks for user in U
; User should be stopped so that he is in user mode.
; The only exception is if we are unlocking the locks of the running job,
; in which case the contents of SRN3 will be used as our PC.
; Clobbers just about everything except U.
IODCSW: PUSH P,U
        PUSHJ P,IODCS0          ; Do actual work, if any...
        MOVE U,USER             ; But be sure to always
        PUSHJ P,MPLDZ           ; restore normal page map of running user.
        JRST POPUJ              ; And U

IODCS0: HRRZ J,U
        MOVE U,USER     ;SET UP MAP TO USER BEING HACKED (IDX IN J).
        PUSHJ P,MPLDJ   ;LH(J) CLOBBERED, RH SAVED.
        HRRZ U,J        ;U HAS WHAT IT HAD AT CALL (USR BEING HACKED).
        MOVEI C,1000    ;COUNT LENGTH OF LIST SO CIRCULAR LISTS DON'T HANG US UP.
        HRRZ E,40ADDR(U)
        XCTRIJ XRW,[MOVES B,3(E)] ;GET HIS "43" (AND MAKE SURE IT'S WRITABLE)
IODCS1: JUMPE B,IODCS2          ;REACHED END OF LOCKED SWITCH LIST, MAYBE?
        XCTRIJ XR,[HLL B,1(B)]  ;MERGE LOCK INSN WITH ADDR OF SWITCH.
        PUSHJ P,IODCDO          ;EXECUTE THE UNLOCK INSN
         POPJ P,                 ;IODCDO DETECTED MPV OR PUR INTERRUPT.
        XCTR XR,[HRRZ B,1(B)]   ;REPLACE LIST BY ITS CDR.
        UMOVEM B,3(E)
        SOJG C,IODCS1

IODCS2: XCTRIJ XRW,[MOVES E,4(E)]       ;GET JOB'S "44", AND MAKE SURE IT'S WRITEABLE.
        HRRZ C,UPC(U)           ;GET ITS PC, FOR COMPARISON.
        CAMN U,USER             ; Except if this is us,
         HRRZ C,SRN3(U)         ; then unlock PC is in SRN3
        JUMPGE E,CPOPJ          ;THERE ARE NO PROTECTED RANGES => DONE.
IODCS3: XCTRIJ XR,[MOVS B,(E)]  ;GET BOUNDS OF NEXT PROTECTED RANGE.
        CAIGE C,(B)             ;IS PC ABOVE LOWER BOUND?
         JRST IODCS4
        MOVSS B
        CAIL C,(B)              ;IS IT BELOW UPPER?
         JRST IODCS4
        XCTRIJ XR,[MOVE B,1(E)] ;PC IS IN THIS RANGE; GET UNLOCK INSN
        PUSHJ P,IODCDO          ;EXECUTE IT
         POPJ P,                ;NO SKIP => MPV OR PUR INTERRUPT DETECTED.
IODCS4: ADD E,[2,,2]            ;CHECK ALL ENTRIES IN CRITICAL RTN TABLE, 1 BY 1.
        HRRZ B,40ADDR(U)        ;UPDATE 44 SO ENTRIES ALREADY PROCESSED ARE
        UMOVEM E,4(B)           ;ACTUALLY IN THE TABLE. THIS IS IN CASE PCLSR.
        JUMPL E,IODCS3
        POPJ P,
\f
;PRECEDE AN XCTR WITH JSP TT,IODCXC TO POPJ IF THE XCTR WOULD
;CAUSE AN INTERRUPT (MPV OR PUR). CLOBBERS A,T,Q.
IODCXC: MOVEI A,@(TT)   ;GET EFFECTIVE ADDR OF XCTR.
        MOVEI A,@(A)    ;GET EFFECTIVE ADDR OF XCTR'ED INSN.
        LSH A,-10.      ;GET PAGE # BEING REFERENCED.
        PUSHJ P,UPLC    ;SET T = B.P. TO PAGE MAP HALFWORD. CLOBBERS Q.
        LDB T,T
        TRNE T,600000   ;IF PAGE IS SWAPPED IN, PUT ACCESS BITS IN
         LSH T,-20      ;SAME PLACE THEY ARE WHEN SWAPPED OUT (LOW 2 BITS).
;FOLLOWING CODE COMMENTED OUT BECAUSE IT DOESN'T WORK ON THE KL10 XCTR
;       TRNE T,2        ;CHANGE CODE 2 (READ-WRITE, NOT WRITTEN) TO 3 (READ-WRITE).
;        IORI T,1
;       LSH T,27        ;PUT ACCESS CODE IN AC FIELD, AND TEST
;       ANDCA T,(TT)    ;AGAINST WHAT THE XCTR WILL TRY TO DO.
;       TLNN T,(0 3,)   ;ALL DESIRED ACCESS AVAILABLE =>
;        JRST (TT)      ;WE WIN.
;       POPJ P,         ;ELSE QUIT OUT OF CALLING ROUTINE.
;
;FOLLOWING CODE INSERTED INSTEAD.  THIS RELIES ON THE FACT
;THAT ONLY THE FOLLOWING INSTRUCTIONS ARE XCTRIJ'ED:
; BOOLE,HWT,MOVXX,ADDX,SUBX,AOSX,SOSX
        MOVE A,@(TT)    ;GET INSTRUCTION XCTR'ED
        TLC A,300000
        TLCE A,300000   ;SKIP IF AOS OR SOS
         TLNE A,002000  ;SKIP IF DOESN'T WRITE IN MEMORY
          TRNE T,2      ;INSTRUCTION WRITES, SKIP IF RW OR RWF ACCESS NOT PRESENT
           TRNN T,3     ;INSTRUCTION READS, SKIP IF ANY ACCESS PRESENT
            POPJ P,     ;INSUFFICIENT ACCESS, QUIT OUT OF CALLING ROUTINE
        JRST (TT)       ;WINNING, GO DO THE XCTR

;PUSHJ P,IODCDO WITH INSN IN B TO XCTRIJ IT, CHECKING FOR LEGALITY
;AND PERFORMING ONE LEVEL OF INDIRECTION IF THE @ BIT IS SET.
;(WE CAN'T AFFORD AN INFINITE LOOP WHILE KILLING A JOB EVEN IF IT IS
;INTERRUPTABLE)
;INDEX FIELD IS IGNORED. IF THE OPCODE IS 0, SETOM IS USED INSTEAD.
;SKIPS IF INSN IS LEGAL AND DOESN'T CAUSE MPV OR PUR INTERRUPT.
;CLOBBERS A,D,J,T,TT,Q
IODCDO: MOVE J,B        ;B IS NOT CLOBBERED.
        TLZN J,(@)
         JRST IODCD1
        XCTRIJ XR,[HRR J,(J)]   ;INDIRECTION IS WANTED; DO IT.
IODCD1: TLNN J,-1       ;IF LH IS 0, REPLACE BY (SETOM)
         HRLI J,(SETOM)
        LDB A,[271500,,J]
        CAIE A,AOS_-27  ;AOS AND SOS ARE LEGAL WITH 0 IN AC FIELD.
         CAIN A,SOS_-27
          JRST IODCD2
        LDB A,[410300,,J]
        CAIE A,4        ;ALL INSNS WITH 4 IN TOP 3 BITS (LOGICAL INSNS) ARE OK.
         CAIN A,5       ;HALFWORD INSTRUCTIONS ALSO OK.
          JRST IODCD3
        LDB A,[360600,,J]
        CAIE A,MOVE_-36 ;ALL FORMS OF MOVE, MOVS, MOVN AND MOVM OK
         CAIN A,MOVN_-36
          JRST IODCD3
        CAIE A,ADD_-36  ;ADD & SUB OK.      (OF COURSE, ONLY TO-MEMORY INSNS MAKE SENSE)
         POPJ P,
IODCD3: LDB A,[270400,,J] ;AC FIELD NEED NOT BE 0, SO GET CONTENTS OF SPEC'D AC,
        UMOVE D,(A)
        MOVEI A,D
        DPB A,[270400,,J] ;AND MAKE THE INSN USE AC D, WHERE THE VALUE IS.
IODCD2: TLZ J,17
        XCTRIJ XRW,J    ;EXECUTE INSN, CHECKING FOR INTERRUPTS.
        AOS (P)
        POPJ P,
\f
; FLUSH LAST VESTIGES OF USER
;  ELIMINATES ALL POINTERS TO USER & FREES USER VARIABLES (CLOBBERS U TO "USER")
;  R, IF NON-ZERO, IS ADDRESS OF CHANNEL NOT TO BE CLOSED UNTIL LAST MINUTE
;       (IN CASE PCLSR OUT OF .UCLOSE)

ZUSER:  MOVEI A,(U)     ;CLEAR BOTH TRANSLATION LISTS
        HRLI A,300000   ;FOR THIS JOB.
        PUSHJ P,NTRNC
         JFCL
        MOVEI A,0       ;AND GET RID OF EXISTING FOREIGN-USER CHANNELS.
ZUSER2: SKIPE UNAME(A)
         PUSHJ P,ZUSES  ;SEE IF THIS USER HAS ANY POINTERS TO BE FLUSHED
        CAMN U,SERVER(A)        ; If we were a server for this guy,
         SETOM SERVER(A)        ; clear it out.
        ADDI A,LUBLK
        CAMGE A,USRHI
         JRST ZUSER2    ;LOOP FOR ALL SETS OF USER VARIABLES
        SKIPE R
         SETZM (R)
        CONO PI,CLKOFF
        SKIPE NMPGS(U)  ;USER SHOULD HAVE NO MEMORY BY NOW
         BUG
        SETZM UNAME(U)  ;ONLY PLACE THAT UNAME IS ZEROED
        SETOM USTP(U)   ;SET USTP TO SPEED SEARCH
        MOVE A,U        ;USER FLUSHED
        MOVE U,USER
        MOVSI T,SCLDEC
        IORM T,SUPCOR   ;CAUSE USER VARIABLE BLOCKS DECREASE PROGRAM TO RUN
        POPJ P,         ;RETURN WITH CLOCK OFF


;CALLED BY ADISOWN, NATTACH, NDETACH, ETC.
ZUSES:  MOVEI D,%CLSU\%CLSFU\%CLSJI\%CLSJO      ;CLSTB BITS FOR CHANNELS TO CLOSE
ZUSES1: PUSH P,B
        PUSH P,R
        PUSH P,C
        MOVE C,R
        SETZM B         ;CLEAR STOPPED PROC FLAG
        PUSHJ P,CHSCAA  ;EXECUTE FOLLOWING INST FOR EACH CHANNEL AND I/O PDL SLOT
            PUSHJ P,ZACHEK
        POP P,C
        POP P,R
        SKIPE B         ;SKIP UNLESSS YOU STOPPED THE PROC
         PUSHJ P,UPCLSR ;RESTART USER
        JRST POPBJ

ZACHEK: HLRZ T,(R)      ;CHECK FOR CHANNEL TO ZAP
        CAME T,U
         POPJ P,
ZACHK4: HRRZ T,(R)
        HLRZ T,CLSTB(T)
        TRNN T,(D)
         POPJ P,        ;IS IT EITHER TYPE OF USER CHANNEL? OR JOB CHNL?
        TRON B,-1       ;SET FLAG
         PUSHJ P,RPCLSR ;STOP USER
        HRRZ T,(R)
        HLRZ T,CLSTB(T)
        TRNN T,%CLSFU   ;IS IT A FOREIGN USR CHNL?
         JRST ZACHK2    ;NO, SUPERIOR OR JOB CHNL.
        JUMPG R,ZACHK1  ;IOPDL CHANNEL
        MOVEI T,LUBLK   ;SEE IF A HAS BEEN CLOBBERED
        IDIVM A,T       ;(AT LEAST MAKE SURE IT'S A VALID USER INDEX)
        IMULI T,LUBLK
        CAMN T,A
         CAML A,USRHI
          BUG
        HRRZ T,R        ;NORMAL CHANNEL, INTERRUPT ON IT.
        SUBI T,IOCHNM(A)
        MOVE T,CHNBIT(T)
        AND T,MSKST2(A)
        IORM T,IFPIR(A)
ZACHK2: CAIE C,(R)      ;UNLESS THE ONE NOT TO BE CLOSED UNTIL LAST MINUTE,
         SETZM (R)      ;FOR ANY KIND OF CHANNEL, CLEAR IT OUT.
        POPJ P,

ZACHK1: MOVEI T,IIOPOP  ;FOREIGN USR IN IOPDL SLOT: INTERRUPT WHEN IOPOPPED.
        MOVEM T,(R)
        POPJ P,
\f
ZUSLOG: PUSH P,[ZUSER]          ;DO LOGUSE THEN ZUSER

;LOG RUNTIME AND SWAPIN REQUESTS USED BY JOB IN U
;JOB CALLED FOR SHOULD NOT BE CURRENT OR ABLE TO RUN DURING CALL
;JOB SHOULD NOT BE TOP LEVEL EXCEPT WHEN DMNPLO CALLS
; HERE JUST BEFORE SENDING THE USAGE TO THE DEMON
;CLOBBERS T,TT,I

LOGUSE: MOVN TT,UTRNTM(U)
        MOVN T,USIPRQ(U)
        EXCH TT,TRUNTM(U)       ;AVOID CHARGING FOR THIS USAGE TWICE
        EXCH T,TSIPRQ(U)
        SUB TT,TRUNTM(U)        ;COMPUTE TOTAL USAGE NOT YET CHARGED
        SUB T,TSIPRQ(U)
        SKIPGE I,SUPPRO(U)      ;FIND HIGHEST JOB IN TREE
         POPJ P,                ;BUT IF TOP LEVEL RETURN WITH USAGE IN TT, T
;THIS IS TO FIND A BUG.  -- CStacy, 4/30/82
        CAME I,U                ;IS THIS JOB ITS OWN SUPERIOR?
         JRST LOGUS1
        BUG PAUSE,[SOME JOB IS ITS OWN SUPERIOR, U AND I=],OCT,U
LOGUS1: SKIPL SUPPRO(I)
         JRST [ MOVE I,SUPPRO(I) ? JRST .-1 ]
        ADDM TT,TRUNTM(I)       ;ADD CHARGES TO TREE'S ACCOUNT
        ADDM T,TSIPRQ(I)
        POPJ P,

;DO LOGOUT FOR TREE HEADED BY JOB IN U
;CALLER SHOULD THEN PUSHJ P,DMNPLI TO LOG JOB BACK IN
;THIS IS USED TO KEEP ACCOUNTING STRAIGHT WHEN DETACH, CHUNAME, RELOAD (SIGH)
;IF JOB IS CURRENTLY RUNNING, TIME USED IN CURRENT QUANTUM
;WON'T GET CHARGED THIS TIME AROUND.  TOO BAD.
;CLOBBERS T,TT,I,J,D. CALL WITH CLKOFF OR IN PROGRESS.

LOGUPD: PUSH P,U
        MOVE J,UTMPTR(U)
        MOVEI U,LUBLK
LOGUP1: ADDI U,LUBLK
        CAML U,USRHI
         JRST LOGUP2
        CAMN J,UTMPTR(U)        ;SKIP JOBS IN OTHER TREES (FOR SPEED)
         SKIPGE SUPPRO(U)       ;AND SKIP TOP LEVEL JOBS
          JRST LOGUP1
        SKIPE UNAME(U)          ;DON'T GET CONFUSED BY EMPTY SLOTS
         PUSHJ P,LOGUSE         ;PROBABLY AN INFERIOR IN TREE LOGGING OUT, UPDATE ACCT
        JRST LOGUP1

LOGUP2: POP P,U
        JRST DMNPLO             ;TELL DEMON ABOUT TREE'S USAGE
\f
SUBTTL USER UUO WAIT (HANG UP) ROUTINE
;  DOES NOT WORK FOR XCT T OR FOR X (T)
;  THE INSTRUCTION BEFORE THE PUSHJ P,UFLS GETS EXECUTED WITH AN
;  ARGUMENT PASSED IN T AND ITS USER INDEX IN U.  I BELIEVE IT
;  IS ONLY ALLOWED TO BASH T AND A.
;
UFLS:   CONSZ PI,77400
         BUG HALT,[UFLS WITH PI IN PROGRESS]
        CONO PI,CLKOFF  ;DOES NOT ALLOW CLOCK INTS
        XCT CLUSAV
        SKIPGE U,USER   ;GET INDEX OF USER BEING BLOCKED
         JRST 4,.       ;NULL JOB SHOULD NOT GET BLOCKED
        MOVEM T,EPDL2(U)        ;SAVE C(T) FOR FLSINS AT PCLSR
        MOVEM T,AC16S(U)        ;SAVE IN SWAP OUT AC ALSO
        POP P,UPC(U)            ;WORK FOR INST INDEX OF P
        MOVEI T,AC0S(U)
        BLT T,AC15S(U)  ;STORE REST OF ACS
        MOVE T,UPC(U)   ;GET PC AT CALL (=CALL+1 ; =SKIP +2)
        SKIPA T,-2(T)   ;GET POINTER TO SKIP
UFL3:    MOVE T,(T)     ;GET CONTENTS OF E (WAS AN XCT)
        MOVE U,AC17S(U) ;WIN FOR INSNS INDEX OF U.
        HRRI T,@T       ;CALCULATE E
        TLZ T,37        ;CLEAR OUT @ AND INDEX BITS
        MOVE U,USER
        MOVEM T,FLSINS(U)       ;STORE AS BLOCKING CONDITION
        TLC T,(XCT)
        TLNN T,777740
         JRST UFL3      ;JUMP IF INSTRUCTION WAS XCT
        CONO PI,UTCON-1 ;TURN ON ALL PIS EXCEPT CLOCK
        MOVSI T,%SWPGW+%SWINT
        ANDCAM T,USWST(U) ;CLEAR WAITING FOR PAGE TYPE FLSINS
        SKIPGE RPCL(U)  ;SKIP IF NOT BEING RPCLSRED
         JRST UFL1      ;LOSER IS BEING RPCLSRED
UFL6:   MOVE U,AC17S(U) ;FOR CLUSAV TO STORE
        SETOM UFLSF
        CONO PI,CLKRQ   ;CAUSE INTERRUPT TRANSFERING TO CLOCK ROUTINE PI IN
                        ; PROGRESS
IFE KA10P, JRST .       ;ON KL AND KS SEEMS TO TAKE A WHILE TO GO OFF ("I
                        ; CAN WAIT FOREVER, YOU KNOW")
IFN KA10P, JRST 4,.     ;ON KA SHOULD GO OFF RIGHT AWAY

UFL1:   MOVE P,CPDLP    ;MUST NOT USE USR PDL SINCE THAT CAN
                        ;GET CLOBBERED BY LSWDIS VIA UFL5
                        ;CLOCK IS OFF, SO CPDLP IS OK
IFN KA10P,[
        MOVE T,UEXIT    ;PICK UP EXIT INSTR
        CAME T,[JRST ONEPROC]   ;SKIP IF WAS TRYING TO ONE PROCEED THE UUO
                                ; THAT HUNG
         JRST UFL1A     ;NOT ONE PROCEEDING
        MOVSI T,%PC1PR  ;GET ONE PROCEED BIT
        IORM T,UUOH     ;TURN IT ON IN PC
UFL1A:] ;KA10P
IFN KS10P,[
        MOVE T,UEXIT    ;PICK UP EXIT INSTR
        CAME T,[JRST ONEPR4]    ;SKIP IF WAS TRYING TO ONE PROCEED THE UUO
                                ; THAT HUNG
         JRST UFL1A     ;NOT ONE PROCEEDING
        MOVSI T,OIPBIT  ;GET ONE PROCEED BIT
        IORM T,UUOH     ;TURN IT ON IN PC
UFL1A:] ;KS10P
        SOS T,UUOH      ;UUOH HAS REAL PC IF UFL5 SKIPS. WILL GET SET BY ONEPR1
        PUSHJ P,UFL5    ;BACK UP TO UUO
         JRST UFL6      ;FINALIZATION REQUIRED
        MOVE T,RPCL(U)
        JRST ONEFL2     ;WIN
\f
SUBTTL VARIOUS WAIT & LOCK-SWITCH ROUTINES
;
;WAIT FOR INSTRUCTION AFTER CALL TO SKIP WITH UTCCHN OFF
;
LWAIT1: CONO PI,UTCON   ;TURN INTERRUPTS ON
LWAIT:  PCLT
        XCT @(P)        ;ENTRY, EXECUTE INSTRUCTION
         PUSHJ P,UFLS   ;HANG TILL INSTRUCTION SKIPS
        CONO PI,UTCOFF  ;TURN INTERRUPTS OFF
        XCT @(P)        ;TRY AGAIN
         JRST LWAIT1    ;LOSE
        JRST POPJ1      ;WIN, RETURN SKIPPING OVER ARG
;
;WAIT FOR LOCK VAR (@ NEXT LOC) TO BE -1 AND SEIZE IT
;
SWTL:   PCLT
        MOVEI T,(@)     ;ENTRY
        HRLM T,(P)      ;MAKE PC STORED ON PDL INDIRECT
        SKIPGE @(P)     ;SKIP IF ALREADY LOCKED
         JRST SWTL1     ;NOT LOCKED SO TRY TO GRAB IT
        MOVEI T,@(P)    ;ADDRESS OF SWITCH
        HLRZ T,1(T)     ;USER THAT HAS SWITCH
        ANDI T,777
        IMULI T,LUBLK
        CAMN T,USER     ;SKIP IF THIS USER DOESN'T HAVE IT
         BUG            ;THIS USER ALREADY HAS THAT SWITCH
SWTL1:  SKIPL @(P)      ;(DO NOT CHANGE TO AOSE)
         PUSHJ P,UFLS   ;HANG TILL NEGATIVE
        CONO PI,CLKOFF
        AOSE @(P)
         JRST SWTL1
SWTL2:  MOVEI T,@(P)
SWTL3:  PUSH P,U
        PUSH P,T
        MOVE T,USER
        IDIVI T,LUBLK
        ADDI T,600000
        MOVE U,USER
        HRL T,LSWPR(U)
        POP P,U
        MOVSM T,1(U)
        MOVE T,USER
        HRRZM U,LSWPR(T)
        POP P,U
        JRST CLKOJ1
;
;IF LOCK ALREADY SEIZED, JUST SET UP POINTERS
SWTLZ:  MOVEI T,(@)
        HRLM T,(P)
        JRST SWTL2

SWTAD:  PCLT            ;TRY TO LOCK SWITCH (@NEXT LOCN). IF SUCEED, SKIP EXTRA TIME.
        MOVE T,@(P)     ;IF FAIL, DO N LSWPOPS (AS SPEC IN 4.6-4.1 OF NEXT WORD)
        SKIPGE (T)      ;AND WAIT FOR SWITCH TO SEEM TO BE AVAILABLE.
         JRST SWTAD1    ;THEN RETURN (NOTE: NOT LOCKING IT).
SWTAD2: TLNN T,77000
         JRST SWTAD3
        PUSH P,T
        PUSHJ P,LSWPOP
        POP P,T
        SUB T,[1000,,]
        JRST SWTAD2

SWTAD3: SKIPL (T)
         PUSHJ P,UFLS
        JRST POPJ1

SWTAD1: CONO PI,CLKOFF
        AOSE (T)
         JRST [ CONO PI,CLKON
                JRST SWTAD2 ]
        AOS (P) ;SKIP OVER FAILURE RETURN
        JRST SWTL3
\f
;
;WAIT FOR INSTRUCTION AFTER CALL TO SKIP WITH CLKCHN OFF
CWAIT1: CONO PI,CLKON   ;TURN CLOCK ON
CWAIT:  PCLT
        XCT @(P)        ;ENTRY, EXECUTE INSTRUCTION
         PUSHJ P,UFLS   ;HANG TILL INSTRUCTION SKIPS
        CONO PI,CLKOFF  ;TURN CLOCK OFF
        XCT @(P)        ;TRY AGAIN
         JRST CWAIT1    ;LOSE
        JRST POPJ1      ;WIN, RETURN SKIPPING OVER ARG

;
;WAIT FOR LOCK VAR (@ NEXT LOC) TO BE NON-NEGATIVE AND SEIZE IT
LSWTL:  PCLT
        MOVEI T,(@)     ;IF 4.9 OF NEXT LOCN =1, RETURN WITH UTCOFF
        HRLM T,(P)
        MOVSI T,400000
        PUSHJ P,LWAIT
            SKIPGE @-1(P)
        IORM T,@(P)
        MOVE T,(P)
        SKIPL (T)
         CONO PI,UTCON
        MOVEI T,@(P)
LSWTL2: PUSH P,TT
        MOVEI TT,601000
        PUSHJ P,LSWSET
        POP P,TT
        JRST POPJ1
\f
;SWITCH LIST LOCK, DOES NOT WORK FOR SWITCHES POINTED TO INDEX OF A, B, OR D
;FOLLOW BY LIST OF SWITCHES
;4.9-4.4=0 4.3-4.1 0 AOSE SWITCH 1 SIGN SWITCH
SLUGH:  PCLT
        PUSH P,A
        PUSH P,B
        PUSH P,D
        MOVEI T,AC0S(U)
        BLT T,AC0S+17(U)        ;FOR SLWAIT FIRST TIME
SLUGH1: HRRZ T,-3(P)    ;POINTER TO SWITCH LIST
        PUSHJ P,SLWAIT
         PUSHJ P,UFLS
        HRRZ T,-3(P)
SLUGH2: MOVE A,(T)      ;TRY TO LOCK LIST
        TLNE A,770000
         JRST SLUWIN    ;REACHED END OF LIST
        LDB B,[220400,,A]       ;INDEX
        LDB D,[330300,,A]
        SKIPE B
         ADD A,(B)
        HRRZS A
        CAIL D,2
         BUG
        XCT SLLOCK(D)
         JRST SLULOS
        AOBJP T,SLUGH2  ;LH COUNTS SWITCHES SUCCESSFULLY SEIZED
                        ;SHOULD NVERE FALL THROUGH
SLWAIT: MOVE A,(T)
        TLNE A,770000
         JRST POPJ1             ;WIN
        LDB B,[220400,,A]       ;INDEX
        LDB D,[330300,,A]       ;TYPE CODE
        JUMPE B,SLWT1
        ADD B,U
        ADD A,AC0S(B)
SLWT1:  CAIL D,2
         BUG
        XCT SLWATT(D)
         POPJ P,        ;LOSE
        AOJA T,SLWAIT   ;THAT SWITCH OK, TRY OTHERS

SLWATT: SKIPL (A)       ;WAIT FOR NEG (AOSE SW)
        SKIPGE (A)      ;WAIT FOR POS (SIGN SW)

SLUWIN: POP P,D
        POP P,B
        POP P,A
        SUB P,[1,,1]    ;"RETURN" BUT NOT INCREMENTED
        JRST (T)

SLLOCK: PUSHJ P,SWTLX
        PUSHJ P,LSWTLX

SLULOS: HLRZ A,T
SLULO2: JUMPE A,SLUGH1  ;NONE SEIZED TRY AGAIN
        PUSHJ P,LSWPOP  ;RELEASE THOSE SEIZED
        SOJA A,SLULO2

SWTLX:  CONO PI,CLKOFF  ;DON'T GO OFF HALF-LOCKED
        AOSE (A)
         JRST CLKONJ
        EXCH A,T
        PUSHJ P,SWTL3
         BUG
SWTLX1: EXCH A,T
        JRST POPJ1

LSWTLX: CONO PI,UTCOFF
        SKIPGE (A)
         JRST UTCONJ
        MOVSI B,400000
        IORM B,(A)
        CONO PI,UTCON
        EXCH A,T
        PUSH P,TT
        MOVEI TT,601000
        PUSHJ P,LSWSET
        POP P,TT
        JRST SWTLX1
\f
;SET UP ROUTINE TO SETOM VARIABLE UPON UNLOCKING SWITCH
STMSET: PUSH P,TT
        MOVEI TT,606000
        JRST COMSET

IFN 0,[
;SET UP ROUTINE TO BE CALLED ON PCLSR'ING OUT
FINSET: MOVE T,@(P)
        HRLI T,-1(P)
        PUSH P,TT
        MOVEI TT,402000
        PUSHJ P,LSWSET
        POP P,TT
        JRST POPJ1
]

;SET UP ROUTINE TO AOS VARIABLE UPON UNLOCKING SWITCH
AOSSET: PUSH P,TT
        MOVEI TT,605000
        JRST COMSET

;SET UP ROUTINE TO SOS VARIABLE UPON UNLOCKING SWITCH
SOSSET: PUSH P,TT
        MOVEI TT,603000
        JRST COMSET

;SET UP ROUTINE TO SOS LH UPON UNLOCKING SWITCH
;HALT IF SWITCH'S LH EVER BECOMES NEGATIVE
SOLSET: PUSH P,TT
        MOVEI TT,607000
        JRST COMSET

;SET UP ROUTINE TO BE CALLED UPON UNLOCKING SWITCH
;THAT ROUTINE MAY ONLY CLOBBER A AND T!!  IT GETS CALLED
;WITH USER IN U, AND THE JOB'S ACS IN AC0S(U)-AC17S(U)
LOSSET: MOVE T,@(P)
        HRLI T,-1(P)
        PUSH P,TT
        MOVEI TT,602000
        PUSHJ P,LSWSET
        POP P,TT
        JRST POPJ1

;SET UP ROUTINE TO CLEAR SIGN BIT OF VARIABLE UPON UNLOCKING SWITCH
SGNSET: PUSH P,TT
        MOVEI TT,601000
        JRST COMSET

;SET UP ROUTINE TO DO NOTHING UPON UNLOCKING SWITCH
NULSET: PUSH P,TT
        MOVEI TT,0
        PUSHJ P,LSWSET
        POP P,TT
        POPJ P,
\f
;ROUTINE TO ADD THIS PROCEDURE TO A LIST POINTED TO
;BY THE WORD AFTER THE CALL.  UNLOCKING REMOVES IT FROM THE LIST
LSTSET: PUSH P,TT       ;LEAVES CLKON
        MOVEI TT,604000
        PUSHJ P,LSTST3
        POP P,TT
        JRST POPJ1

LSTST3: PUSH P,U
        PUSH P,Q
        MOVEI Q,LSWB0(U)
REPEAT NULBLK,[
IFN .RPCNT,ADDI Q,2
        SKIPN 1(Q)
        JRST LSTST2
]
        BUG             ;NOT ENOUGH BLOCKS
LSTST2: MOVE T,@-4(P)   ;ADDRESS OF HEAD OF LIST
        CONO PI,CLKOFF
        PUSH P,(T)      ;PUSH HEAD OF LIST
        POP P,(Q)       ;POP INTO LSWB BLOCK
        MOVEM Q,(T)
        HRLM T,(Q)
        MOVE T,(Q)
        TRNE T,-1
        HRLM Q,(T)
        CONO PI,CLKON
        JRST LSWSE3

IFN 0,[
;SET UP ROUTINE TO SETOM VARIABLE UPON UNLOCKING OF SWITCH
;BY OTHER THAN PCLSRING OUT
STMNPS: PUSH P,TT
        MOVEI TT,206000
        JRST COMSET

;SET UP ROUTINE TO BE CALLED UPON UNLOCKING OF SWITCH
;BY OTHER THAN PCLSRING OUT
LNPSET: PUSH P,TT
        MOVEI TT,202000
        JRST COMSET
];END IFN 0

COMSET: EXCH TT,(P)
        MOVE T,@-1(P)
        MOVEI T,@T
        EXCH TT,(P)
        PUSHJ P,LSWSET
        POP P,TT
        JRST POPJ1
\f
;SET USER LOCK SWITCH BLOCK,  WD1 IN T,  MODE IN TT
LSWSET: PUSH P,U
        MOVE U,USER
        PUSH P,Q
        MOVEI Q,LSWB0(U)
REPEAT NULBLK,[IFN .RPCNT,ADDI Q,2
        SKIPN 1(Q)
        JRST LSWSE2
]
        BUG             ;NOT ENOUGH BLOCKS

LSWSE2: MOVEM T,(Q)
LSWSE3: MOVE T,U
        IDIVI T,LUBLK
        MOVE U,USER
        HRL T,LSWPR(U)
        IOR T,TT        ;GET TYPE
        MOVSM T,1(Q)
        HRRZM Q,LSWPR(U)
        JRST POPQUJ

LSWCJ1: AOS (P)         ;EXIT TO DO LSWCLR AND SKIP-RETURN.

;UNLOCK ALL SWITCHES, CALLED BY OPENL, ADISOWN, IOADCR
LSWCLR: PUSH P,T
LSWCL1:
;TEMPORARY CODE ADDED 1/22/80 TO SEE IF THERE ARE ANY MORE OF
;THIS CLASS OF BUGS
        CAME U,USER
         BUG
;END TEMPORARY CODE
        SKIPN T,LSWPR(U)        ;MUST HAVE USER IN U
        JRST POPTJ
        PUSHJ P,LSWPOP
        JRST LSWCL1

LSWPJ1: AOS (P)
LSWPOP: PUSH P,U
        MOVE U,USER
        TLO U,400000    ;SIGNAL NOT PCLSR
        SKIPN T,LSWPR(U)
         BUG
        PUSHJ P,LSWPPP
        JRST POPUJ

LSWPPP: PUSH P,A
        PUSH P,T
        MOVE A,1(T)
        HRRZM A,LSWPR(U)
        CAIL T,USRSTG
         SETZM 1(T)
        PUSHJ P,LSWDIS
        POP P,T
        POP P,A
        POPJ P,

LSWZAP: PUSH P,U        ;FROM PCLSR
        PUSH P,A
LSWZP1: PUSH P,T
        MOVE A,1(T)
        HRRZM A,LSWPR(U)
        CAIL T,USRSTG
         SETZM 1(T)
        PUSHJ P,LSWDIS
        POP P,T
        HRR U,-1(P)
        SKIPE T,LSWPR(U)
         JRST LSWZP1
        POP P,A
        SUB P,[1,,1]
        TLZN U,200000   ;HAS PC BEEN CLOBBERED?         ;THIS IS ONLY FOR FINSET R.I.P.
         JRST PCLSR7    ;NO
        SKIPLE PCLDBM
         SETZM LSUUO(U) ;INDICATE OCCURRENCE OF FINSET (WILL MEAN WE HAVEN'T MISSED MARK)
        JRST PCLSR4     ;REQUIRED TO START UP ROUTINE
\f
;-1(P) HAS POINTER TO SWITCH BLOCK TO UNDO.
;A HAS SECOND WORD OF THAT BLOCK.
; 4.9=1 => PERFORM FUNCTION ON PCLSR
; 4.8=1 => PERFORM FUNCTION ON ANY LSWPOP OTHER THAN PCLSR
; 4.1-4.3 => FUNCTION
; 3.1-3.9 USER # LAST LOCKED BY
; 1.1-2.9 LSWPR THREAD

LSWDIS: LDB T,[330300,,A]       ;FUNCTION
        TLNE A,400000   ;SKIP IF NOT FOR PCLSR
         JUMPGE U,LSWDS1        ;PCLSRED AND 4.9=1
        TLNN A,200000   ;NOT FOR PCLSR OR FOR PCLSR BUT NOT PCLSRED
         POPJ P,        ;NOT FOR EITHER LSWPOP
        JUMPGE U,CPOPJ  ;FOR OTHER LSWPOP BUT PCLSRED
LSWDS1: JRST LSWTAB(T)

LSWTAB: JRST UNSWTL     ;0 (AOSE) ALSO USED FOR QUSR
        JRST UNLSWT     ;1 (SIGN)
        JRST ULROUT     ;2 (GO TO ROUTINE)
        JRST ULAOS      ;3 (AOS, SOS)
        JRST UNLST      ;4 (UNLOCK FROM LIST)
        JRST ULSOS      ;5 (SOS, AOS)
        JRST ULSTM      ;6  (SETOM)
        JRST ULAOSL     ;7 (AOS,SOS LEFT HALF)

UNSWTL: MOVE T,-1(P)
        SETOM (T)
        POPJ P,

ULSTM:  MOVE T,@-1(P)
        SETOM (T)
        POPJ P,

UNLSWT: MOVE T,@-1(P)
        MOVSI A,400000
        ANDCAM A,(T)
        POPJ P,

ULAOSL: MOVE T,@-1(P)
        MOVSI A,-1
        ADDB A,(T)
        JUMPGE A,CPOPJ
        BUG                     ;OVER-SOS'ED

ULAOS:  MOVE T,@-1(P)
        SOS (T)
        POPJ P,

UNLST:  SETOM DLSRCH
        MOVS T,@-1(P)
        HLRM T,(T)
        MOVSS T
        TRNE T,-1
        HLLM T,(T)
        SETZM DLSRCH
        POPJ P,

ULSOS:  MOVE T,@-1(P)
        AOS (T)
        POPJ P,

ULROUT: MOVE T,@-1(P)
        TLNE A,200000
         JRST ULROU1    ;A LOSSET - MAY CLOBBER A OR T; USR INDEX IN U
        HRRZM T,UPC(U)  ;IT'S A FINSET, EXPECTS THE OLD METHOD OF CALL.
        TLNE T,-1
         HLRM T,AC15S(U)
IFE KA10P,[
        MOVSI T,%PSPCU  ;IT MIGHT TRY AN XCTR
        HLLM T,UPC(U)
] ;IFE KA10P
        TLOE U,200000   ;SIGNAL PC CLOBBERED
         BUG            ;PC TRIED TO BE CLOBBERED TWICE
        POPJ P,

ULROU1: JUMPGE U,(T)    ;IF LOSSET, AND LSWPOPPING,
        MOVE A,[B,,AC0S+B]
        ADDI A,(U)      ;PUT THE ACS IN THE AC0S, SINCE
        BLT A,AC0S+H(U) ;THAT'S WHERE THEY'LL BE IF CALL LOSSET ROUTINE WHILE PCLSRING.
        JRST (T)
\f
;FIND SWITCH POINTED TO BY WORD AFTER
;PUSHJ P,LSWREM AND UNLOCK IT
LSWREM: PUSH P,T
        PUSH P,U
        PUSH P,Q
        MOVE U,USER
        SKIPN U,LSWPR(U)
         BUG
        HRRZ Q,@-3(P)
        MOVEI T,1
LSWRM1: CAMN U,Q
         JRST LSWRM2
        HRRZ U,1(U)
        SKIPN U
         BUG
        AOJA T,LSWRM1
LSWRM2: POP P,Q
        POP P,U
        PUSHJ P,LSWPON
        AOS -1(P)
        JRST POPTJ

LSWDEL: PUSH P,U        ;REMOVE SWITCH FROM HEAD OF LIST
        MOVE U,USER     ;DO NOT ATTEMPT TO UNLOCK IT
        PUSH P,T
        SKIPN T,LSWPR(U)
         BUG
        PUSHJ P,LSWDDD
        JRST POPTUJ

LSWDDD: PUSH P,Q
        HRRZ Q,1(T)
        HRRZM Q,LSWPR(U)
        CAILE T,USRSTG
         SETZM 1(T)
        POP P,Q
        POPJ P,

;POP C(T)'TH FROB BACK
LSWPON: PUSHJ P,LSWBAK
        PUSHJ P,LSWPPP
        POPJ P,

;DELETE C(T)'TH FROB BACK
LSWDLN: PUSHJ P,LSWBAK
        PUSHJ P,LSWDDD
        POPJ P,

LSWBAK: PUSH P,U
        MOVE U,USER
        TLO U,400000    ;SIGNAL NOT PCLSR IN CASE OF LSWPPP
        PUSH P,Q
        MOVE Q,T
        MOVEI T,LSWPR-1(U)
        SOJE Q,LSWBA3   ;UNLOCKING FIRST FROB
        MOVE T,1(T)
        SOJG Q,.-1
LSWBA2: MOVE Q,T
        HRRZ T,1(T)
        PUSH P,LSWPR(U) ;DON'T WORRY, YOU CAN'T GET PCLSR'ED JUST BELOW
        XCT @-3(P)
        HRRZ T,LSWPR(U)
        HRRM T,1(Q)
        POP P,LSWPR(U)
        JRST POPQU1

LSWBA3: MOVE T,LSWPR(U)
        XCT @-2(P)
        JRST POPQU1
\f
SUBTTL VARIOUS RETURNS

PPBAJ1: POP P,B
POPAJ1: AOSA -1(P)
POPBAJ: POP P,B
POPAJ:  POP P,A
CPOPJ:  POPJ P,

POPQJ:  POP P,Q
        POPJ P,

POPBJ1: AOSA -1(P)
POPCBJ: POP P,C
POPBJ:  POP P,B
        POPJ P,

POPJ3:  AOS (P)
POPJ2:  AOSA (P)
POPCJ1: POP P,C
POPJ1:  AOSA (P)
POPCJ:  POP P,C
        POPJ P,

POPJJ1: AOS -1(P)
POPJJ:  POP P,J
        POPJ P,

POPUJ1: AOSA -1(P)
POPTUJ: POP P,T
POPUJ:  POP P,U
        POPJ P,

POPTJ:  POP P,T
        POPJ P,

POPTTJ: POP P,TT
        POPJ P,

POPWJ2: AOS -1(P)
POPWJ1: AOS -1(P)
POPWJ:  POP P,W
        POPJ P,

PIONJ:  CONO PI,PION
        POPJ P,

CKOCJ1: CONO PI,CLKON
        JRST POPCJ1

CLKOJ1: AOS (P)
CLKONJ: CONO PI,CLKON
        POPJ P,

CKOPJ1: AOS (P)
CLKOPJ: CONO PI,CLKON
        JRST LSWPOP

IFN OMXP,[
OMXONJ: CONO PI,OMXON
        POPJ P,
]

TTYOJ1: AOS (P)
TTYONJ: CONO PI,TTYON
        POPJ P,

IFN PTRP, PTRONJ:: PTPONJ::
LPTONJ: CONO PI,LPTON
        POPJ P,

IFN NETP,NETOJ1:
UTCOJ1: AOSA (P)
UTCOAJ:  POP P,A
IFN NETP,NETONJ:
UTCONJ: CONO PI,UTCON
        POPJ P,

POPQU1: AOS -2(P)
POPQUJ: POP P,Q
        POP P,U
        POPJ P,

POP1J1: AOS -1(P)
POP1J:  SUB P,[1,,1]
        POPJ P,

POP2J:  SUB P,[2,,2]
        POPJ P,

POP3J1: AOS -3(P)
POP3J:  SUB P,[3,,3]
        POPJ P,

POP4J:  SUB P,[4,,4]
        POPJ P,

POP7J:  SUB P,[2,,2]
POP5J:  SUB P,[5,,5]
        POPJ P,
\f
SUBTTL UUO PROCESSOR

.IOT=UUOMIN
.OPEN=UUOMIN+1_27.
.OPER=UUOMIN+2_27.
.CALL=UUOMIN+3_27.
.USET=UUOMIN+4_27.
.BREAK=UUOMIN+5_27.
.STATUS=UUOMIN+6_27.
.ACCESS=UUOMIN+7_27.

DEFINE GLOSYM X
        IRP Y,,[X]
        SQUOZE 4,.!Y
        .!Y
        TERMIN
        TERMIN

;REPEAT OVER USET NAMES FROM 0 TO 77.
        DEFINE USTIRP A
        IRPS X,,[UPC VAL TTY FLS UNAME JNAME MASK USTP
PIRQC INTB MEMT SV40 IPIRQ APIRQ SNAME PICLR
MARA MARPC UUOH UIND RUNT MSK2 IFPIR APRC
CNSL UTRP IIFPI AIFPI IMASK AMASK IMSK2 AMSK2
JPC OPC RTMR HSNAME BCHN MPVA IDF1 ADF1
IDF2 ADF2 DF1 DF2 OPTION 40ADDR TVCREG
TTST TTS1 TTS2 WHO1 WHO2 WHO3 SUPPRO TR1INS
TR2INS MBOX MBO1 EBOX EBO1 XUNAME XJNAME FTL1 FTL2]
A
TERMIN
TERMIN

;REPEAT OVER USET NAMES 600 AND UP.
        DEFINE USTIR1 A
        IRPS X,,[PAGRAN PAGAHD SERVER]
           A
        TERMIN TERMIN

;NOTE:  OPER'S BELOW ARE 8 PER LINE
;    USE UP ILUUO'S BEFORE ADDING TO END
; THE FOLLOWING SHOULD GO AWAY EVENTUALLY
;       ITYI (=ITYIC)
;       SETMSK (=SUSET)
;       WSNAME (=SUSET)
;       UPISET (=SUSET)
;       RDSW (=DATAI)
;       EOFC (OBSOLETE)
DEFINE OPRIRP A
        IRPS X,,[ITYI LISTEN SLEEP SETMSK SETM2 DEMON CLOSE
UCLOSE ATTY DTTY IOPUSH IOPOP DCLOSE DSTOP RDTIME
RDSW GUN UDISMT GETSYS IPDP GETLOC SETLOC DISOWN
DWORD DSTEP GENSYM LOGOUT REALT WSNAME UPISET RESET
ARMOVE DCONTIN CBLK ASSIGN DESIGN RTIME RDATE HANG
EOFC IOTLSR RSYSI SUPSET PDTIME ARMRS UBLAT IOPDL
ITYIC MASTER VSTST NETAC NETS REVIVE DIETIM SHUTDN
ARMOFF NDIS FEED EVAL REDEF IFSET UTNAM UINIT
RYEAR RLPDTM RDATIM RCHST RBTC DMPCH SWAP MTAPE
GENNUM NETINT]
        A
TERMIN
TERMIN

DEFINE CALIRP A
IRPS X,,[DISMIS LOSE TRANAD VALUE UTRAN CORE TRAND
DSTART FDELE DSTRTL SUSET LTPEN VSCAN POTSET]
A TERMIN TERMIN
\f
;THESE ARE THE SYMBOLS USED BY MIDAS AND DDT. THEY ALSO
;EXIST IN SYS:ITS DEFS.
;SYMBOLS SHOULD BE LEFT IN CURRENT ORDER OR DDT WILL LOSE
SYSYMB: USTIRP [SQUOZE 44,.R!X
        .IRPCNT]
        SQUOZE 44,.RIOC
        100
        SQUOZE 44,.RIOS
        120
        SQUOZE 44,.RIOP
        140
        SQUOZE 44,.RPMAP
        200
        USTIR1 [SQUOZE 44,.R!X
        600+.IRPCNT]
        USTIRP [SQUOZE 44,.S!X
        400000+.IRPCNT]
        USTIR1 [SQUOZE 44,.S!X
        400600+.IRPCNT]

        GLOSYM [IOT,OPEN,OPER]

DEFINE DEFSYM X/
IRPS Z,,[X]
SQUOZE 44,Z
Z
.ISTOP
TERMIN TERMIN

.INSRT BITS >

EXPUNG DEFSYM

        ZZ=1
        OPRIRP [IFSN X,ILUUO,[.!X=.OPER ZZ
        SQUOZE 4,.!X
        .!X]
        ZZ==ZZ+1]

MXOPR==ZZ

        SQUOZE 4,.CALL
        .CALL

CALIRP [
IFSN X,UNUSD,[
        .!X=.CALL .IRPCNT+1,
        SQUOZE 4,.!X
        .!X
]]

        GLOSYM [USET,BREAK,STATUS,ACCESS]
SYSYME==.-1
\f
;THESE SYMBOLS ARE USED BY DDT, SO THE USER CAN OPEN .PIRQC, ETC.
                ;BEGINNING FOR .GETSYS (USYMS)
SYSUSB:
USTIRP [
        SQUOZE 4,.!X
        .IRPCNT
]
        SQUOZE 4,.IOC
        100
        SQUOZE 4,.IOS
        120
        SQUOZE 4,.IOP
        140
        SQUOZE 4,.PMAP
        200
USTIR1 [
        SQUOZE 4,.!X
        600+.IRPCNT
]
SYSUSE==.-1     ;END FOR .GETSYS (USYMS)

;SIXBIT NAME TABLES FOR WHO LINE GENERATION.
;ALSO USED BY PEEK FOR PRINTING OUT JOBS' STATUS.

OPRSXB: SIXBIT/OPER/
OPRIRP [
.1STWD  SIXBIT/X/
]

CALSXB: SIXBIT/CALL/
CALIRP [
.1STWD  SIXBIT/X/
]
        SIXBIT/UNUSD/

UUOSXB:
IRPS X,,IOT OPEN OPER CALL USET BREAK STATUS ACCESS
.1STWD  SIXBIT/X/
TERMIN
NUUOSX==.-UUOSXB
\f
;MACRO TO SAVE ACS AS APPROPRIATE FOR OUR CPU, LOAD UP U,
;CHECK VARIOUS ERROR CONDITIONS.

DEFINE UUOSAV
        CONSZ PI,77400
         BUG AWFUL,[UUO WITH PI IN PROGRESS]
IFN KA10P,[
        UMOVEM U,17             ;SAVE 17
        SKIPGE U,USER           ;LOAD CURRENT USERS INDEX,
         BUG AWFUL,[UUO IN NULL JOB]
        UMOVEM T,16             ;SAVE LOC 16 FOR USER
        MOVEI T,0               ;HA HA
        XCTR XBW,[BLT T,15]     ;SAVE REST OF ACS IN USERS SHADOW 0-15
] ;KA10P
IFE KA10P,[
        SYSCTX
        SKIPGE U,USER
         BUG AWFUL,[UUO IN NULL JOB]
        LDB T,[330300,,MUUOCX(U)]
        CAIE T,1
         BUG AWFUL,[UUO WHILE IN AC BLK ],DEC,T
] ;IFE KA10P
TERMIN

; UUO AND ILLOP TRAP HANDLER
;
;EITHER DISPATCHES TO APPROPRIATE UUO ROUTINE,
;   RETURNS CONTROL TO USERS UUO ROUTINE, GOES TO ILLOP, USRTRP, OR USRIOT.
;CODE ON THIS PAGE IS INTERRUPTABLE AT ANY POINT

;COME HERE TO RETURN A UUO TO THE USER. RESTORES USER ACS W THROUGH U ONLY.
USRUUO: CAIG U,LUBLK
         BUG AWFUL,[RETURNABLE UUO FROM SYS OR CORE JOB,PC=],OCT,UUOH
        MOVE W,UUOH
        TLNN W,%PCUSR
         BUG AWFUL,[RETURNABLE UUO FROM EXEC MODE,PC=],OCT,UUOH
        HRRZ W,40ADDR(U)
        MOVE P,USRPDL(U) ;IN CASE AN XCTR FAULTS.
        XCTR XR,[HLRZ H,1(W)]
        CAIE H,(JSR)    ;ELSE OK ONLY IF OPCODE IN 41 IS 0 OR JSR.
         JUMPN H,ILUUO  ;THIS IS IN CASE USER IS HANDLING USER-UUO'S WITH PUSHJ
                        ;AND HIS UUOH ISN'T ABLE TO BE JSR'D TO.
        XCTR XR,[HRRZ H,1(W)]
        JUMPE H,ILUUO           ;0 ISN'T ACCEPTABLE AS UUOH ADDRESS.
        MOVE T,FORTY
        UMOVEM T,(W)    ;ALL IS LEGAL; PLANT UUO INTO USERS "40".
        MOVE T,UUOH     ;SIMULATE A JSR AT USER'S "41"
        UMOVEM T,(H)
        AOS H
        HRRM H,UUOH     ;SET TO RETURN TO USER AT FIRST INSTRUCTION OF UUO HANDLER
IFN KA10P,[
        MOVE U,[W,,W]
        XCTR XBR,[BLT U,U]
] ;KA10P
ULEAVE: USRCTX          ;SELECT USER MODE AC BLOCK IF NEC.

EBLK

;THE FOLLOWING BLOCK OF LOCATIONS IS SWITCHED WITH SOME USER VARS

UEXIT:  JRST 2,@XUUOH   ;EXIT FROM UUO (FOR KL-10, POINTS TO APPROPRIATE
                        ;UPT LOC) 

CLUSAV: MOVEM U,AC17S   ;CLOCK SAVE OF U

IFE KA10P,[
CLCXSV: DATAI PAG,CLCX  ;CLOCK LEVEL CONTEXT SAVE
] ;IFE KA10P

IFN KA10P,[
XUUOH:  0               ;UUO AND ILLOP TRAP GETS HERE - UUOH0 MUST BE . + 1.
] ;KA10P

UEXND:: ;END OF SWAPPED UEXIT BLOCK.

BBLK

UUOH0:  UUOSAV
MUUOT1: SKIPGE UTRAPM(U) ;IF SUPERIOR WANTS TO CATCH UUOS, THIS IS FATAL INT.
         JRST USRTRP
        SKIPGE T,FORTY  ;PICK UP THE UUO OR ILLOP
         JRST USRIOT
        CAML T,[UUOMIN]
         CAML T,[UUOMAX]
          JRST USRUUO   ;NOT A SYSTEM CALL, GIVE TO USER
;DROPS THROUGH
\f;DROPS IN
;HERE WITH UUO TO BE HANDLED BY SYSTEM IN T
ILLOP1: JUMPN U,UUOH1
        MOVEI Q,0       ;SAVE SYS JOB EXEC MODE LSWPR PNTR
        EXCH Q,LSWPR
        MOVEM Q,SLSWPR
UUOH1:  SKIPE LSWPR(U)
         JRST 4,.
        MOVEM T,LSUUO(U)        ;SAVE UUO FOR DEBUGGING PURPOSES
        LSH T,-27.              ;RIGHT JUSTIFY OP CODE
        SKIPL UUODSP-UUOMIN_-27.(T)
         JRST UUOTR3
        MOVE H,OPTION(U)
        TLNE H,%OPDEC
         JRST USRUUO
UUOTR3: SETZM SYSCVL(U)         ;DIDN'T GET INTO SYSTEM VIA .CALL
        MOVE P,USRPDL(U)        ;SET UP USER PDL
        HRRZ C,FORTY            ;PICK UP EFFECTIVE ADDRESS OF UUO
        LDB R,[270400,,FORTY]   ;PICK UP AC FIELD OF UUO
        MOVEM R,UUAC(U)         ;SAVE AC FLD
        PUSHJ P,@UUODSP-UUOMIN_-27.(T)  ;DISPATCH ON UUO TYPE
         JRST URET      ;NORMAL RETURN (NON SKIP)
URETJ1:
IFE KA10P, MOVE U,USER  ;(SINCE UUOH IS IN THE USER VARIABLES)
        AOS UUOH        ;UUO ROUTINE SKIPPED, AOS USER RETURN POINT
URET:   MOVE U,USER
        MOVE A,PIRQC(U) ;CHECK FOR RETURNING TO USER WITH PCLSR'ING FATAL
                        ; INT SET.
        TDNE A,[BADBTS&#<%PIC.Z\%PIDIS>] ;A FEW BITS ARE FATAL BUT SET
                                         ; ASYNCHRONOUSLY.
         JRST [ HRRZ A,UEXIT            ;INT SET, MAKE SURE UEXIT IS CLOBBERED
            IFN KA10P, CAIE A,ONEPRO    ;TO A LOCATION WHICH WILL CHECK PIRQC.
            IFN KS10P, CAIE A,ONEPR4
                CAIE A,ONEFLS
                 BUG
                JRST .+1]
        SKIPE UMAPS(U)
         PUSHJ P,MPLDZ
        CAMN U,PCLUSR
         SKIPG PCLDBM
          JRST URET2
        SKIPL PCLNXT
         JRST URPCL1
URET2:  SKIPE LSWPR(U)
         BUG
        JUMPN U,URETC
        MOVEI T,0       ;RESTORE SYS JOB EXEC LSWPR
        EXCH T,SLSWPR
        MOVEM T,LSWPR
URET1:  CONSO PI,1
         BUG            ;RETURNING TO USER MODE WITH CLOCK OFF
IFN KA10P,[
        MOVEI U,0
        XCTR XBR,[BLT U,U]      ;RESTORE USERS ACS FROM USERS SHADOW 0-17
] ;KA10P
        JRST ULEAVE

URETC:  REPEAT NULBLK/2,[
        SKIPN CONC LSWB,\<2*.RPCNT>,+1(U)
        SKIPE CONC LSWB,\<2*.RPCNT+1>,+1(U)
        BUG
]
        REPEAT NULBLK&1,[
        SKIPE CONC LSWB,\<NULBLK-1>,+1(U)
        BUG
]
        JRST URET1

URPCL1: SKIPN LSUUO(U)
        JRST URET2      ;DIDN'T REALLY MISS MARK (DUE TO FINSET)
        SETOM PCLNXT    ;MISSED MARK, REINITIALIZE
        SETZM PCLL
        SETZM PCLHSH
        JRST URET2

UUOTRO: MOVE T,FORTY
        JRST UUOH1

USRIOT: MOVSI T,(UIOT)  ;I/O INST TURNS INTO PSEUDO UUO TO DISPATCH ON
        JRST ILLOP1
\f
IFE KA10P,[

;HANDLE UUOS EXECUTED FOR TRAPS (PDL OV, ARITH OV, ONE PROCEED).
;MOST ARE AS USUAL, BUT OPCODE 0 IORM'S ADDRESS INTO PIRQC.
;NOTE: LOSER IS NOT PERMITTED TO USE OPCODE 0 - SEE USTR1I, ETC.

MUUOTR: UUOSAV
        MOVE T,FORTY
        TLNE T,-1
         JRST MUUOT1    ;IF OPCODE ISN'T 0, TREAT UUO NORMALLY (STARTING A
                        ; ONE PROCEED)
        MOVSI A,%PSTR1+%PSTR2
        ANDCAB A,UUOH   ;TURN OFF TRAP FLAGS, GET PC
        TRNN T,%PIARO
         JRST MUUOT2
        TLNE A,%PCFOV   ;DISTINGUISH FIXED AND FLOATING OVERFLOW.
         TLO T,(%PIFOV)
MUUOT2: MOVE A,MSKST(U)
        IOR A,[BADBTS]
        AND T,A         ;INTS SETTING WHICH AREN'T DISABLED
        IORM T,PIRQC(U)
        SKIPN PICLR(U)
         TDZA A,A
          SETCM A,IDF1(U)
        IOR A,[BADBTS]  ;MASK FOR INTS WHICH AREN'T DEFERRED
        TDNE T,A
         JRST ONEPR1    ;TAKE INT
        JRST URET       ;IGNORE INT

MUUOEX: BUG AWFUL,[MUUO IN EXEC MODE, PC=],OCT,EPT+425
                        ;UUO IN EXEC MODE NOT IN SYS JOB

LUUOEX: 0
        BUG AWFUL,[LUUO IN EXEC MODE,PC=],OCT,LUUOEX

ILLTRP: 0
        BUG AWFUL,[TRAP IN EXEC MODE,PC=],OCT,ILLTRP
] ;IFE KA10P

IFN KA10P,[
EBLK
60H:    0               ;TRAPS FROM 60
BBLK
60H0:   UUOSAV          ;IF WE LOSE PROCESSOR HERE, 60 GETS COPIED INTO 40,
                        ; 60H IS COPIED INTO UUOH, AND UPC GETS MOVED INTO
                        ; UUOH0.
60HE:   CONO PI,CLKOFF
        MOVE T,60H
        MOVEM T,UUOH
        MOVE T,60
        MOVEM T,FORTY
        CONO PI,CLKON
        JRST MUUOT1
] ;KA10P
\f
;COME HERE FROM UEXIT WHEN USER IS BEING PCLSR'ED
; KA10 - ALL USER ACS ARE IN MACHINE ACS AND IN UUOACS
; KL10 & KS10 - ALL USERS ACS ARE IN AC BLOCK 1

ONEFLS: CONO PI,CLKOFF          ;TURN OFF CLOCK BREAKS
        SYSCTX
        MOVE U,USER             ;GET INDEX OF CURRENT USER
ONEPR2: SKIPE T,RPCL(U)         ;SKIP IF NO RPCLSRING OCCURING
         JRST ONEFL2            ;RPCLSRING GOING ON
ONEPR1: MOVE U,USER             ;GET INDEX OF CURRENT USER
        CONO PI,CLKOFF          ;TURN OFF CLOCK BREAKS
        SKIPE LSWPR(U)
         JRST 4,.
        MOVEI T,AC0S(U)         ;PUT USER ACS INTO SWAP OUT ACS
        XCTR XBR,[BLT T,AC17S(U)]
        MOVE T,UUOH
        MOVEM T,UPC(U)          ;SIMULATE JRST 2,@UUOH
IFN KA10P, MOVE T,[JRST 2,@UUOH]
IFE KA10P,[
        MOVSI T,(JRST 2,@)
        HRRI T,UUOH
] ;IFE KA10P
        MOVEM T,UEXIT           ;RESTORE UEXIT
        USRCTX
        MOVE U,USER             ;AS IF HAD RETURNED TO USER THEN CLKBRK
                                ;EXCEPT THAT AC'S ARE ALREADY STORED IN AC0S
        JRST UFL6               ;RESCHEDULE, ETC

ONEFL2: JUMPG T,[JRST 4,.]      ;LOSEY LOSEY (SHOULD NOT TRY TO EXIT WHILE TRYING TO RPCLSR SOMEONE)
        MOVE A,FLSINS(T)        ;GET FLSINS OF USER SUPPOSEDLY RPCLSRING YOU
        SUBI A,RPCL(T)          ;HIS FLSINS SHOULD BE A SKIPE OF HIS RPCL
        CAME A,[SKIPE]          ;SKIP IF HE HAS THE RIGHT FLSINS
         JRST 4,.               ;LOSEY LOSEY
        CLEARM FLSINS(T)        ;ASSURE NO INTERRUPT
        SETZM RPCL(U)           ;ACS IN UUO ACS CLOCK OFF
        AOS USTP(U)             ;STOP SELF
        SETZM RPCL(T)           ;UNHANG LOSER RPCLSR'ING YOU
        JRST ONEPR1
\f
;ROUTINES TO GIVE THE RUNNING JOB AN INTERRUPT AND ABORT THE CURRENT INSTRUCTION

TTYLOS: SKIPA T,[%PITTY] ;JOB WHOSE %TBINT IS SET TRIED TO USE ITS TTY WHEN DIDN'T OWN IT
IOADC:   MOVEI T,%PIMPV ;I/O UUO MEMORY PROTECT VIOLATION
        JRST UUOERR

ABREAK: MOVEI T,%PIBRK  ;.BREAK - INTERRUPT TO SUPERIOR
ILLOP4: IORM T,PIRQC(U)
        JRST ONEPR1

        RADIX 10.
IOCERF: ;ADDRESS OF FIRST IO CHANNEL ERROR
ZZ==NIOTER
IFG ZZ-9,ZZ==9
REPEAT ZZ,CONC IOCER,\.RPCNT+MIOTER,:   JSP T,IOCERX
IFG NIOTER-9,[REPEAT NIOTER-9,CONC IOCR,\.RPCNT+MIOTER+9,:      JSP T,IOCERX
]
IFN 0, IOCER1: IOCER2: IOCER3: IOCER4: IOCER5: IOCER6: IOCER7:  ;FOR @
.ALSO  IOCER8: IOCER9: IOCR10: IOCR11: IOCR12: IOCR13: IOCR14:

        RADIX 8
IOCERX: CONSZ PI,77400
         JRST 4,.       ;ERR WITH PI IN PROGRESS
        SUBI T,IOCER9-9+1
        MOVE U,USER
        HRRZ TT,UUAC(U)
        DPB TT,[BCHPTR] ;STORE LAST CHNL IN ERROR
        ADD TT,U
        DPB T,[330600,,IOCHST(TT)]
IOCERR: MOVEI T,%PIIOC
        JRST UUOERR

AILUUO::
ILUUO:  SKIPA T,[%PIILO]        ;ILLEGAL SYSTEM UUO
TRPDEV:                         ;ATTEMPTED USE OF TRAP DEVICE
USRTRP:  MOVSI T,(%PITRP)       ;SYSTEM UUO IN TRAP MODE

UUOERR: MOVE U,USER
        IORM T,PIRQC(U) ;GIVE USER INT BIT
IOADCR: MOVE U,USER
        MOVE T,OPTION(U);PC CLOBBERED TO HERE IF MPV IN EXEC MODE - INTR OUT OF UUO
        TLNN T,%OPOPC   ;UNLESS USER HAS SAID NOT TO,
         AOS UUOH       ;UNDO SOS THAT PCLSR'ING WILL DO; PC SHOULD END UP -> AFTER UUO.
UUOER2: CONO PI,CLKON   ;THERE HAD BETTER BE A CLASS 1 OR 2 INT. PENDING.
        MOVE P,USRPDL(U)
        SETZM SCHMNY    ;CAUSE FULL SCHEDULE SO INTERRUPT WILL BE SEEN
        JFCL            ; (IT'S A CROCK TO HAVE TO DO THIS, BUT HARD TO FIX)
        PUSHJ P,UFLS    ;LET THE INTERRUPT PCLSR US.
        JRST 4,.

UUOER1: MOVE U,USER     ;UUOERR ASSUMING %OPOPC
        IORM T,PIRQC(U)
        JRST UUOER2

IFN KA10P,[
ILEXPF: CONO PI,CLKOFF  ;GET HERE AFTER EXEC PAGE FAULT TAKEN ON XCTRI
        SPM UPGML(U)
        MOVSI A,1770    ;CLEAR FAULT REASON BITS
        ANDCAM A,UPQUAN(U)
        LPMR UPGML(U)
        JRST ILUUO
] ;KA10P
IFE KA10P, ILEXPF==ILUUO        ;NO CLEANUP NECESSARY
\f
;UUO DISPATCH

;AT DISPATCH TIME, P HAS UPDL, C HAS RH OF 40
;R HAS AC FIELD OF UUO, U HAS USER INDEX

UUODSP: SETZ AIOT       ;SETZ FLAGS UUO'S TO REFLECT TO USER WHEN %OPDEC OPTIONS
        SETZ AOPEN      ;IN EFFECT. THEY ARE THE UUOS WHICH OVERLAP DEC
        AOPER
        ACALL
        AUSET
        ABREAK
        ASTATUS 
        SETZ AACCESS
        SETZ AUIOT
IF2,IFN <UIOT-UUOMIN>_-27.+UUODSP-.+1,.ERR LOSE AT UUODSP

;.CALL IOT
NIOT:   CAIL W,3        ;SET IOTBTS TO USER'S 3RD ARG, OR TO 0.
         SETZ C,
        MOVEM C,IOTBTS(U)
        HRRZ C,B        ;ADDRESS OF 2ND ARG
        SKIPGE SYSCVL(U)
         SKIPA C,[SETZ] ;USING OUTPUT ARG INSTEAD OF INPUT, FOR UNIT INPUT MODE
          CAIL W,2
           AOSA (P)     ;GOING TO SUCCEED NOW
            JRST OPNL30 ;NOT ENOUGH ARGS
        JRST AIOT1

;.IOT
AIOT:   SETZM CTLBTS(U)
        SETZM IOTBTS(U)
        ADDI R,IOCHNM(U) ;GET IOCHNM WD ADDR IN R.
AIOT1:  MOVE A,U
        IDIVI A,LUBLK
        SKIPE B
         BUG
        HLRZ A,(R)      ;PICK UP LEFT HALF (DEVICE DEPENDENT)
        HRRZ B,(R)      ;PICK UP RIGHT HALF (INDEX INTO IOTTB, ETC.)
        MOVE D,IOTTB(B) ;GO TO ROUTINE FOR PARTICULAR DEV AND MODE
        TLNE D,%IOTOT+%IOTBK+%IOTSP     ;BUT FOR "NORMAL" UNIT MODE INPUT, SPECIAL:
         JRST (D)
        XCTR XRW,[MOVES (C)] ;MAKE SURE XCTR XW, BELOW WON'T PCLSR.
        PUSH P,C
        PUSHJ P,(D)     ;CALL IOT ROUTINE, EXPECTING VALUE IN W.
AIOT3:   JRST AIOT2     ;NOTE AIOT3 MAY BE CHECKED FOR ON PDL.
          JRST AIOT2

AIOT2:  POP P,C
        SKIPGE C
         SKIPA A,W      ;RETURNING IN NEW SYSTEM-CALL STYLE
          UMOVEM W,(C)
        POPJ P,

;RANDOM ACCESS

AACCES: HRRZ A,UUAC(U)
        UMOVE B,(C)
        MOVE T,['ACCESS]
        MOVEM T,LSCALL(U)       ;IN CASE PASSED TO JOB DEVICE
        MOVEI W,2
        PUSHJ P,NACCES
         JRST IOCER8    ;FOR .ACCESS, SIGNAL FAILURE WITH IOC ERROR.
        POPJ P,         ;ONLY POSSIBLE FAILURE IS CHANNEL NOT OPEN.

NACCES: MOVEI T,AIOCAL  ;GET <CLSTB BITS>,,<IOCHNM WD ADDR> IN R
        MOVSI J,NACCE1
        JRST CHNDCD

NACCE1: TLNN R,%CLSQ\%CLSU\%CLSFU
         JRST OPNL34
        HRRM B,IOCHST-IOCHNM(R) ;STORE USR .ACCESS POINTER
        TLNN R,%CLSQ
         JRST POPJ1             ;NOT DISK
        HLRZ I,(R)
        MOVEM B,QRADAD(I)       ;STORE ACCESS POINTER FOR DSK
        MOVSI D,%QAACC
        IORM D,QSRAC(I) ;SET ADR HAS BEEN HACKED FLAG
        JRST POPJ1
\f
;SIOT SYMBOLIC SYSTEM CALL - IOT A STRING.
; 1ST ARG CHANNEL NUMBER.
; 2ND ARG BYTE POINTER
; 3RD ARG STRING LENGTH
; 4TH (OPTIONAL) ARG DEVICE-INDEPENDENT CONTROL BITS
; CTLBTS  DEVICE DEPENDENT CONTROL BITS

NSIOT:  TLNN B,1000     ;OBJECT IF B.P. OR COUNT IS IMMEDIATE.
         TLNE C,1000
          JRST OPNL33
        CAIGE W,4
         SETZ D,
        MOVEM D,IOTBTS(U)
        MOVE D,IOTTB(H)
        TLNE D,%IOTBK+%IOTSP    ;SIOT ALLOWED ONLY ON UNIT MODE CHANNELS.
         JRST OPNL12            ;"MODE NOT AVAILABLE".
        XCTR XRW,[MOVES A,(B)]  ;ENSURE BYTE POINTER WRITABLE
        TLNE A,(@)              ;CAN'T HACK BYTE POINTER WITH INDIRECT ADDRESSING
         JRST OPNL33            ;MEANINGLESS ARGS
        TLNE A,17
         PUSHJ P,NSIOT9         ;HACK INDEXING
        XCTR XRW,[MOVES A,(C)]  ;ENSURE BYTE COUNT WRITABLE
        JUMPLE A,POPAJ1         ;0 BYTES TO BE XFERED => SUCCEED IMMEDIATELY.
        HLRZ A,(R)
        MOVE TT,B               ;IN CASE SPECIAL ROUTINE WANTS TO CALL SIOKT
        TLNE D,%IOTBP           ;IF THERE'S A SPECIAL DEVICE ROUTINE FOR SIOT,
         JRST -1(D)             ;GO TO IT.
;THIS CALL IS LEGAL AND ORDINARY. LOOP, CALLING THE UNIT MODE ROUTINE.
NSIOT1: PUSH P,A
        PUSH P,B
        PUSH P,C
        PUSH P,D                ;PUT ALL IMPORTANT INFO ON STACK FOR MAIN LOOP
        HRRZS (P)               ;TO LOOK AT.
        PUSH P,R
        TLNN D,%IOTOT
         JRST NSIOIL            ;INPUT AND OUTPUT PART HERE
NSIOOL: UMOVE A,@-3(P)
        IBP A                   ;THIS HAIR IS TO AVOID INCREMENTING THE USER'S COPY
        UMOVE D,(A)             ;OF THE BYTE POINTER BEFORE THE BYTE HAS BEEN
        HRRI A,D                ;FINALLY TAKEN WITH NO POSSIBILITY OF PCLSR'ING OUT.
        LDB D,A                 ;CAN'T USE XCTR XR,[LDB D,A] BECAUSE ON THE KA10
        MOVE C,[SETZ D]         ;THAT WOULD USE THE LOSER'S AC A.
        MOVE R,(P)
        MOVE A,-4(P)    ;SET UP ARGS FOR IOT ROUTINE; C HAS ADDR OF VALUE.
        PUSHJ P,@-1(P)  ;CALL THE IOT ROUTINE.
        XCTR XRW,[IBP @-3(P)]   ;NOW STEP THE B.P. AND COUNT.
        XCTR XRW,[SOS A,@-2(P)]
        JUMPG A,NSIOOL
        JRST NSIOTX

NSIOIL: UMOVE A,@-3(P)
        IBP A           ;MAKE SURE NO FAULT IDPB'ING THE BYTE
        XCTR XRW,[MOVES (A)]
        MOVE R,(P)      ;NOW GET THE ARGS FOR THE IOT ROUTINE,
        MOVE A,-4(P)
        PUSHJ P,@-1(P)  ;AND CALL IT, WITH VALUE COMING IN W.
         JRST NSIOI3    ;NO SKIP => WE WIN.
          JRST NSIOTX   ;1 SKIP => THERE'S NO INPUT; RETURN WITHOUT STEPPING B.P.
                        ;2 SKIPS => THIS BYTE IS THE LAST ONE AVAILABLE.
        XCTR XBYTE,[IDPB W,@-3(P)]
        XCTR XRW,[SOS @-2(P)]
        JRST NSIOTX

NSIOI3: XCTR XBYTE,[IDPB W,@-3(P)]
        XCTR XRW,[SOS A,@-2(P)]
        JUMPG A,NSIOIL
NSIOTX: SUB P,[5,,5]
        JRST POPJ1

NSIOT9: EXCH A,R        ;INDEXED BYTE POINTER, EVAL INDEX ONCE AND WRITE BACK
        PUSHJ P,ASCIND
        EXCH A,R
        UMOVEM A,(B)
        POPJ P,
\f;
; ROUTINES TO SIMULATE SOME I/O INSTRUCTIONS WHEN EXECUTED BY USER

IFE KS10P,[     ; KS10 will never have any devices so we might as well punt
                ; this sham right from the start.

AUIOT:  MOVE I,FORTY    ;GET I/O INST
        ANDI R,7        ;GET IOT TYPE FIELD
        LDB J,[320700,,FORTY]
        LDB D,[420200,,IOTTYP(R)]
        JRST @IOTTYP(R) ;DISPATCH ON TYPE

IOTTYP: 000000,,IOTTY3          ;BLKI
        000000,,IOTTY2          ;DATAI
        200000,,IOTTY3          ;BLKO
        200000,,IOTTY2          ;DATAO
        600000,,IOTTY2          ;CONO
        400000,,IOTTY2          ;CONI
        400000,,IOTTY1          ;CONSZ
        400000,,IOTTY1          ;CONSO

IOTTY1: CAIN J,177      ;IF EQ INST WAS 7777XX,,XXXXXX
        JRST ILUUO      ;USER HAS EXECUTED A SMALL NEGATIVE NUMBER
        JRST IOTTY2

IOTTY3:
IFN KL10P,[
        MOVE C,DCHNTB(J)
        TRNE C,10000
         JRST IOTTY2    ;SPECIAL BLKI THAT IS TREATED LIKE DATAI
]
        TLO I,40        ;BLOCK TYPE, TURN ON BIT TO CONVERT TO UNIT
        UMOVE C,(I)     ;GET BLOCK POINTER
        ADD C,[1,,1]    ;ADVANCE
        TLNE C,-1       ;SKIP IF OVERFLOW
        AOS (P)         ;CAUSE RETURN TO SKIP
        UMOVEM C,(I)    ;STORE BACK
        HRR I,C         ;MODIFY INST ADR TO RH OF BLOCK POINTER
IOTTY2: SKIPL C,DCHNTB(J)
        JRST IOTTYA
        LSH C,19.(D)
        SKIPL C
        JRST ILUUO
IOTTYB: XCTR XRW,I      ;DO IOT
        POPJ P,         ;NORMAL RETURN
        JRST POPJ1      ;IOT SKIPPED RETURN

IOTTYA: SKIPGE DCHNTC(J)
        JRST ILUUO      ;SUSPICIOUS DEVICE
        JRST IOTTYB

] ;IFE KS10P

IFN KS10P, AUIOT==:ILUUO        ; For now.

IFN 0,[         ; Simple IO instruction simulating for the KS should look
                ; like this.  Unfortunately XCTR XRW,[APRID 100] clobbers
                ; exec location 100.  Further investigation is needed
                ; before figuring out how to deal with this.

AUIOT:  LDB R,[271500,,FORTY]   ; Get opcode and AC.
        CAIE R,APRID_-27        ; For now this is the only instruction we
                                ; simulate on the KS
         JRST ILUUO
        XCTR XRW,FORTY          ; Do it
         POPJ P,                ; Return normally
        JRST POPJ1              ; It skipped (well APRID can't, but perhaps
                                ; someday something else will)
] ;IFN 0
\f
SUBTTL .SUSET, .USET, .CALL USRVAR

;COMMON CODE FOR USRVAR, TTYVAR, ETC. SYMBOLIC SYSTEM CALLS
;PUSHJ P,VARCAL WITH FIRST ARG DECODED INTO H,I,J,R; B,C,W,U SET UP AS IN .CALL
;NOTE B IS A POINTER TO THE SECOND ARG (IN BLOCK MODE IS WRITTEN BACK)
;POPJS (OR PUSHJS IN THE CASE OF BLOCK MODE) BACK WITH E CONTAINING
;VARIABLE SPEC, D INPUT DATA, W INSTRUCTION TO HACK IT (0 TO READ INTO A,
;OTHERWISE OP D, WITH RH CLEAR WHERE OP IS MOVEM, ANDCAM, ADDM, ETC.)

VARCAL: HRRZ E,B        ;USE 2ND ARG AND NUM OF ARGS TO DETERMINE TYPE OF OPERATION
        TLNE B,1000
         JRST VARCA1    ;IMMEDIATE 2ND ARG
        UMOVE E,(B)     ;GET VALUE OF 2ND ARG
        TLC E,777000
        TLCN E,777000
         JRST VARCBL    ;BLOCK MODE (2ND ARG LOOKS LIKE AOBJN POINTER)
VARCA1: EXCH D,C        ;D GETS 3RD ARG, INPUT DATA
        CAIL W,4
         JRST VARCA2    ;JUMP IF IMMEDIATE INSTRUCTION MODE
        CAIGE W,3       ;SKIP IF WRITING
         TDZA W,W       ;W 0 FOR READING
          MOVSI W,(MOVEM D,) ;SIMPLE CASE OF WRITING (SEE VARCBL FOR HAIR)
        POPJ P,         ;CALLER WILL DO OPERATION AND POPJ1 OR OPEN-LOSS

VARCA2: ADD P,[2,,2]    ;IMMEDIATE INSTRUCTION MODE.  MAKE STACK SAME AS AT VARCAL.
        TLNN C,-1       ;E HAS VARIABLE SPEC
         MOVSS C        ;C GETS INSTRUCTION
        PUSHJ P,VARCA3  ;PERFORM THE INSTRUCTION
        JRST POP3J1     ;TAKE GOOD RETURN FROM THE CALL

VARCBL: PUSH P,J        ;BLOCK MODE.  SAVE J WHICH SOME SUSETS CLOBBER
        PUSH P,B        ;SAVE POINTER TO AOBJN POINTER TO SPEC,INSN PAIR LIST
        XCTR XRW,[MOVES B,@(P)] ;GET AOBJN POINTER, TEST WRITEABILITY
VARCB1: UMOVE E,(B)     ;GET VARIABLE SPEC
        UMOVE C,1(B)    ;GET "INSTRUCTION"
        MOVE J,-1(P)    ;GET DECODED FIRST ARG OR WHATEVER (SOME USRVAR ROUTINES CLOBBER J)
        PUSHJ P,VARCA3  ;PERFORM THE INSTRUCTION
        MOVE B,[2,,2]
        XCTR XRW,[ADDB B,@(P)]  ;ADVANCE AOBJN POINTER
        JUMPL B,VARCB1          ;MORE STUFF TO DO
        JRST POP3J1             ;POINTER COUNTED OUT, POP B, J, PUSHJ TO VARCAL

VARCA3: EXCH C,R        ;HERE TO PERFORM INSTRUCTION IN C
        TLNE R,37
         PUSHJ P,ASCIND         ;EVALUATE INSTRUCTION'S EFFECTIVE ADDRESS
        EXCH C,R
        LDB B,[410300,,C]       ;GET MAJOR PDP10 OPCODE CLASS
        JRST @.+1(B)
         VARCBE         ;0 UUO ILLEGAL
         VARCBE         ;1 FP/BYTE ILLEGAL
         VARCB2         ;2 MOVE/ADD/SUB
         VARCBE         ;3 CAM ETC. RESERVED FOR .HANGING IN THE FUTURE
         VARCB4         ;4 BOOLE
         VARCBE         ;5 HWT ILLEGAL
         VARCB6         ;6 TEST
         VARCBE         ;7 IOT ILLEGAL

VARCBE: SUB P,[4,,4]    ;POP PUSHJ TO VARCA3, B, J, PUSHJ TO VARCAL
        JRST OPNL33     ;BAD ARG

VARCB6: TLNE C,006000   ;TEST INSTRUCTION - SKIP IF NO SKIP
         JRST VARCBE    ;SKIPPING TESTS RESERVED FOR FUTURE .HANGS
        TLNE C,010000   ;SKIP IF IMMEDIATE
         XCTR XR,[SKIPA D,(C)]
          HRRZ D,C
        TLNE C,001000   ;SKIP IF TDX OR TRX
         MOVSS D        ;TSX OR TLX
        LDB C,[370200,,C] ;GET MODIFICATION TYPE
        XCT (C)[JRST VARCBE     ;NO MODIFICATION OBVIOUSLY AN ERROR
                MOVSI W,(ANDCAM D,) ;TXZ
                MOVSI W,(XORM D,)   ;TXC
                MOVSI W,(IORM D,)]  ;TXO
        JRST VARCBA
\f
VARCB4: TLNE C,002000   ;BOOLEAN INSTRUCTION - OK IF RESULT TO AC
         JRST VARCBE
        TLNN C,001000   ;SKIP IF IMMEDIATE
         XCTR XR,[SKIPA D,(C)]
          HRRZ D,C
        HLLZ W,C        ;SET UP OPCODE TO HAVE A+M EXCHANGED
        TLZ W,003777    ;AND RESULT TO BE SENT TO MEMORY
        TLCE W,030000
         TLCE W,030000
          TLC W,030000
        TLO W,(<002000,,> D,)
        JRST VARCBA

VARCB2: SETZB W,D               ;MOVE/ADD/SUB GROUP
        HLRZ B,C
        CAIN B,(MOVEM)
         JRST VARCBB            ;SIMPLY READING
        TLNE C,002000
         JRST VARCBE            ;RESULT MUST BE TO AC
        TLZ C,(0 17,)           ;CHANGE AC FIELD TO D
        TLO C,(0 D,)
        TLNE C,060000           ;SKIP IF MOVE GROUP
         JRST VARCB5
        XCTR XR,C               ;FETCH OPERAND, DO MODIFICATION IF CALLED FOR (MOVN)
        MOVSI W,(MOVEM D,)      ;OPERATION WILL BE SIMPLE STORE
        JRST VARCBA

VARCB5: TLC C,070000
        TLCE C,070000
         JRST VARCBE            ;NOT ADD/SUB
        XCTR XR,C               ;ADD TO/SUBTRACT FROM ZERO IN D
        MOVSI W,(ADDM D,)       ;DROP INTO VARCBA

;HERE WITH E, W, D ALL SET UP FOR WRITING.
VARCBA: PUSHJ P,@-3(P)          ;CALL BACK TO CALLER OF VARCAL
         JRST POP4J             ;LOST, POP PUSHJ TO VARCA3, B, J, VARCAL, TAKE ERR RETURN
        POPJ P,                 ;WON, RETURN FROM VARCA3
        
;HERE WITH E AND W SET UP FOR READING.
VARCBB: PUSH P,C                ;SAVE ADDRESS TO BE READ INTO
        XCTR XRW,[MOVES (C)]    ;NO FAULT.  INSURANCE OF WRITEABILITY.
        PUSHJ P,@-4(P)          ;GET VALUE OF VARIABLE INTO A
         JRST POP5J             ;LOST POP C, VARCA3, B, J, VARCAL, TAKE ERR RETURN TO USER
        POP P,C                 ;WON, STORE RESULT INTO USER
        UMOVEM A,(C)
        POPJ P,                 ;AND RETURN FROM VARCA3
\f
USETBT: 420200,,USETL(E)        ;BYTE POINTER TO UENTRY FIELD A
        400200,,USETL(E)        ; " B
        200200,,USETL(E)        ; " C
        160200,,USETL(E)        ; " D

USETRL: 221600,,USETL(E)        ;BYTE POINTER TO UENTRY FIELD E
        001600,,USETL(E)        ; " F

;IN EACH UENTRY ENTRY:  A IS THE METHOD FOR USET READ
;                       B IS THE METHOD FOR SUSET READ
;                       C IS THE METHOD FOR USET SET
;                       D IS THE METHOD FOR SUSET SET
;                       E & F ARE USED BY THE METHODS AS LISTED BELOW
;METHOD 0 = ILLEGAL MODE
;METHOD 1 = USE F AS RELATIVE LOC OF VAR
;METHOD 2 = USE E AS ROUTINE TO TRANSFER TO
;METHOD 3 = USE F AS ROUTINE TO TRANSFER TO

DEFINE UENTRY A,B,C,D,E,F
        ZZ==.SUCCESS
        A_20+B_16+E,,C_20+D_16+F
        IF2 [
        IFN 777774&<A\B\C\D>,[PRINTX /UENTRY A,B,C,D TOO BIG
/]      IFN 740000&<E\F>,[PRINTX /UENTRY E,F TOO BIG
/]      IFSE [E!F],[PRINTX /UENTRY E,F NULL
/]      ]
        .SUCCESS==ZZ
        TERMIN

USETL:  UENTRY 1,1,2,0,UPCSET,UPC-USRSTG        ;.UPC
        UENTRY 1,1,1,1,,VALUE-USRSTG            ;.VAL
        UENTRY 3,3,2,2,USTTY,URTTY              ;.TTY
        UENTRY 1,1,0,0,,FLSINS-USRSTG           ;.FLS
        UENTRY 1,1,0,2,UUNAME,UNAME-USRSTG      ;.UNAME
        UENTRY 1,1,2,2,UJNAME,JNAME-USRSTG      ;.JNAME
        UENTRY 1,1,2,2,USMASK,MSKST-USRSTG      ;.MASK
        UENTRY 1,1,2,0,USTOP,USTP-USRSTG        ;.USTP

        UENTRY 1,1,2,2,USPIRQ,PIRQC-USRSTG      ;.PIRQC
        UENTRY 2,2,0,0,UGSUPR,                  ;.INTB
        UENTRY 1,1,2,2,USMEMT,HUSRAD-USRSTG     ;.MEMT
        UENTRY 1,1,0,0,,SV40-USRSTG             ;.SV40
REPEAT 2,UENTRY 1,1,2,2,IAPIRQ,PIRQC-USRSTG     ;.IPIRQ/.APIRQ
        UENTRY 1,1,2,2,USYNST,USYSNM-USRSTG     ;.SNAME
        UENTRY 1,1,2,2,UPISET,PICLR-USRSTG      ;.PICLR

        UENTRY 2,2,3,3,URMAR,USMAR              ;.MARA
        UENTRY 1,1,1,1,,UMARPC-USRSTG           ;.MARPC
        UENTRY 1,1,0,0,,SUUOH-USRSTG            ;.UUOH
        UENTRY 2,2,0,0,UINDEX,                  ;.UIND
        UENTRY 1,2,0,0,UTRNTR,UTRNTM-USRSTG     ;.RUNT
        UENTRY 1,1,2,2,USMSK2,MSKST2-USRSTG     ;.MSK2
        UENTRY 1,1,2,2,USIFPI,IFPIR-USRSTG      ;.IFPIR
        UENTRY 1,1,0,0,,APRC-USRSTG             ;.APRC

        UENTRY 3,3,0,0,,URCNSL                  ;.CNSL
        UENTRY 2,0,3,0,RUTRAP,SUTRAP            ;.UTRP
REPEAT 2,UENTRY 1,1,2,2,IAIFPI,IFPIR-USRSTG     ;.IIFPI/.AIFPI
REPEAT 2,UENTRY 1,1,2,2,IAMASK,MSKST-USRSTG     ;.IMASK/.AMASK
REPEAT 2,UENTRY 1,1,2,2,IAMSK2,MSKST2-USRSTG    ;.IMSK2/.AMSK2

        UENTRY 3,3,2,2,UJPCS,UJPCR,             ;.JPC
        UENTRY 2,2,0,0,UROPC,                   ;.OPC
        UENTRY 1,1,1,1,,RTIMER-USRSTG           ;.RTMR
        UENTRY 1,1,1,1,,HSNAME-USRSTG           ;.HSNAME
;IFN KL10P,UENTRY 1,1,1,1,,ULSPBR-USRSTG        ;.LSPBR
;.ELSE  UENTRY 1,1,1,1,,SRN3-USRSTG
        UENTRY 2,2,3,3,RUBCHN,SUBCHN,           ;.BCHN
        UENTRY 2,2,0,0,MPVARD                   ;.MPVA
REPEAT 2,UENTRY 1,1,2,2,IADF1,IDF1-USRSTG       ;.IDF1, .ADF1

REPEAT 2,UENTRY 1,1,2,2,IADF2,IDF2-USRSTG       ;.IDF2, .ADF2
        UENTRY 1,1,2,2,USDF1,IDF1-USRSTG        ;.DF1
        UENTRY 1,1,2,2,USDF2,IDF2-USRSTG        ;.DF2
        UENTRY 1,1,1,1,,OPTION-USRSTG           ;.OPTION
        UENTRY 1,1,1,1,,40ADDR-USRSTG           ;.40ADDR
IFE N11TYS,     UENTRY 1,1,1,1,,SRN3-USRSTG     ;.TVCREG - JOB'S CONSOLE REGISTER CONTENTS
IFN N11TYS,     UENTRY 1,1,1,2,STVCRG,TVCREG-USRSTG
        UENTRY 1,1,1,1,,TTSTSV+2-USRSTG         ;.TTST

        UENTRY 1,1,1,1,,TTSTSV-USRSTG           ;.TTS1
        UENTRY 1,1,1,1,,TTSTSV+1-USRSTG         ;.TTS2
        UENTRY 1,1,1,1,,UWHO1-USRSTG            ;.WHO1
        UENTRY 1,1,1,1,,UWHO2-USRSTG            ;.WHO2
        UENTRY 1,1,1,1,,UWHO3-USRSTG            ;.WHO3
        UENTRY 3,3,0,0,,RUSUPP                  ;.SUPPRO
IFN KA10P, UENTRY 2,2,0,0,URTR1I                ;.TR1INS
IFE KA10P, UENTRY 1,1,1,1,,TR1INS-USRSTG
IFN KA10P, UENTRY 2,2,0,0,URTR2I                ;.TR2INS
IFE KA10P, UENTRY 1,1,1,1,,TR2INS-USRSTG

IFE KL10P,[
REPEAT 4,UENTRY 1,1,0,0,,SRN3-USRSTG
] ;IFE KL10P
IFN KL10P,[
        UENTRY 1,0,0,0,,MBOXCT-USRSTG           ;.MBOX
        UENTRY 1,0,0,0,,MBOXCT+1-USRSTG         ;.MBO1
        UENTRY 1,0,0,0,,EBOXCT-USRSTG           ;.EBOX
        UENTRY 1,0,0,0,,EBOXCT+1-USRSTG         ;.EBO1
] ;KL10P
        UENTRY 1,1,1,1,,XUNAME-USRSTG           ;.XUNAME (USER'S REAL NAME)
        UENTRY 1,1,1,1,,XJNAME-USRSTG           ;.XJNAME
        UENTRY 1,1,1,1,,SRN4-USRSTG             ;.FTL1
        UENTRY 1,1,1,1,,SRN5-USRSTG             ;.FTL2
        UENTRY 1,1,1,1,,PAGRAN-USRSTG           ;.PAGRANGE
        UENTRY 1,1,1,1,,PAGAHD-USRSTG           ;.PAGAHEAD
        UENTRY 2,2,3,3,URSERV,USSERV            ;.SERVER
MXVAL==.-USETL
EXPUNGE UENTRY  ;NO MORE UENTRY'S
\f
MXVAL2==.RADIX 2,CONC [.LENGTH/]\MXVAL-1,/      ;BASE 2 LOG OF TABLE SIZE

;SIXBIT TABLE OF USER VARIABLE NAMES.  MUST BE IN CORRECT ORDER,
;SAME AS SYSCTB.

USETTB: SIXBIT/ADF1/
        SIXBIT/ADF2/
        SIXBIT/AIFPIR/
        SIXBIT/AMASK/
        SIXBIT/AMSK2/
        SIXBIT/APIRQC/
        SIXBIT/APRC/
        SIXBIT/BCHN/
        SIXBIT/CNSL/
        SIXBIT/DF1/
        SIXBIT/DF2/
        SIXBIT/EBO1/
        SIXBIT/EBOX/
        SIXBIT/FLS/
        SIXBIT/FTL1/
        SIXBIT/FTL2/
        SIXBIT/HSNAME/
        SIXBIT/IDF1/
        SIXBIT/IDF2/
        SIXBIT/IFPIR/
        SIXBIT/IIFPIR/
        SIXBIT/IMASK/
        SIXBIT/IMSK2/
        SIXBIT/INTB/
        SIXBIT/IPIRQC/
        SIXBIT/JNAME/
        SIXBIT/JPC/
        SIXBIT/MARA/
        SIXBIT/MARPC/
        SIXBIT/MASK/
        SIXBIT/MBO1/
        SIXBIT/MBOX/
        SIXBIT/MEMT/
        SIXBIT/MPVA/
        SIXBIT/MSK2/
        SIXBIT/OPC/
        SIXBIT/OPTION/
        SIXBIT/PAGAHE/
        SIXBIT/PAGRAN/
        SIXBIT/PICLR/
        SIXBIT/PIRQC/
        SIXBIT/RTMR/
        SIXBIT/RUNT/
        SIXBIT/SERVER/
        SIXBIT/SNAME/
        SIXBIT/SUPPRO/
        SIXBIT/SV40/
        SIXBIT/TR1INS/
        SIXBIT/TR2INS/
        SIXBIT/TTS1/
        SIXBIT/TTS2/
        SIXBIT/TTST/
        SIXBIT/TTY/
        SIXBIT/TVCREG/
        SIXBIT/UIND/
        SIXBIT/UNAME/
        SIXBIT/UPC/
        SIXBIT/USTP/
        SIXBIT/UTRP/
        SIXBIT/UUOH/
        SIXBIT/VAL/
        SIXBIT/WHO1/
        SIXBIT/WHO2/
        SIXBIT/WHO3/
        SIXBIT/XJNAME/
        SIXBIT/XUNAME/
        SIXBIT/40ADDR/
IFN .-USETTB-MXVAL, .ERR USETTB INCONSISTENT WITH USETL
REPEAT 1_<MXVAL2>-<MXVAL-1>-1, <SETZ>-1 ;PAD TO POWER OF 2 WITH PLUS INFINITY
\f
;THE FOLLOWING TABLE IS PARALLEL TO USETTB AND GIVES THE NUMERIC USET CODE
;WHICH SHOULD BE IN THE RANGE 0 - 77 OR 600 AND UP.
USETBN: 47      ;.ADF1
        51      ;.ADF2
        33      ;.AIFPI
        35      ;.AMASK
        37      ;.AMSK2
        15      ;.APIRQ
        27      ;.APRC
        44      ;.BCHN
        30      ;.CNSL
        52      ;.DF1
        53      ;.DF2
        73      ;.EBO1
        72      ;.EBOX
        3       ;.FLS
        76      ;.FTL1
        77      ;.FTL2
        43      ;.HSNAME
        46      ;.IDF1
        50      ;.IDF2
        26      ;.IFPIR
        32      ;.IIFPI
        34      ;.IMASK
        36      ;.IMSK2
        11      ;.INTB
        14      ;.IPIRQ
        5       ;.JNAME
        40      ;.JPC
        20      ;.MARA
        21      ;.MARPC
        6       ;.MASK
        71      ;.MBO1
        70      ;.MBOX
        12      ;.MEMT
        45      ;.MPVA
        25      ;.MSK2
        41      ;.OPC
        54      ;.OPTION
        601     ;.PAGAHE
        600     ;.PAGRAN
        17      ;.PICLR
        10      ;.PIRQC
        42      ;.RTMR
        24      ;.RUNT
        602     ;.SERVER
        16      ;.SNAME
        65      ;.SUPPRO
        13      ;.SV40
        66      ;.TR1INS
        67      ;.TR2INS
        60      ;.TTS1
        61      ;.TTS2
        57      ;.TTST
        2       ;.TTY
        56      ;.TVCREG
        23      ;.UIND
        4       ;.UNAME
        0       ;.UPC
        7       ;.USTP
        31      ;.UTRP
        22      ;.UUOH
        1       ;.VAL
        62      ;.WHO1
        63      ;.WHO2
        64      ;.WHO3
        75      ;.XJNAME
        74      ;.XUNAME
        55      ;.40ADDR
IFN .-USETBN-MXVAL, .ERR USETBN INCONSISTENT WITH USETL
\f
;.CALL USRVAR HACK USER VARIABLES.
;ARG 1 - <JOB> SPEC
;ARG 2 - AOBJN PNTR FOR BLOCK MODE OR 0,,USER-VAR-NUMBER OR SIXBIT/USER-VAR-NAME/
;ARG 3 - DATA IF WRITING AND NOT IN BLOCK MODE. (OPTIONAL)
;ARG 4 - IMMEDIATE INSTRUCTION, OVERRIDES ARG 3. (OPTIONAL)
;VAL 1 - DATA IF READING AND NOT IN BLOCK MODE

NUSRVA: MOVE J,A                ;DECODE FIRST ARG
        JSP T,NCORUI            ;GET JOB AND LOCK ITS DIELOK
         JRST NUSRV0            ;DEFINITELY WRITEABLE
        JSP T,NCORWR            ;NOT SURE, CHECK FURTHER
         TLO J,(SETZ)           ;SET WRITE PROTECT BIT
NUSRV0:
IFN PDP6P,[
        TRNE J,400000
         PUSHJ P,NULSET
]
        PUSHJ P,NUSRV5          ;DO IT
         POPJ P,                ;LOST
        JRST LSWPJ1             ;WON, UNLOCK DIELOK AND TAKE SUCCESS RETURN

NUSRV5: PUSHJ P,VARCAL          ;DECODE ARGS, HACK BLOCK MODE, SET E, W, D.
NUSRV3: SETZB B,I               ;ENTER HERE FROM .USET AND .SUSET
        TLNN E,-1               ;NOW DECODE USER VARIABLE SPEC
         JRST NUSRV1            ;JUMP IF OLD STYLE NUMERIC SPEC
REPEAT MXVAL2,[                 ;SIXBIT SPEC LOOK UP IN TABLE
        CAML E,USETTB+1_<MXVAL2-.RPCNT-1>(B)
         ADDI B,1_<MXVAL2-.RPCNT-1>
]
        CAMN E,USETTB(B)
         CAIL B,MXVAL
          JRST OPNL11           ;ILLEGAL USER VARIABLE NAME
        MOVE E,USETBN(B)        ;TRANSLATE TO NUMERIC SPEC
NUSRV1: JUMPE W,NUSRV2          ;READING
        JUMPL J,OPNL31          ;WRITING AND WRITE PROTECTED
        MOVEI I,2               ;MAGIC INDEX 1.2=R/W 1.1=OTHER/SELF
NUSRV2: CAIN U,(J)
         IORI I,1
IFN PDP6P,[
        HRRE B,J
        AOJE B,PDPPMT           ;USER IS PDP6
]
        CAIL E,600
         JRST [ SUBI E,500
                JRST NUSRV4]
        CAIL E,100
         JRST AUSET2            ;100 TO 577 ARE .IOC, .IOS, .IOP, .PMAP VARS.
NUSRV4: CAIL E,MXVAL            ;DETECT USET CODE BEYOND 6XX MAXIMUM.
         JRST OPNL11
        LDB B,USETBT(I)         ;GET METHOD BITS
        SOJL B,OPNL12           ;VARIABLE NOT AVAILABLE THIS MODE (WRITE PROTECT?)
        SOJL B,AUSVAR           ;SIMPLE VARIABLE
        LDB B,USETRL(B)         ;GET ADDRESS OF ROUTINE TO CALL
        HRRZ A,J                ;SOME ROUTINES WANT USER INDEX IN A
        JUMPE W,(B)
        CAMN W,[MOVEM D,]
         JRST (B)
        PUSH P,D                ;READ/ALTER/REWRITE
        PUSH P,E
        PUSH P,I
        PUSH P,W
        PUSH P,J
        TRZ I,2                 ;FIRST READ IT
        MOVEI W,0
        PUSHJ P,NUSRV4
         JRST POP5J             ;READ LOST
        POP P,J
        POP P,W
        POP P,I
        POP P,E
        POP P,D
        HRRI W,A
        XCT W                   ;MODIFY THE VALUE IN A
        MOVE D,A
        MOVSI W,(MOVEM D,)
        JRST NUSRV4             ;THEN WRITE IT BACK
\f
;
;       .SUSET [N,,LOC] ;SAME AS .USET (SEE BELOW) BUT REFERS TO SELF
;
ASUSET: HRRZ J,U        ;JOB TO BE HACKED IS SELF
        SETZM UUAC(U)   ;IF ERROR, RETURN LOSS IN .IOS+0
        JRST AUSET0

;                               ;IF N&200000=1, BLOCK MODE
;       .USET CH,[N,,LOC]       ;IF N&400000=0, READS USER VAR SPECIFIED BY REST OF N
                                ;       FOR INFERIOR OR FOREIGN USER OPEN ON CHANNEL CH
                                ;       INTO USER LOCATION LOC
                                ;IF N&400000.NE.0, SETS USER VAR SPECIFIED BY REST OF N
                                ;       FOR DIRECTLY INFERIOR USER OPEN ON CHANNEL CH
                                ;       FROM USER LOCATION LOC
AUSET:  MOVE J,R        ;DECODE AC FIELD AS CHANNEL NUMBER
        PUSHJ P,AUSETJ
         JRST IOCER7    ;USR OP CHNL DOES NOT HAVE USR OPEN
AUSET0: XCTR XR,[HRRZ B,(C)]    ;GET ADDRESS READING INTO OR WRITING FROM
        XCTR XR,[HLRZ E,(C)]    ;GET VARIABLE AND DIRECTION
        TRNE E,200000
         JRST ABUSET    ;BLOCK MODE
        TRZN E,400000
         JRST AUSET1    ;JUMP IF READING
        JUMPL J,IOCER7  ;WRITE PROTECT VIOLATION
        MOVSI W,(MOVEM D,)      ;FLAG WRITING
        UMOVE D,(B)     ;GET DATA TO WRITE
        PUSHJ P,NUSRV3  ;DO THE WRITE
         JRST ILUUO     ;LOST
        POPJ P,

;BLOCK-MODE .USET
ABUSET: TRNE E,400000
         TLOE J,(MOVE)  ;SET BLOCK BIT
          JRST ILUUO    ;BLOCK IN BLOCK LOSES
        UMOVE Q,(C)     ;GET AOBJN PTR AGAIN
ABUST2: UMOVEM Q,(C)    ;STORE AWAY UPDATED POINTER
        PUSH P,C
        PUSH P,J
        MOVE C,Q
        PUSHJ P,AUSET0
        POP P,J
        POP P,C
        UMOVE Q,(C)
        AOBJN Q,ABUST2
        POPJ P,

AUSET1: MOVEI W,0       ;FLAG READING
        XCTR XRW,[MOVES (B)]    ;ENSURE WRITEABILITY
        PUSH P,B
        PUSHJ P,NUSRV3  ;GET VALUE OF VARIABLE INTO A
         JRST ILUUO     ;LOST
        POP P,J
APTUAJ: UMOVEM A,(J)
        POPJ P,

;DECODE ARG FOR USET
AUSETJ: JSP T,NCRUI2
         JRST POPJ1
        JSP T,NCORWR
         TLO J,(SETZ)
        JRST POPJ1

AUSVAR: LDB C,USETRL+1  ;GET ADDRESS OF VARIABLE
        ADDI C,USRSTG(J)
        JUMPE W,[MOVE A,(C)
                 JRST POPJ1]
        HRR W,C
        XCT W
        JRST POPJ1

IFN PDP6P,[
PDPPMT: MOVEI A,%JSSIX#%JSNUM   ;PDP6 HAS ONLY A FEW VARIABLES, WHICH ARE READ-ONLY
        CAIN E,.RUIND
         JRST POPJ1
        MOVEI A,LPDP6M*2000     ;FIXED MEM BOUND FOR PDP-6
        CAIN E,.RMEMT
         JRST POPJ1
        JRST POPJ1              ;IGNORE OTHER VARIABLES
]
\f
;VARIABLES 100 - 577 (.IOC, .IOS, .IOP, .PMAP)
AUSET2: JUMPN W,OPNL31  ;JUMP IF TRYING TO WRITE
        SUBI E,100
        CAIL E,40
         JRST AUSET4    ;>140=>.RIOP+M
        TRZE E,20
         JRST AUSET3    ;117<E<140=>.RIOS+M
        ADDI E,IOCHNM(J)        ;77<E<120=>.RIOC+M
AUSETX: MOVE A,(E)      ;GET VAR
        JRST POPJ1

AUSET3: MOVE R,J        ;INFERIOR USER INDEX
        ADDI R,IOCHNM(E)        ;GET CHANNEL POINTER
        MOVE H,(R)
        JRST NSTATUS    ;DO A .CALL STATUS

AUSET4: CAIL E,40+LUIOP ;COMPARE AGAINST LAST IO PDL LOC
         JRST AUSET5    ;READ MAP ENTRY
        ADDI E,SIOCHN-40(J)     ;MAKE UP POINTER TO VAR
        JRST AUSETX

;USET VARIABLE 200+N  --  READ MAP VARIABLE FOR PAGE N.
; (0 <= N < 400)  E CONTAINS N+100.

;VALUE OF MAP WORD READ:

;4.9  -  PAGE WRITEABLE.
;4.8  -  PAGE EXISTS (IF THIS OFF, WHOLE WORD IS 0)
;4.7  -  PAGE IS IN CORE.
;4.6  -  PAGE IS PUBLIC (ANYONE CAN WRITE IT)

;3.1 - 3.9  -  # TIMES PAGE SHARED (LIKE CORTYP'S 4TH VALUE'S RH)
;2.1 - 2.9  -  ABS PAGE # OR PAGE # IN NEXT SHARER
;               (LIKE CORTYP'S 3RD VALUE)
;1.1 - 1.9  -  0 => ABS PAGE  (OR NO PAGE, OF COURSE)
;               -1 => UNSHARED PAGE,
;               ELSE USR NUM. OF NEXT SHARER.

AUSET5: CAIGE E,100
         JRST OPNL11
        PUSHJ P,SWTL
            CIRPSW      ;DON'T LET PAGE TABLES CHANGE.
        MOVEI A,-100(E) ;PAGE NUMBER IN JOB.
        PUSH P,J
        PUSHJ P,NCORT0  ;PUT CORTYP'S VALUES IN A THRU D.
        POP P,J
        PUSHJ P,LSWPOP  ;FREE CIRPSW.
        ANDI B,777      ;CORTYP'S 2ND VALUE IN 1.1 - 1.9
        DPB C,[111100,,B]       ;3RD VALUE IN 2.1 - 2.9
        TLO B,(D)       ;4TH VALUE RH INTO 3.1-3.9
        LSH D,-20.
        TLO B,(D)       ;4TH VAL BITS 4.8-4.9 INTO 4.6-4.7
        IOR A,B         ;TOGETHER WITH 1ST VALUE'S 4.8, 4.9.
        JRST POPJ1
\f
USTOP:  AOS (P)         ;GOING TO WIN
        JUMPN D,1USTOP  ;NONZERO VALUE => STOP THE JOB.
        MOVE B,APRC(A)  ;ZERO => START.
        TLNE B,BULGOS   ;BUT DON'T EVER START A JOB THAT'S BEING KILLED.
         POPJ P,
        JRST 1USTRT

1USTOP: MOVNI D,1       ;SET TO STOP
1USTRT: PUSHJ P,RPCLSR  ;STOP USER IN A
        DPB D,[.BP BUSRC_22,USTP(A)]    ;BUSRC
IFN SWPWSP,[
        EXCH U,A
        PUSHJ P,LVLOAD
        EXCH U,A
];SWPWSP
        JRST UPCLSR

;SET INFERIOR'S PC
UPCSET: PUSHJ P,RPCLSR  ;STOP USER IN USER MODE
        TLO D,%PCUSR    ;BE SURE USER MODE IS ON IN NEW PC
        TLZ D,BADPC     ;BE SURE PRIVILEGED BITS ARE OFF
        SKIPGE IOTLSR(A) ;SKIP UNLESS USER IS SUPPOSED TO BE IN IOT-USER MODE
         TLO D,%PCUIO   ;TURN ON IOT-USER MODE
        MOVEM D,UPC(A)  ;SET PC
        PUSHJ P,UPCLSR  ;RESTART
        JRST POPJ1

UJPCS:  CAIN U,(A)      ;SET .JPC, WITH CARE IF SETTING OWN
         SPM UPGML(U)
        HRRM D,UPJPC(A)
        CAIN U,(A)
         LPMR UPGML(U)
        JRST POPJ1

UJPCR:  CAIN U,(A)      ;READ .JPC:
         SPM UPGML(U)   ;IF READING ONE'S OWN, MAKE SURE IT'S UP TO DATE.
        HRRZ A,UPJPC(A)
        JRST POPJ1

IFN KA10P,[
UROPC:  HLLZ A,UPOPC(J)
        LSH A,5
        HRR A,UPOPC(J)
        JRST POPJ1
] ;KA10P
IFE KA10P, UROPC: JRST OPNL12   ;.OPC NOT SUPPORTED ON KL AND KS  ((CAN'T
                                ; USE == DUE TO FWD REF))

IFN N11TYS,[                    ;SET OWN TV CONSOLE REGISTER
STVCRG: MOVEM D,TVCREG(U)       ;ENABLE TVCREG TO BE SWAPPED IN AND OUT OF HARDWARE
        JUMPL D,POPJ1           ;IF TURNING ON; OR, IF TURNING OFF, ALL DONE
        SKIPGE TT11P            ;ALLOWED TO TOUCH HARDWARE?
         SKIPE TEN11F
          CAIA
           MOVEM D,400000+TTR10*2000 ;UPDATE REG IN HARDWARE
        MOVEM D,TVCREG(U)       ;AND UPDATE AGAIN IN SOFTWARE IN CASE CLOBBERED AT SSTVR2
        JRST POPJ1
]
\f
IFE KS10P,[     ; KS10 doesn't have a MAR and it never will...

;READ MAR
URMAR:  MOVE A,UPMAR(J)
IFN KA10P,      TLZ A,777770
IFN KL10P,      LDB B,[270400,,A]
IFN KL10P,      HRL A,MARPTB(B)
        JRST POPJ1

;SET MAR
USMAR:  CONO PI,CLKOFF  ;TURN OFF CLOCK INTERRUPTS
        CAMN J,USER
         SPM UPGML(J)   ;STORE PG VARIABLES IF HACKING CURRENT USER
IFN KA10P,[
        TLZ D,777770
        TLO D,4         ;SET USER MODE
] ;KA10P
IFN KL10P,[
        LDB B,[220400,,D]
        HLL D,MARPTB(B)
] ;KL10P
        MOVEM D,UPMAR(J)
        CAMN J,USER
         LPMR UPGML(J)  ;USE LPMR BECAUSE KL10 DOESN'T HAVE VANILLA LPM
        JRST CLKOJ1

IFN KL10P,[     ;MAR PERMUTATION TABLE.  MAYBE CAN DO BETTER????   *****

MARPTB: 0  1,  0        ;OFF            ;NONE (EXEC)
        0 11,  0        ;FETCH          ;NONE (USER)
        0  3,  2        ;WRITE          ;WRITE(EXEC)
        0 17,  6        ;ANY            ;WRITE (USER)
        0  1, 10        ;OFF            ;READ (EXEC)
        0 11, 14        ;FETCH          ;READ (USER)
        0  3, 12        ;WRITE          ;NOT FETCH (EXEC)
        0 17, 16        ;ANY            ;NOT FETCH (USER)
        0  5,  1        ;READ           ;FETCH (EXEC)
        0 15,  5        ;READ+FETCH     ;FETCH (USER)
        0  7, 13        ;NOT FETCH      ;NOT READ (EXEC)
        0 13, 17        ;NOT READ       ;NOT READ (USER)
        0  5, 11        ;READ           ;READ+FETCH (EXEC)
        0 15, 15        ;READ+FETCH     ;READ+FETCH (USER)
        0  7,  3        ;NOT FETCH      ;ANY (EXEC)
        0 13,  7        ;NOT READ       ;ANY (USER)
] ;KL10P
] ;IFE KS10P

IFN KS10P,[
URMAR:
USMAR:  JRST OPNL12
] ;KS10P
\f
RUSUPP: HRRE A,SUPPRO(J) ;READ SUPERIOR'S USER INDEX
        JUMPL A,POPJ1   ;-1 => TOP LEVEL
UINDEX: IDIVI A,LUBLK   ;GET INDEX NUMBER
        JRST POPJ1      ;GIVE TO USER

;READ OWN RUN TIME
UTRNTR: CONO PI,CLKOFF
IFN KA10P,[
        SPM UPGML(U)
        LDB A,[2300,,UPQUAN(U)]
        LSH A,-2        ;SIMULATE 4.069 USEC CLOCK
] ;KA10P
IFN KL10P,[
        SKIPL MTRUSR    ;SKIP IF PERFORMANCE METER AVAILABLE
         JRST [ RMBOXC A        ;REQUIRES AC ORDER - A,B,C,D,E
                DSUB A,STMBOX
                DMUL A,KLMBCC   ;BECAUSE DMUL PRODUCES FOUR WORD RESULT
                REBOXC D
                DSUB D,STEBOX
                DADD B,D
                DMUL B,KLEBCC
                MOVE A,D
                JRST UTRNT1 ]
        RPERFC A
        DSUB A,STPERF
        DIVI A,50.*4096.
UTRNT1:
] ;KL10P
IFN KS10P,[
        SPM UPGML(U)
        LDB A,[400400,,UPQUAN(U)]       ; 3.9 USEC CLOCK
] ;KS10P
        ADD A,UTRNTM(U)
        JRST CLKOJ1

;SET JOB'S TTYTBL (.TTY VARIABLE).
USTTY:  CONO PI,CLKOFF          ;PREVENT TIMING ERROR.
        HLLZ E,TTYTBL(J)        ;GET CURRENT VALUE
        XOR E,D                 ;GET WHICH BITS USER WANTS TO CHANGE
        AND E,[%TBNVR+%TBINT+%TBWAT+%TBOUT+%TBINF+%TBIIN+%TBOIG,,]      ;GET BITS USER IS ALLOWED TO CHANGE
        TRNE I,1
         TLZ E,%TBWAT           ;THESE BITS CAN BE ALTERED ONLY BY THE SUPERIOR
        XORM E,TTYTBL(J)        ;ALTER THE USER-CONTROLLED BITS WITHOUT WRITING THE OTHERS.
        JRST CLKOJ1

;READ JOB'S TTYTBL (.TTY) VARIABLE
URTTY:  CONO PI,CLKOFF
        HRRZ A,TTYTBL(J)
        SKIPGE TTYTBL(J)
         IDIVI A,LUBLK
        HLL A,TTYTBL(J)
        JRST CLKOJ1

;READ JOB'S .CNSL VARIABLE - TTY# OF TREE'S CONSOLE
URCNSL: MOVE A,UTMPTR(J)
        SUBI A,USRRCE
        CAIL A,NCT
         SUBI A,NCT+2           ;DISOWNED -1 SYS -2
        JRST POPJ1
\f
UJNAME: JUMPE D,OPNL33  ;SET INFERIOR'S JNAME
        CAME D,[SIXBIT/PDP6/]
         CAMN D,[SIXBIT/PDP10/]
          JRST OPNL33   ;CHANGING TO ILLEGAL NAME
        CAIN I,3        ;.SUSET?
         JRST UJNAMS    ;YES...
        PUSHJ P,RPCLSR
        PUSHJ P,UJNAMU  ;IS NEW JNAME UNIQUE?
         JRST UJNAMG    ;NO
        MOVEM D,JNAME(A)        ;YES
        CONO PI,CLKON
        PUSHJ P,UPCLSR
        JRST POPJ1

UJNAMU: MOVE B,UNAME(A)
        MOVEI E,0
        CONO PI,CLKOFF
UJNAM1: CAME B,UNAME(E)
         JRST UJNAMF
        CAMN D,JNAME(E)
         POPJ P,
UJNAMF: ADDI E,LUBLK
        CAMGE E,USRHI
         JRST UJNAM1
        JRST POPJ1

UJNAMG: PUSHJ P,UPCLSR
        CAME A,E
         JRST OPNL13            ;DUPLICATE NAME
        JRST CLKOJ1             ;WASN'T REALLY CHANGING THE NAME

UUNAME: HLRE I,D                ;SET OWN UNAME
        AOJE I,OPNL33           ;CHECK FOR ILLEGAL ___nnn UNAME
        SKIPA I,U
UJNAMS:  SETO I,                ;SET OWN JNAME
        JUMPE D,OPNL33          ;CHECK FOR EVIL NAMES
        CAME A,U                ;SELF?
         BUG                    ;SOMETHING SCREWED
        SKIPL SUPPRO(U)
         JRST OPNL40            ;MUST BE TOP LEVEL
        CONO PI,CLKOFF          ;TURN CLOCK OFF NOW SO WE DON'T GET REOWNED OR SOMETHING
        SKIPL I
         SKIPA C,JNAME(U)       ;CHANGING UNAME, KEEPING JNAME
          SKIPA C,UNAME(U)      ;VICE VERSA
           EXCH D,C             ;NOW C=UNAME, D=JNAME
        MOVEI E,0               ;CHECK FOR DUPLICATE NAMES
UUNAM0: SKIPE UNAME(E)
         CAMN E,U               ;ALLOW SETTING TO SAME NAME AS BEFORE
          JRST UUNAM1
        HRRZ A,SUPPRO(E)
        CAMN C,UNAME(E)
        CAME D,JNAME(E)
         CAMN A,I               ;JOB CAN'T HAVE INFERIORS IF SETTING UNAME
          JRST OPNL13           ;OR DUPLICATE U-JNAME IF SETTING EITHER
UUNAM1: ADDI E,LUBLK
        CAMGE E,USRHI
         JRST UUNAM0
        CAMN C,UNAME(U)
         CAME D,JNAME(U)
          SKIPA A,D             ;D GETS CLOBBERED
           JRST CLKOJ1          ;THE NAMES WEREN'T ACTUALLY CHANGED! (SYNCOM DOES IT).
        CAME C,UNAME(U)         ;IF NOT LOGGED IN, AND CHANGING UNAME,
         SKIPGE TTYTBL(U)       ; AND CONSOLE-CONTROLLED,
           JRST UUNAM3
        HLLO J,UNAME(U)
        AOJN J,UUNAM2
          AOS SUSRS             ;DISGUST! SHOULD BE USING LOGIN
UUNAM2: HRRZ T,TTYTBL(U)
        HRLI T,[ASCIZ / CHUNAM /]
        PUSHJ P,SGWAIT          ;REQUEST SYSTEM JOB TO PRINT OUR MSG
        MOVEM C,SLGIV+2         ;INCLUDE NEW UNAME AS SECOND NAME
UUNAM3: PUSHJ P,LOGUPD          ;CHARGE OLD NAME FOR USAGE SO FAR
        MOVEM C,UNAME(U)        ;THEN SWITCH NAMES
        MOVEM A,JNAME(U)
        PUSHJ P,DMNPLI          ;LOG BACK IN UNDER NEW NAMES
        JRST CLKOJ1

;WAIT FOR SLGIV VARIABLES TO BECOME FREE, AND REQUEST THE
;SYSTEM JOB TO PROCESS THEM.  TAKES STRING,,TTY IN T, AND
;PLACES UNAME(U) IN SLGIV, AND T INTO SLGIV+1.  THE CALLER
;IS RESPONSIBLE FOR FILLING IN SLGIV+2

SGWAIT: PUSH P,T
        MOVSI T,SCLLGI          ;SOMEBODY ELSE IS USING THOSE VARIABLES
        PUSHJ P,CWAIT           ;WAIT FOR THE SYSTEM JOB TO FINISH WITH
          TDNE T,SUPCOR         ;THEM.
        IORM T,SUPCOR           ;REQUEST THE SYSTEM JOB TO PRINT OUR MSG
        POP P,SLGIV+1           ;STRING,,TTY #
        MOVE T,UNAME(U)         ;STORE AWAY THE UNAME
        MOVEM T,SLGIV
        POPJ P,

RUTRAP: LDB A,[430100,,UTRAPM(J)]       ;GET SPECIAL TRAP MODE INDICATOR
        JRST POPJ1

SUTRAP: DPB D,[430100,,UTRAPM(J)]       ;SET    "     "    "       "
        JRST POPJ1

IFN KA10P,[
URTR1I: SKIPA A,[0,,%PIARO]     ;READ "TRAP 1 INSTRUCTION" FOR KA-10
URTR2I:  MOVEI A,%PIPDL         ;TRAP 2
        JRST POPJ1
] ;KA10P
\f
;SET MEMORY BOUND
USMEMT: CAMN U,A
         JRST USMEM2
        PUSHJ P,RPCLSR
        MOVSI B,BSSTP
        IORM B,USTP(A)
        PUSHJ P,UPCLSR
USMEM2: ADDI D,1777
        LSH D,-10.
        MOVE B,D
        MOVEM A,SRN5(U) ;ARGUMENT TO NCORFS
        PUSHJ P,LOSSET
            NCORFS      ;CLEARS BSSTP IN USTP(A).
        EXCH U,A
        PUSHJ P,ACORE
         JRST OPNL33    ;LOST
        EXCH U,A
        JRST LSWPJ1

;SET SYSTEM NAME (ZERO IGNORED)
USYNST: SKIPE D
         MOVEM D,USYSNM(J)
        JRST POPJ1

;SET INFERIOR'S INTERRUPT MASK
USMASK: SKIPA E,[2]     ;MOVEM
IAMASK:  ANDI E,1       ;ANDCAM OR IORM
        ANDCM D,[VBDBTS] ;BITS FOR CLASS 1 INTS CAN'T BE CHANGED.
        XCT (E)[ IORB D,MSKST(A)
                 ANDCAB D,MSKST(A)
                 MOVEM D,MSKST(A)]
IFN KA10P,[
        MOVEI B,440+APRCHN ;NOW UPDATE JOB'S APRC VARIABLE.
        TRNE D,%PIARO
         TRC B,60
        TLNE D,(%PIFOV)
         TRC B,600
        HRRM B,APRC(A)
        TRNE I,1
         CONO @APRC(A)
] ;KA10P
IFE KA10P, PUSHJ P,TRINST
        JRST UPISE1

IFE KA10P,[
;SET THE AROV AND PDLOV TRAP INSNS ACCORDING TO WHETHER THE
;INTERRUPTS ARE ENABLED; BUT DON'T OVERRIDE AN EXPLICIT SPECIFICATION
;BY THE USER, WHICH IS ANYTHING OTHER THAN 0 OR (CAI) IN THE LH.

TRINST: MOVE D,MSKST(A)
        MOVSI B,(CAI)           ;CAI IS FASTER THAN JFCL - NO AC DECODE
        TDNE D,[%PIFOV+%PIARO]  ;AND OVERFLOW GOES OFF A LOT
         MOVEI B,%PIARO
        HLRZ C,TR1INS(A)
        SKIPE C
         CAIN C,(CAI)
           MOVEM B,TR1INS(A)
;       MOVSI B,(CAI)           ;THESE LINES COMMENTED OUT TO MAKE 
;       TRNE D,%PIPDL           ; PDL OVERFLOW CLASS 2 INSTEAD OF CLASS 3
         MOVEI B,%PIPDL
        HLRZ C,TR2INS(A)
        SKIPE C
         CAIN C,(CAI)
          MOVEM B,TR2INS(A)
        POPJ P,
] ;IFE KA10P
\f
;SET INFERIOR'S PI IN PROGRESS FLAG
UPISET: ASH D,-35.      ;SHIFT SIGN BIT TO BOTTOM BIT
        MOVEM D,PICLR(A)        ;SET VARIABLE
;COME HERE WHEN ANY INTERRUPT VARIABLE'S VALUE IS CHANGED
;BY A .USET OR .SUSET; TAKE ANY INTS THAT ARE NOW PENDING.
UPISE1: HRRZ A,J        ;IAMASK, ETC. MODIFY A. RESTORE IT.
        AOS (P)         ;GOING TO WIN
        TRNN I,1        ;SKIP IF A SUSET
         JRST APISE6
        JRST APISE1     ;SEE IF SHOULD REINTERRUPT

IAMSK2: ADDI A,MSKST2-IDF1
IADF1:  ADDI A,IDF1-IDF2
IADF2:  ADDI A,IDF2-PIRQC       ;IORM OR ANDCAM INTO IDF2.
IAPIRQ: ADDI A,PIRQC-IFPIR
IAIFPI: ANDI E,1        ;GET USET PARITY (0=IORM, 1=ANDCAM)
        XCT IAINS(E)    ;DO APPRO OP
        JRST UPISE1

IAINS:  IORB D,IFPIR(A) ;SET BITS
        ANDCAB D,IFPIR(A)       ;FLUSH BITS

USMSK2: ADDI A,MSKST2-IDF1      ;SET .MSK2, ETC.
USDF1:  ADDI A,IDF1-IDF2
USDF2:  ADDI A,IDF2-PIRQC
USPIRQ: ADDI A,PIRQC-IFPIR
USIFPI: MOVEM D,IFPIR(A)
        JRST UPISE1

;.RBCHN, .SBCHN  READ/SET NUMBER OF LAST CHANNEL ON WHICH ERROR OCCURRED
RUBCHN: LDB A,[BCHPTR#(A#U)]
        JRST POPJ1

SUBCHN: DPB D,[BCHPTR#(A#U)]
        JRST POPJ1

;GET INT BIT
UGSUPR: HLLZ A,SUPPRO(J)
        JRST POPJ1

;SAVE AWAY MA (HIGH BITS) ON LAST MPV OR WIRO
;CALLED FROM CLKBRK, DONT CLOBBER A OR D

MPVMAS:
IFN KA10P,[
        HLRZ T,UPJPC(U)
        LSH T,10.               ;HIGH BITS ONLY ON KA
] ;KA10P
IFE KA10P, HRRZ T,UPFW(U)
        HRRM T,IOTLSR(U)
        POPJ P,

;.RMPVA READ VIRTURAL PAGE # (8 BITS) OF LAST MPV OR WIRO

MPVARD: HRRZ A,IOTLSR(J)
        JRST POPJ1

;.RSERVER  Read server user number, or -1 if none.
URSERV: SKIPL A,SERVER(J)
         IDIVI A,LUBLK
        JRST POPJ1

;.SSERVER  Set server user number, or clear if negative.
; (To prevent timing screws, you should really use the SSERVE call to set
; this variable, but for debugging convenience...)
USSERV: IMULI D,LUBLK
        SKIPGE D
         SETOI D,
        MOVEM D,SERVER(J)
        JRST POPJ1
\f
SUBTTL USER INSTRUCTION HANG ROUTINE (.HANG)

; .HANG was rewritten by Alan Feb 87:
; 
; The general theory is that .HANG should behave -exactly- like JRST .-1 as
; much as possible.  Thus, it is considered to make sense to put any
; skipping or jumping instruction before a .HANG.  We are always careful to
; return from the .HANG by jumping to the previous instruction, so any side
; effects (such as clearing bits or incrementing accumulators or memory) are
; always performed, and jumps will be correctly taken.
;
; There are two ways to leave a .HANG, either the job can get PCLSR'ed, or
; the awaited condition can become true.  We arrange for -both- cases to
; return the job to the previous instruction by SOSing UUOH -once- before
; calling UFLS, and once more if UFLS returns.
; 
; As an additional feature, .HANG with a non-zero accumulator behaves like
; the disjunction of ordinary .HANG and .SLEEP, allowing the user to do a
; timeout.  The accumulator should initially contain an argument, as for
; .SLEEP, that indicates when .HANG should timeout.  In that case only,
; .HANG returns to the following instruction and the designated accumulator
; will contain zero.  If such a .HANG is interrupted, or if it returns
; because the awaited condition is now true, that accumulator will contain
; the correct negative number indicating the absolute time it would have
; timed out.
;
; Accepted instructions are:
; Any CAI, CAM, JUMP, SKIP, AOJ, AOS, SOJ, or SOS class instruction.
; Any test instruction.
; JFFO.
; JFCL with 0 in the AC field.
; Or an XCT that eventually fetches one of the above.
; 
; As special cases SKIPA 0, and CAIA 0, are taken to request a schedule,
; and JFCL 0, and SKIP 0, set %SWDSO.
; 
; As before, it is a limitation that changes to memory referenced by .HANG
; when computing effective addresses and fetching XCT'ed instructions will
; not cause the job to wake up.  But how could it be otherwise?  Changes to
; the accumulators will of course cause the job to be PCLSR'ed.

AHANG:  MOVE R,UUOH
        UMOVE R,-2(R)           ; Get user's flush instruction
        HRLOI A,377777          ; A: most positive fixnum
        JUMPE J,AHANG2          ; No AC => timeout when hell freezes over
        XCTR XR,[MOVN A,(J)]    ; A: argument as for .SLEEP
        JUMPG A,AHANG2          ; 'twas already neg., so wait 'til then
        SUB A,TIME              ; else compute time
        UMOVEM A,(J)            ; store back negative for PCLSRing
        MOVN A,A                ; A: time to wait for
AHANG2: PUSHJ P,ASCIND          ; Compute E for instruction
        HLRZ C,R                ; C: Opcode and AC
        CAIE C,(JFCL)
         CAIN C,(SKIP)
          JRST AHANGI           ; User might be waiting for a while
        CAIE C,(SKIPA)
         CAIN C,(CAIA)
          JRST AHANGF           ; User is just trying to cause a schedule
        LSH C,-9                ; C: 9-bit opcode
        CAIN C,XCT_-33
         JRST AHANG1            ; XCT - Go loop
        CAIN C,JFFO_-33
         JRST AHANGO            ; JFFO is like JUMPN
        LSH C,-6                ; C: First 3 bits of opcode
        CAIN C,CAI_-41
         JRST AHANGC            ; CAI, CAM, JUMP, SKIP, AOJ, SOJ, AOS, SOS
        CAIN C,TRN_-41
         JRST AHANGT            ; Txxx
IFN KS10P, JRST ILUUO
IFE KS10P,[
;CODE TO ALLOW CONSO, CONSZ AS .HANG INSTRUCTIONS
        HLRZ C,R                ;CHECK FOR CONSO, CONSZ
        TRZ C,077477
        LDB B,[320700,,R]       ;GET DEVICE CODE/4
        SKIPGE T,DCHNTB(B)
         TRNE T,40000
          CAIE C,(CONSZ\CONSO)
           JRST ILUUO           ;UNRECOGNIZED INSTRUCTION, OR USER CONI NOT
                                ; ALLOWED
        MOVEM R,EPDL(U)
        MOVE T,A
        SOS UUOH
        PUSHJ P,AHANG9
         PUSHJ P,UFLS
        JRST AHANGX

AHANG9: XCT EPDL(U)
         CAMGE T,TIME
          AOS (P)
           POPJ P,

] ;IFE KS10P

; XCT ? .HANG
AHANG1: PUSHJ P,OPBRK           ; Don't let "XCT ." hang you up
        UMOVE R,(R)             ; Get new instruction
        JRST AHANG2             ; And start over

; CAI, CAM, JUMP, SKIP, AOJ, SOJ, AOS, SOS ? .HANG
AHANGC: TLNN R,040000
         JRST AHANG3            ; CAI, CAM, JUMP, SKIP
        TLNN R,010000
         JRST AHANGJ            ; AOJ, SOJ
        TLNN R,020000
         SKIPA T,[-1]           ; AOS: Compare with -1
          MOVEI T,1             ; SOS: Compare with 1
        TLZ R,770777            ; Clear all but last 3 bits of opcode
        TLO R,(CAM T,)          ; Build a CAM instruction
        TLNE R,001000           ; With the opposite sense
         TLC R,006000
        JRST AHANGM

AHANG3: TLNN R,020000
         JRST AHANG4            ; CAI, CAM
        TLNN R,010000
         JRST AHANGJ            ; JUMP
        TLZ R,(0 17,)           ; SKIP
        JRST AHANGM

; JFFO ? .HANG
AHANGO: TLC R,(JFFO#JUMPN)
AHANGJ: HRRI R,AHANGX
        JRST AHANGA

; SKIPA ? .HANG -- just flush once (ignores timeout)
AHANGF: SOSA UUOH
         SKIPA
          PUSHJ P,UFLS
        JRST AHANGX

; JFCL ? .HANG -- hang infinitely (or until timeout)
AHANGI: MOVE B,TIME
        ADDI B,60.*30.          ; If sleeping for more than a minute
        MOVSI C,%SWDSO          ; Desire swap out
        CAML A,B                ; (just like .SLEEP)
         IORM C,USWST(U)
        SOS UUOH
AHANG5: MOVE T,A
        CAML T,TIME
         PUSHJ P,UFLS
        JRST AHANGX

; Txxx ? .HANG
AHANGT: TLZ R,060000            ; Make opcode be TRN or TDN series
        TLNE R,010000           ; If TRN, only AC matters
         JRST AHANGB            ; TDN: Both AC and memory matter
; Wait for something that only references the user's accumulators.
; (Instruction in R might be some kind of jump to AHANGX.)
AHANGA: PUSHJ P,AHANGG          ; Get contents of user's AC into T
        SOS UUOH
        XCT R                   ; Must try it once to prevent timing screw
         JRST AHANG5            ; OK, wait forever for PCLSR
        JRST AHANGX

AHANG4: TLNN R,010000           ; If CAM, both AC and memory matter
         JRST AHANGA            ; CAI: Only AC matters
; Wait for something that references memory.
; (Instruction in R better not be a jump!)
AHANGB: PUSHJ P,AHANGG          ; Get contents of user's AC into T
AHANGM: MOVEM R,EPDL(U)
        SOS UUOH
        TRNE R,-20              ; Memory reference really only AC?
         JRST AHANG6            ; No, real memory, go wait
        XCTR XRW,R              ; Must try it once to prevent timing screw
         JRST AHANG5            ; OK, wait forever for PCLSR
        JRST AHANGX

        PUSHJ P,UHANG
AHANG6:  PUSHJ P,UFLS
AHANGX: ;; Everyone exits here after SOSing UUOH once (before hanging).
        ;; Thus we always exit to the previous instruction (just like being
        ;; PCLSRed), unless we timeout instead.
        CAMGE A,TIME            ; Timeout?
         JRST AHANGY            ; Yes
        SOS UUOH
        POPJ P,

AHANGY: XCTR XW,[SETZM (J)]     ; Let user know we timed out
        AOS UUOH                ; And fall through instead of backing out
        POPJ P,

;.HANG flush instruction routine, called with PUSHJ only on clock level
UHANG:
IFE KS10P,[
        MOVEI TT,0              ; Save MAR word
        EXCH TT,UPMAR(U)        ; so will not MAR
        LPMR UPGML(U)
        MOVEM TT,UPMAR(U)       ; Restore MAR
] ;IFE KS10P
IFN KS10P, LPMR UPGML(U)
        MOVE TT,AC0S+A(U)
        XCTRI XRW,EPDL(U)
         CAMGE TT,TIME
          AOS (P)               ; Might be because location swapped out or
           POPJ P,              ; missing, but that's OK because we always
                                ; exit to the previous instruction!

; Kind of like ASCIND for the accumulators...
AHANGG: LDB T,[270400,,R]
        UMOVE T,(T)             ; Get contents of AC from user
        TLZ R,(0 17,)           ; Clear out AC field in instruction
        TLO R,(0 T,)            ; Replace AC field with T
        POPJ P,

; Allow interrupt if being PCLSRed
OPBRK:  PUSH P,T
        MOVE T,UEXIT
        CAMN T,[JRST ONEFLS]
         PUSHJ P,UDELAY
        POP P,T
        POPJ P,
\f
SUBTTL .OPEN AND FRIENDS

;
;.FDELE FILBLK  ;DELETE OR RENAME FILE SPECIFIED AT FILBLK
;
AFDELE: SETZM UUAC(U)
        UMOVE A,(C)             ;GET DEVICE
        MOVEI W,4
        DPB W,[OPNCOM,,A]       ;SET OP TO SPECIFY AN .FDELE
        JRST AFDEL1
;
;OPEN SET UP AND DISPATCH
;3.1=0 => INPUT  =1 OUTPUT
;3.2=0  => UNITS   =1  BLOCK
;3.3=0  => ASCII   =1 IMAGE
;4.9-4.7 OPERATION FIELD
;   0=> NORMAL READ OR WRITE
;   1=> WRITE OVER MODE
;   2=> MAKE LINK
;   4=> DELETE OR RENAME (INTERNAL)
;
;.OPEN CH,FILBLK        ;OPEN FILE SPECIFIED AT FILBLK ON LOGICAL CHANNEL CH
;
AOPEN:          ;C HAS EFF ADR OF UUO AND R ITS AC FIELD
        ADDI R,IOCHNM(U)        ;MAKE R POINT TO SPECIFIED I/O CHANNEL WORD
        PUSH P,C
        PUSHJ P,ACLOSE  ;CLOSE PREV
        POP P,C
        UMOVE A,(C)     ;GET DEV AND MODE BITS
        LDB W,[OPNCOM,,A]
        CAIN W,4
         JRST OPNL23    ;BARF IF TRY TO DELETE WITH .OPEN
AFDEL1: MOVEI TT,SRN3(U)        ;MOVE 4TH-6HT ARGS
        HRLI TT,3(C)            ;TO SRN3 THRU SRN5
        MOVEI Q,3(TT)
        XCTR XBR,[BLT TT,-1(Q)]
        UMOVE B,1(C)    ;GET 2ND, 3RG ARGS (FILENAMES)
        UMOVE C,2(C)
        MOVE D,USYSNM(U)        ;USE DEFAULT SNAME.
        HLRZ E,A                ;GET MODE BITS.
        HRLZI A,(A)     ;LEFT-JUSTIFY DEVICE NAME.
        SETZM EPDL(U)
        SETZM EPDL3(U)
NOPNE:  CAIN W,4        ;SKIP ON NOT .FDELE (ENTRY FOR NCALL TYPE OPEN, ETC COMMANDS)
         SKIPN SRN3(U)  ;SKIP ON RENAME
          JRST AOPEN3   ;JUMP IF A .OPEN OR DELETING .FDELE
        JUMPN B,AOPEN3  ;JUMP UNLESS RENAME WHILE OPEN.
        MOVE TT,C       ;GET CH ON WHICH FILE IS SUPPOSIDLY OPEN
        TDNE TT,[-NIOCHN]       ;SKIP IF CH LOGICALLY LESS THAN 20
         JRST OPNL14    ;BAD CHANNEL NUM
        ADDI TT,IOCHNM(U)       ;RELOCATE TO POINT TO CH WORD FOR USER
        MOVE Q,(TT)     ;GET CH WORD
        JUMPE Q,OPNL44  ;CHNL NOT OPEN
        HLRZ Q,CLSTB(Q) ;GET LEFT HALF OF CLOSE TABLE ENTRY FOR INDEX IN I/O CH WORD
        TRNE Q,%CLSJI\%CLSJO
         JRST JFDEL4            ;JOB DEVICE CHNL
        TRNN Q,%CLSDO\%CLSQ     ;SKIP IF A DIRECTORY DEVICE
         JRST POPJ1     ;JUMP IF NOT DIRECTORY DEVICE
        HLRZ J,(TT)     ;PICK UP DEV CHNL NO
        EXCH A,B        ;PUT FN1, FN2 IN A, B.
        EXCH B,C
IFN NUNITS,[
        TRNN Q,%CLSDO   ;SKIP IF DEC TAPE
         JRST NOPNE1
        MOVSI C,'UT0    ;GET DUMMY UT DEV NAME.
        HRRZ I,UTTNO(J) ;GET POSSIBLE (?) TAPE NUM
        TLO C,(I)       ;STORE IN DEV NAME
        MOVE TT,DVAUT   ;WILL EXIT TO UTAPE OPEN RTN.
        JRST OPEN2B
NOPNE1:
]
        MOVSI C,'DSK    ;NOT UT, MUST BE DSK.
        MOVE TT,DVAQSK  ;NOBODY ELSE HANDLES RENAME WHILE OPEN.
        JRST OPEN2B
\f
AOPEN3: PUSHJ P,TRAN    ;PERFORM I/O TRANSLATIONS
         JRST OPNL3     ;TOO MANY TRANSLATIONS.
        MOVEM D,USYSN1(U);SAVE TRAN'D SNAME FOR OPEN RTN.
        PUSH P,A        ;PUT NAMES ON STACK.
        PUSH P,B
        PUSH P,C
        MOVSI B,-NDEVS  ;LOAD LENGTH OF FIRST DEV NAME TABLE
        CAME A,DEVTAB(B);SEARCH FIRST DEV NAME TABLE
         AOBJN B,.-1    ;LOOP TILL FOUND OR COUNTED OUT
        JUMPG B,OPEN1   ;JUMP IF NOT FOUND
OPEN2:  MOVE TT,DEVADR(B) ;LOAD BITS,,OPEN-ROUTINE-ADDRESS
OPEN21: POP P,B         ;UNSAVE SECOND FILE NAME
        POP P,A         ;UNSAVE FIRST FILE NAME
        POP P,C         ;UNSAVE DEVICE NAME
        CAIN W,4
         JRST [ TLNN TT,%DVDEL
                 JRST OPNL34    ;DEVICE DOES NOT ALLOW DELETE
                JRST OPEN2B ]
        CAIN W,2
         JRST [ TLNN TT,%DVLNK
                 JRST OPNL34    ;DEVICE DOES NOT ALLOW LINK
                JRST OPEN2B ]
OPEN2B: HRRZ D,E        ;MODE BITS
        EXCH E,C        ;SAVE DEVICE IN E
        HLL C,E         ;SET UP OLD-STYLE C: MODE,,DEV
        MOVSS C
;
;AT THIS POINT: A & B HAVE FILE NAMES, C HAS MAPPED DEV AND MODE BITS, D HAS MODE BITS,
;W HAS OPEN COMMAND, E HAS DEVICE NAME, TT HAS DEVADR WORD (BITS,,ROUTINE)
;
        ROT D,-1        ;ROTATE IN/OUT BIT TO SIGN
        CAIN W,4        ;SKIP IF NOT A .FDELE
         TDZ D,[400000,,7]      ;A .FDELE, MAKE LOOK LIKE OPEN FOR READ
        PUSHJ P,FLDRCK
         JRST OPEN2D    ;NORMAL OPEN
        JUMPL D,OPNL2   ;WRITING DIRECTORY?
        JUMPN W,OPNL12  ;DELETING, RENAMING, LINKING, WRITING OVER DIRECTORY?
        TLNE TT,%DVDIR
         JRST (TT)      ;OPEN DEVICE FOR DIRECTORY
;ASKING FOR DIR OF DEVICE SYSTEM DOESN'T HAVE DIR ROUTINE FOR.
;PASS IT OFF TO THE UNKNOWN-DEVICE HANDLER.
        PUSH P,E        ;PUSH DEVICE NAME
        PUSH P,A        ;PUSH FN1
        PUSH P,B        ;PUSH FN2
        HLRZ E,C        ;GET MODE BITS
        JRST OPEN22     ;PASS TO UNKNOWN DEVICE JOB

OPEN2D: TLNE TT,%DVIN
         JUMPGE D,(TT)  ;OPENING FOR INPUT AND DEVICE CAN DO INPUT
        TLNE TT,%DVOUT
         JUMPL D,(TT)   ;OPENING FOR OUTPUT AND DEVICE CAN DO OUTPUT
        JRST OPNL2      ;DEVICE DOESN'T GO THAT DIRECTION
\f
;CHECK FOR NUMBERED DEV
OPEN1:  MOVE B,[-NDV1,,DVT1-DEVTAB]     ;LOAD AOBJN POINTER WITH COUNT FOR 2ND DEV TABLE
OPEN1A: MOVEI I,0               ;INITIALIZE NUMBERED DEV NUM TO ZERO
        MOVE D,[440600,,-2(P)]  ;GET BYTE POINTER INTO DEV REQUESTED
        MOVE C,[440600,,DEVTAB(B)]      ;GET BYTE POINTER INTO CURRENT TABLE ENTRY
OPENA1: ILDB A,C        ;GET CHAR FROM TABLE
        ILDB J,D        ;GET CHAR FROM DEV
        JUMPE A,OPEN1B  ;JUMP ON SPACE IN TABLE, "MATCHES" DIGIT IN DEV
        CAIN A,(J)      ;SKIP IF CHAR DIFFER
         JRST OPEN1C    ;SAME, TRY FOR NEXT CHAR
OPENZ1: AOBJN B,OPEN1A  ;LOOP TO NEXT TABLE ENTRY OR COUNT OUT
;CHECK FOR NAMED SECONDARY PACK
;FIND THE ONE WITH THIS NAME AND THE BIGGEST QSFT.
;ASSUME THAT BY THE TIME WE GET HERE TUTS HAVE BEEN READ IN AND SO FORTH
        SKIPE A,-2(P)   ;GET DEVICE NAME AGAIN
         CAMN A,[-1]    ;0 OR -1 ARE NOT LEGAL PACK NAMES
          JRST OPEN22
        MOVEI C,NQS-1   ;SEARCH NAMES OF SECONDARY PACKS
        SETOB TT,I      ;I BEST DRIVE SO FAR, TT BEST QSFT SO FAR
OPENZ2: CAMN A,QRESRV(C)
         JRST [ CAML TT,QSFT(C)
                 JRST .+1
                MOVE TT,QSFT(C)
                MOVE I,C
                JRST .+1 ]
        SOJGE C,OPENZ2
        MOVE TT,[%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK,,QSKOB]
        JUMPGE I,OPEN21
;
;"UNKNOWN DEVICE" HANDLER.  FOO DEVICE IS LOADED BY
;SYS;ATSIGN DEVICE FROM FILE DEVICE;JOBDEV FOO
;
OPEN22: POP P,EPDLT2(U) ;WHEN WE USE SYS:ATSIGN DEVICE AS A JOB DEVICE,
        POP P,EPDLT1(U) ;SET UP THE "NAMES BEFORE LAST TRANSLATION" TO BE
        POP P,EPDLT4(U) ;THE NAMES BEING USED, INCLUDING "FOO" AS THE DEVICE.
        MOVE A,USYSN1(U)
        MOVEM A,EPDLT3(U)
        MOVSI C,'JOB
        MOVE TT,DVAJOB  ;DEVADR ENTRY FOR JOB:
        MOVSI A,'SYS
        MOVEM A,USYSN1(U)
        MOVE A,['ATSIGN]        
        MOVE B,['DEVICE]
        JRST OPEN2B

OPEN1B: JUMPE J,OPEN1C  ;JUMP IF DEV ARG EXHAUSTED
        SUBI J,'0       ;CONVERT SIXBIT DIGIT TO NUMBER
        JUMPL J,OPENZ1  ;JUMP IF TOO SMALL, NOT A DIGIT
        CAILE J,9       ;SKIP IF LESS THAN 10.
         JRST OPENZ1    ;LOSE, TRY NEXT
        ASH I,3         ;MULTIPLY NUM SO FAR BY 8
        ADD I,J         ;ADD NEW DIGIT
OPEN1C: TLNE C,770000   ;SKIP IF ALL SIX CHAR POSITIONS COMPARED
         JRST OPENA1    ;GO TO NEXT POSITION
        JRST OPEN2
\f
NSOPEN: HRRZ R,A        ;Args: 1 mode (LH) chnl (RH), 2 BP or aobjn -> block of BPs.
        CAIL R,NIOCHN
         JRST OPNL14
        ADDI R,IOCHNM(U)
        PUSH P,A        ;Save channel number.
        PUSH P,B        ;Save BP or BP block ptr.
        PUSHJ P,CCLOSE
        POP P,R         ;Get back the BP or aobjn pointer.
        MOVEM R,EPDL(U) ;Save where job device can get it.
        PUSHJ P,FNPRS   ;Parse into DEV, FN1, FN2, SNM in A, B, C, D.
        MOVEM D,SRN3(U) ;Make symbolic open of network win using 5th arg as foreign host.
        POP P,R         ;Pop back channel number argument.
        MOVE E,CTLBTS(U)
        TSC E,E
        TRZ E,-1
        XOR R,E
        LDB E,[OPNCOM,,R]
        CAIE E,2
         CAIN E,4
          JRST OPNL12   ;COMMAND CANT BE LINK OR FDELE FOR "NEW" CALL
        HLRZ E,R
        JRST NDEL1

;Given in R a BP into user memory, or an aobjn -> of BPs block in user memory,
;parse filenames into A, B, C, D.  Clobbers Q, T, R, H, I.
FNPRS:  SETZ Q,         ;Guess that it is a BP, not a block of them.
        SETZ A,         ;Clear out the old-fashioned filename words.
        SETZ B,
        SETZ C,
        SETZ D,
        SETCM T,R       ;Is our "BP" realy an aobjn pointer to fewer than 64 things?
        TLNE R,-1       ;If LH is 0, treat as BP and replace with 440700 later.
        TLNE T,777700
         JRST FNPRS8
        MOVE Q,R        ;Put the aobjn pointer in Q and get the first BP in R.
        UMOVE R,(Q)
FNPRS8: PUSHJ P,ASCIND
FNPRS7: PUSHJ P,FNPRS4          ; Read a sixbit word
        JUMPL I,FNPRS9          ; Nothing there at all!
        CAIN H,";               ; Directory?
         JRST FNPRS0            ;  Go do special hack
        MOVEI I,B               ; assume FN1
        SKIPE B                 ; unless we already have a FN1
         MOVEI I,C              ; in which case assume FN2
        CAIN H,":
         MOVEI I,A              ; unless it was a device
        SKIPN (I)       ;Put it there, unless already something there.
         MOVEM T,(I)
        JUMPN H,FNPRS7  ;H=0 means end of last arg string.
FNPRS9: ;; Supply default values for all components except FN1.
        SKIPN A
         MOVSI A,(SIXBIT /DSK/)
        SKIPN D
         MOVE D,USYSNM(U)
        SKIPN C
         MOVSI C,(SIXBIT />/)
        POPJ P,

FNPRS0: SKIPN I,D
         JRST FNPRS2
        LSH T,-6
        TLO T,(SIXBIT /./)
FNPRS1: LSH T,-6
        LSH I,6
        JUMPN I,FNPRS1
FNPRS2: IOR D,T
        JRST FNPRS7

;;; Extract in T the next SIXBIT word from user memory off bp in R,
;;; clobbering I (test 4.9 to see if there was no word read at all).
;;; Terminating character returned in H (0 means we got to the end of the
;;; string).  Q should be an aobjn pointer to a block in user memory of
;;; additional BPs.
FNPRS4: SETZ T,
        MOVE I,[440600,,T]
FNPRS6: PUSHJ P,FNPRS3
        JUMPE H,CPOPJ           ; that was the end of the string
        CAIE H,":
         CAIN H,";
          JRST FNPRS5           ; done?
        CAIN H,40
         JRST FNPRS5            ; done?
        CAIN H,^Q
         PUSHJ P,FNPRS3
        CAIL H,140
         SUBI H,40
        SUBI H,40
        TLNE I,770000
         IDPB H,I
        JRST FNPRS6

FNPRS5: JUMPL I,FNPRS6          ; keep looking if we haven't seen anything yet.
        POPJ P,

;Extract in H the next character from user memory off the byte pointer in R.
;Q should be an aobjn pointer to a block of further BPs
;(in user memory) to use after this one is exhausted.
FNPRS3: TLNN R,-1
         HRLI R,440700
        IBP R
        UMOVE H,(R)             ;Fetch the word the BP points to.
        PUSH P,R
        HRRI R,H                ;Change the BP to point to H.
        LDB H,R                 ;Extract the desired byte.
        POP P,R
        JUMPN H,CPOPJ
        AOBJP Q,CPOPJ           ;When one BP is exhausted, go to the next (if any).
        UMOVE R,(Q)
        PUSHJ P,ASCIND
        JRST FNPRS3
\f
NOPEN:  HRRZ R,A        ;ARGS 1 MODE (LH) CHNL (RH) 2-5 LIKE NOPEN1 1-4
        CAIL R,NIOCHN
         JRST OPNL14
        ADDI R,IOCHNM(U)
        PUSH P,A
        PUSH P,B
        PUSH P,C
        PUSH P,D
        PUSH P,E
        PUSH P,W
        PUSHJ P,CCLOSE
        POP P,W
        SOS W           ;STRIP OF FIRST ARG
        POP P,D         ;B-E POPPED INTO A-D
        POP P,C
        POP P,B
        POP P,A
        POP P,R         ;A POPPED INTO R
        TLC R,@CTLBTS(U)
        LDB E,[OPNCOM,,R]
        CAIE E,2
         CAIN E,4
          JRST OPNL12   ;COMMAND CANT BE LINK OR FDELE FOR "NEW" CALL
        JSP T,NOPEN1
        MOVEM D,SRN3(U) ;MAKE SYMBOLIC OPEN OF NETWORK WIN USING 5TH ARG AS FOREIGN HOST.
NDEL1:  CLEARM SRN4(U)
NRN2:   CLEARM SRN5(U)
NOPENX: TRNE R,-NIOCHN
         BUG            ;BAD CHANNEL #
        HRRZM R,UUAC(U) ;CHNL # (MAYBE ONLY FOR ERRS) IN R
        ADDI R,IOCHNM(U)
        LDB W,[OPNCOM,,R]
        JRST NOPNE

;DEFAULT THE ARGS FOR .CALL OPEN, ETC,; PUT MODE IN E.
NOPEN1: SETZM EPDL(U)
        SETZM EPDL3(U)
        CAIGE W,2
         MOVSI B,(SIXBIT /@/)
        CAIGE W,3
         MOVSI C,(SIXBIT /@/)
        CAIGE W,4
         MOVE D,USYSNM(U)       ;SYSTEM NAME
        HLRZ E,R        ;GET MODE BITS FOR TRAN.
        JRST (T)

;MAKE LINK 1-4 AS NOPEN1, 5 SNAME 2 6,7 FN1,2(2)
NMLINK: MOVSI R,200000
        CAIN W,2        ;Only 2 args are BPs.
         JRST [ PUSHJ P,2FNPRS
                JRST NOPENX]
        CAIGE W,7       ;Otherwise, must be seven word of sixbit.
         JRST OPNL33
        MOVEM E,SRN3(U)
        MOVEM TT,SRN4(U)
        MOVEM I,SRN5(U)
        JSP T,NOPEN1
        JRST NOPENX

NDEL:   SETZM SRN3(U)
        CAIN W,2
         JRST OPNL33
        CAIN W,1        ;If it's just a BP (or block of them),
         JRST [ MOVE R,A        ;Parse it into filenames in A-D.
                MOVEM R,EPDL(U)
                PUSHJ P,FNPRS
                JRST .+2]
         JSP T,NOPEN1
        MOVSI R,400000  ;DELETE, ARGS AS NOPEN1
        SETZ E,
        JRST NDEL1

NRNAM:  MOVSI R,400000
        CAIN W,2        ;Only 2 args are BPs.
         JRST [ PUSHJ P,2FNPRS
                JRST NRN2]
        CAIGE W,6       ;Otherwise, must be six word of sixbit.
         JRST OPNL33
        MOVEM E,SRN3(U)
        MOVEM TT,SRN4(U)
        MOVSI R,400000  ;RENAME 1-4 AS NOPEN1 5,6 NEW FN1,2
        JSP T,NOPEN1
        JRST NRN2

;Parse two BPs (or aobjn pointers to blocks of BPs) into user memory
;into filenames.  The second bunch go in SRN3 - SRN5; the first in A - D.
;The two args are saved in EPDL and EPDL3.  Clears E, preserves R.
2FNPRS: PUSH P,R
        MOVEM A,EPDL(U)         ;Save two BPs for job device.
        MOVEM B,EPDL3(U)
        PUSH P,A                ;Decode the second BP first, to get the new names.
        MOVE R,B
        PUSHJ P,FNPRS
        MOVEM B,SRN3(U)         ;Stick them where RENAME looks.
        MOVEM C,SRN4(U)
        MOVEM D,SRN5(U)
        POP P,R                 ;Parse the first BP, to get the old file filenames.
        PUSHJ P,FNPRS
        SETZ E,
        POP P,R
        POPJ P,

;Takes either channel, FN1 (sixbit) and FN2 (sixbit)
;or channel and BP (or aobjn -> block of BPs).
NRNWO:  SETZM EPDL(U)
        SETZM EPDL3(U)
        PUSH P,A
        CAIN W,2
         PUSHJ P,[MOVE R,B      ;If channel and BP, parse the BP into filenames.
                  MOVEM R,EPDL3(U)      ;But also save it for job device.
                  JRST FNPRS]
        MOVEM B,SRN3(U) ;PUT AWAY NEW NAMES.
        MOVEM C,SRN4(U)
        POP P,C
        ANDI C,-1       ;We call "RENAME" with old fn2 = channel number.
        SETZB A,B
        MOVEI D,0
        MOVSI R,400000  ;OPNCOM IS .FDELE .
        MOVEI E,400000
        JRST NRN2
\f
SUBTTL HACKS FOR OPENS THAT LOSE


IFN 0,[         ;THESE "DEFNS" EXIST ONLY SO @ WILL CREF THEM
        OPNL1:  OPNL2:  OPNL3:  OPNL4:  OPNL5:  OPNL6:  OPNL7:
OPNL10: OPNL11: OPNL12: OPNL13: OPNL14: OPNL15: OPNL16: OPNL17:
OPNL20: OPNL21: OPNL22: OPNL23: OPNL24: OPNL25: OPNL26: OPNL27:
OPNL30: OPNL31: OPNL32: OPNL33: OPNL34: OPNL35: OPNL36: OPNL37:
OPNL40: OPNL41: OPNL42: OPNL43: OPNL44: OPNL45: OPNL46: OPNL47:
OPNL50: OPNL51: OPNL52: OPNL53: OPNL54: OPNL55: OPNL56: OPNL57:
OPNL60: OPNL61: OPNL62: OPNL63: OPNL64: OPNL65: OPNL66: OPNL67:
OPNL70: OPNL71: OPNL72: OPNL73: OPNL74: OPNL75: OPNL76: OPNL77: 
]               ;END OF IFN 0

;HERE ARE THE REAL DEFNS
REPEAT NOPNLS,CONC OPNL,\.RPCNT+1,:     JSP D,OPENL
;
OPENL:  CONSZ PI,77400
         BUG            ;ERROR WITH PI IN PROGRESS
        MOVE U,USER     ;BE SURE U=CURRENT USER'S INDEX
        MOVEI D,-OPNL1(D)       ;GET LOSSAGE NUMBER
        MOVE R,SYSCVL(U);POSSIBLY RETURN IN ERROR-CODE ARG TO .CALL
        TLNE R,%SCVER
         UMOVEM D,(R)
        HRRZ R,UUAC(U)  ;GET CH NUM
        CAILE R,NIOCHN-1
         BUG            ;UUAC BAD
        PUSHJ P,LSWCLR  ;UNLOCK SWITCHES
        DPB R,[BCHPTR]  ;SAVE AS MOST RECENT CHANNEL IN ERR
        ADD R,U         ;RELOCATE TO POINT TO USER VARS
        DPB D,[220600,,IOCHST(R)]       ;STORE IN STATUS WORD
        JRST CLKONJ
\f
SUBTTL RCHST, STATUS, RFNAME, RFPNTR, WHYINT CALLS

;.CALL RFNAME
;1ST ARG IS A <JOB>, WHOSE CHANNEL IS TO BE LOOKED AT.
;2ND ARG IS A CHANNEL NUMBER.
;3RD ARG IS BP TO STORE ASCIZ FILENAME STRING THROUGH.
;4TH ARG IS MAXIMUM NUMBER OF CHARACTERS TO STORE (DEFAULTS TO 1,,0).
;ONLY 1 ARG => IT IS CHANNEL #, AND JOB IS "SELF".
;FIRST 4 VALUES ARE THE DEVICE, FN1, FN2 AND SNAME
;  AS LEFT-JUSTIFIED SIXBIT WHOLEWORDS.
;FIFTH VALUE IS THE MODE THE CHANNEL MIGHT BE RE-OPENED IN

NRFNAM: MOVE J,A        ;FIRST ARG IS JOB SPEC
        CAIL W,2
         SKIPA A,B      ;GET CHANNEL # INTO A IN EITHER CASE
          MOVEI J,%JSELF ;IF ONLY ONE ARG, JOB SPEC IS SELF
        MOVE Q,C        ;SAVE BP FOR STORING ASCIZ FILENAME STRING - IF ANY.
        CAIGE W,3
         SETZ Q,
        CAIGE W,4
         MOVSI D,1
        JSP T,NCORUI    ;DECODE JOB SPEC
         JFCL
IFN PDP6P,[
        CAIN J,-1
         JRST OPNL34    ;PDP6 DOESN'T HAVE CHANNELS
]
        PUSH P,D
        PUSH P,Q
        MOVE W,D
        MOVE U,J        ;LOOK IN THAT JOB'S CHANNELS
        PUSHJ P,NRFNM1  ;GET THE CRUFT
         JRST POP2J
        PUSHJ P,LSWPOP  ;UNSOS DIELOK.
        MOVE T,Q
        POP P,Q
        POP P,I         ;I GETS 4TH ARG: MAX NUMBER OF CHARS TO STORE IN STRING.
        JUMPE T,POPJ1   ;IF DEVICE ROUTINE HAS CLEARED Q, IT HAS STORED THE STRING.
                ;NOTE NETRCH PUTS AN EXTRA VALUE FOR .RCHST (GARBAGE, TO US) IN Q!
        JUMPE Q,POPJ1   ;IF BP ARG WAS 0, CALLER DOESN'T WANT A STRING.
        MOVE R,Q
        PUSHJ P,ASCIND
        MOVE Q,R
        MOVE J,A        ;IF SO, STORE ALL 4 FILENAMES DOWN IT, ONE BY ONE.
        MOVEI T,":
        PUSHJ P,NRFNS1
        MOVE J,D
        MOVEI T,";
        PUSHJ P,NRFNS1
        MOVE J,B
        MOVEI T,40
        PUSHJ P,NRFNS1
        MOVE J,C
        MOVEI T,0
        PUSHJ P,NRFNS1
        JRST POPJ1

;STORE THE SIXBIT WORD IN J FOLLOWED BY THE ASCII CHAR IN T
;INTO USER ADDRESS SPACE DOWN THE BP IN Q.
NRFNS1: JUMPE J,CPOPJ           ;OUTPUT NOTHING AT ALL IF THE SIXBIT WORD IS EMPTY.
        CAIGE I,4               ;GIVE UP NOW IF TOO CLOSE TO END OF ALLOCATED SPACE.
         POPJ P,
        SETZ R,
        ROTC J,6                ;ELSE GET NEXT CHAR IN R, AND CONVERT TO ASCII AND STORE.
        ADDI R,40
        SETZ TT,
        CAIE R,":               ;PRECEDE ANY SPECIAL CHARACTERS WITH ^Q.
         CAIN R,";
          MOVEI TT,^Q
        CAIN R,40
         MOVEI TT,^Q
        JUMPE TT,NRFNS2
        SOS I
        PUSHJ P,NRFNSB
NRFNS2: SOS I
        MOVE TT,R
        PUSHJ P,NRFNSB
        JUMPN J,NRFNS1
        SOS I
        MOVE TT,T
        PUSHJ P,NRFNSB          ;IF NAME FINISHED BUT NOT EMPTY, FOLLOW BY TERMINATOR.
        JUMPE T,CPOPJ
        CAIN T,40
         POPJ P,
        MOVEI TT,40
        PUSHJ P,NRFNSB          ;IF TERMINATOR IS : OR ;, FOLLOW IT WITH A SPACE.
        SOJA I,CPOPJ

;STORE A BYTE IN TT DOWN BP IN Q TO USER SPACE, INCREMENTING FIRST.
;XCTR XBYTE LOSES BECUSE IT GETS THE BP FROM USER SPACE.
NRFNSB: IBP Q
        PUSH P,T
        PUSH P,Q
        UMOVE T,(Q)
        HRRI Q,T
        DPB TT,Q
        POP P,Q
        UMOVEM T,(Q)
        POP P,T
        POPJ P,

;GET THE FILENAMES FOR THE CHANNEL IN A OF JOB IN U INTO A THRU D.
;IF Q IS NONZERO, IT IS A BP TO STORE AN ASCIZ STRING, AND W IS THE
;MAX NUMBER OF CHARACTERS TO STORE.
;THE DEVICE DEPENDENT ROUTINE CAN STORE THE STRING ITSELF
;AND SET Q TO ZERO SO THAT IT WILL NOT BE STORED THE STANDARD WAY.
NRFNM1: MOVE T,[4,,NRFNM2]
        JRST CHNDCD     ;R GETS ADDR OF IOCHNM WD, H GETS CONTENTS.
NRFNM2: HLRZ A,H        ;PUT LH(IOCHNM WD) WHERE DEVICE RTN LOOKS
        HLLZ J,DCHSTB(H)
        JUMPG J,[       ;IF 6-LETTER DEVICE NAME, LH IS POSITIVE ADDRESS
                HLRZS J ;OF FULL NAME.  NOTE THERE BETTER BE NO
                MOVE J,(J)      ;3-CHAR DEVICES WHOSE NAME DOES NOT START
                JRST .+1 ]      ;WITH A LETTER.
        PUSH P,J        ;SAVE THE PROBABLE VALUE OF DEVICE NAME
        LDB J,[1400,,DCHSTB(H)]
        HLRZ J,DRFNTB(J) ;GET RFNAME ROUTINE POINTER
        SETZB B,C       ;FN1, FN2 ARE 0 FOR NON-DIR-DEV
        SETZ D,         ;SNAME IS 0 FOR NON-MULTI-DIR-DEV
        LDB E,[.BP (%IOTOM),IOTTB(H)]   ;PROBABLE VALUE OF MODE
        PUSHJ P,(J)     ;CALL DEVICE-SPECIFIC ROUTINE
         SKIPA A,(P)    ;NO SKIP => USE DEVICE NAME FROM DCHSTB
          MOVE A,J      ;SKIP => USE DEVICE NAME RETURNED IN J
        JRST POP1J1

;.CALL RFPNTR
;ARG 1 - CHANNEL NUMBER
;VAL 1 - ACCESS POINTER OF CHANNEL
;VAL 2 - BYTE SIZE OF CHANNEL.
;FAILS IF NOT A RANDOM-ACCESS DEVICE

NRFPNT: HLRZ A,H        ;CHANNEL ALREADY DECODED, SET UP LH(IOCHNM) FOR DEV RTN
        LDB J,[1400,,DCHSTB(H)]
        HRRZ J,DRFNTB(J) ;GET RFPNTR ROUTINE POINTER
        JRST (J)        ;IT SHOULD PUT POINTER IN A AND POPJ1, OR OPNL34

;SYMBOLIC CALL "RCHST"
;1ST ARG IS A CHANNEL NUMBER.
;6 OR MORE VALUES. THE FIRST 4 ARE THE DEVICE, FN1, FN2 AND SNAME
;  AS LEFT-JUSTIFIED SIXBIT WHOLEWORDS.
;THE 5TH IS THE ACCESS POINTER, OR -1 IF NOT RANDOM ACCESS.
;THE 6TH IS THE MODE THE CHANNEL MIGHT BE RE-OPENED IN.
;MORE VALUES ARE RETURNED ONLY FOR NET:, AT THE MOMENT.
;THE DEV SUBROUTINE MAY PUT EXTRA RESULTS IN TT, I, AND Q, AND PUT # RESULTS INTO W

NRCHST: SETO I,                 ;DEFAULT POSSIBLE EXTRA RESULTS
        SETO TT,                ;DEFAULT ACCESS POINTER TO -1
        MOVEI W,6               ;NORMAL NUMBER OF RESULTS IS 6
        SETZ Q,
        PUSHJ P,NRFNM1          ;GET RESULTS 1 THROUGH 4 AND 6, AND SET UP R AND H
         POPJ P,                ;CHANNEL NUMBER MUST HAVE BEEN BAD
        PUSH P,A
        PUSH P,B                ;SAVE THE AC THAT RFPNTR CLOBBERS.
        HLRZ A,H                ;GET ROUTINE TO GET ACCESS POINTER
        LDB J,[1400,,DCHSTB(H)]
        HRRZ J,DRFNTB(J)        ;ROUTINE BETTER PRESERVE B,C,D,E,TT,I,Q
        CAIL J,OPENL            ;KLUDGILY SKIP IF WOULD OPEN-LOSS
         PUSHJ P,(J)            ;GET ACCESS POINTER IN A, ALWAYS SKIPS
          MOVE A,TT             ;NOT RANDOM ACESS, USE DEFAULT VALUE
        MOVE TT,E               ;OPEN MODE IS 6TH RESULT
        MOVE E,A                ;ACCESS POINTER IS 5TH RESULT
        JRST PPBAJ1
\f
;.RCHST AC,  WITH  AC/ CH,,ADDR
;RETURNS, IN THE 5 OR MORE WORDS STARTING AT ADDR,
;THE RESULTS OF A SYMBOLIC RCHST ON CHANNEL CH.
;EXCEPTION - THE DEVICE NAME IS RETURNED IN THE RH
;OF THE FIRST WORD , SO IT IS TRUNCATED TO 18 BITS.
;EXCEPTION - THE OPEN MODE VALUE IS NOT RETURNED. LATER VALUES
;ARE SHIFTED DOWN ONE WORD.
;NEVER SKIPS.

ARCHST: UMOVE J,(J)     ;GET CONTENTS OF AC
        HLRZ A,J
        CAIL A,NIOCHN
         JRST ILUUO     ;BAD CHANNEL NUMBER
        PUSH P,J
        PUSHJ P,NRCHST  ;DO THE REAL WORK.
         BUG            ;ONLY ERROR RETURN SHOULD BE BAD CHANNEL NUMBER
        HLRZS A         ;PUT DEV NAME IN RH FOR HISTORY'S SAKE
        POP P,J         ;RH(J) HAS PLACE TO STORE DATA
        MOVE TT,I
        MOVE I,Q        ;SHIFT DOWN LAST 2 VALS OVER THE OPEN MODE.
        HRLI J,A
        ADDI W,-2(J)    ;W HAD 1+ # VALS, NOW HAS PLACE TO PUT LAST ONE
        XCTR XBW,[BLT J,(W)]
        POPJ P,

;.STATUS CH,LOC ;STORE IN LOC THE STATUS OF CHANNEL CH
                ;AND OF THE DEV OPEN ON IT IF ANY
;1.1-1.6 SYS PERIPHERAL DEVICE CODE
;1.7-2.9 DEVICE DEPENDENT
;3.1-4.9 LH(IOCHST)

ASTATUS:ADDI R,IOCHNM(U)        ;SET UP AC'S LIKE CHNDCD
ASTAT1: MOVE H,(R)              ;ENTER HERE FROM .USET [.RIOS,,]
        HLL R,CLSTB(H)
        PUSHJ P,NSTATUS         ;CALL NEW SYSTEM CALL VERSION
         BUG
        UMOVEM A,(C)    ;GIVE TO USER
        POPJ P,

;.CALL STATUS
;ARG 1 - CHANNEL NUMBER
;VAL 1 - SAME AS .STATUS

NSTATUS:HLRZ A,H                ;SET UP LH(IOCHNM)
        LDB D,[140600,,DCHSTB(H)] ;GET SYS PERIPHERAL DEVICE CODE
        LDB J,[340300,,IOTTB(H)]        ;GET I/O CHANNEL MODE FROM 4.5-4.2
        DPB J,[060300,,D]       ;RETURN IN BITS 1.9-1.7
        LDB J,[1400,,DCHSTB(H)]
        HLRZ J,DSTSTB(J)        ;GET STATUS ROUTINE POINTER
        PUSHJ P,(J)             ;ROUTINE FILLS OUT STATUS WORD IN D
        HLL D,IOCHST-IOCHNM(R)  ;FILL IN LEFT HALF FROM IOCHST
        TLZ D,740000            ;CLEAR BITS USED FOR CHANNEL NUM ON IO PDL
        MOVE A,D                ;RETURN VALUE IN A
        JRST POPJ1              ;THIS CALL ALWAYS SUCCEEDS

;.CALL WHYINT
;ARG 1 - CHANNEL NUMBER
;VAL 1 - %WY CODE FOR TYPE OF DEVICE
;ADDITIONAL VALUES DEVICE-DEPENDENT
;THIS IS THE USUAL CALL TO GIVE IN RESPONSE TO A SECOND WORD INTERRUPT

NWHYINT:HLRZ A,H                ;SET UP LH(IOCHNM)
        LDB J,[1400,,DCHSTB(H)]
        HRRZ J,DSTSTB(J)        ;GET WHYINT ROUTINE POINTER
        JRST (J)
\f
;DEVICE-SPECIFIC RFNAME/RCHST ROUTINES
;CALLED WITH STANDARD CHNDCD STUFF IN H AND R, LH(IOCHNM) IN A
;MUST PRESERVE H AND R; CAN CLOBBER W TO INDICATE EXTRA STUFF FOR RCHST

RCHUSR: MOVE B,UNAME(A)         ;GET UNAME
        MOVE C,JNAME(A)         ;GET JNAME
        POPJ P,

IFN NUNITS,[            ;UTAPE .RCHST
RCHUTP: HRRZ C,UTTNO(A)
        MOVSI J,'UT0(C) ;GET REAL DEV NAME "UTN" IN J
        AOS (P)         ;SKIP TO RETURN CHANGED DEV NAME
        MOVE D,UTASS(C) ;THE "SNAME" IS THE USER TAPE IS ASSIGNED TO.
        CAIGE A,NUTIC
         JRST RCHUTI    ;INPUT
        MOVE B,UTN1(A)  ;OUTPUT, GET FN1
        MOVE C,UTN2(A)  ;NOW FN2
        POPJ P,

        ;UTAPE INPUT .RCHST
RCHUTI: LDB T,[220500,,UTDBC(A)]        ;GET FILE NUMBER
        SUBI T,1
        LSH T,1                 ;TURN INTO INDEX INTO DIRECTORY
        CONO PI,CLKOFF
        ADD T,UDIRO(C)          ;GET POINTER TO FILE NAMES
        MOVE B,(T)              ;GET FN1
        MOVE C,(T)              ;GET FN2
        JRST CLKONJ
]

;RCHST ROUTINE FOR TTY
RCHTTY: MOVE J,A
        ANDI J,#%TICNS#(.BM $TIIDX)
        IOR E,J         ;MERGE TTY OPEN MODE BITS WITH THE GENERAL ONES.
        TRNE A,%TICNS
         POPJ P,
        ANDI A,7
        MOVEI J,'T00(A)
        HLRZ A,(R)
RCHST1: ANDI A,70
        LSH A,3
        ADD J,A
        HRLZS J         ;J NOW HAS SIXBIT/TNM/, NM = TTY #.
        JRST POPJ1      ;SKIP TO SAY DEV NAME IS IN J.

;RCHST ROUTINE FOR STY
RCHSTY: MOVE J,TTYOPT(A)
        TLNE J,%TOHDX
         IORI E,4       ;STY BIT 1.3 => TTY IS HALF-DUPLEX.
        MOVE J,STYSTS-NFSTTY(A)
        TLNE J,%SSORS
         IORI E,20      ;BIT 1.5 => WANT TO RECEIVE %TDORS ON .RESET OF TYOC,
        TRNN E,1        ;FIND THE DON'T-HANG-BIT FOR THIS DIRECTION.
         TLZA J,#%SSOHG ;AND FLUSH THE ONE FOR THE OTHER DIRECTION.
          TLZ J,#%SSHNG
        TLNE J,-1       ;THEN TESTING BOTH TESTS ONLY THE RELEVANT ONE.
         IORI E,10
        SUBI A,NFSTTY
        ANDI A,7
        MOVEI J,'S00(A)
        HLRZ A,(R)
        SUBI A,NFSTTY
        JRST RCHST1

RCHDRH: HRRZ A,IOCHST-IOCHNM(R) ;TRACK NUMBER
        IMULI A,LMNBLK          ;DIRHNG DEVICE RFNAME
        ADDI A,2000-LMNBLK*NUDSL
        ADD A,QMDRO
        MOVE D,MNUNAM(A)
        POPJ P,
\f
;RCHST ROUTINE FOR DIRECTORY CHANNELS AND THE ERR DEVICE.
RCHDIR: MOVE T,DSKLST(A)        ;GET THE TYPE OF DIRECTORY CODE.
        SKIPE J,UDUSR(A)        ;IF DEVICE # IS NONZERO, ADD IT TO DEV NAME
         HRLZS J                ;(ONLY HAPPENS FOR UTAPE)
        ADD J,RCHDRD-1(T)       ;DETERMINE DEV NAME FROM DIRECTORY TYPE
        MOVE B,RCHDR1-1(T)      ;SAME FOR FN1
        SKIPN C,RCHDR2-1(T)     ;AND FN2, EXCEPT 0 FOR ERR DEVICES
         MOVE C,UUDPP(A)        ; SO WE WILL GET THE STATUS WORD BEING DECODED.
        CAIN T,3
         MOVE D,UDSYSN(A)       ;FOR DISK UFD'S, GET THE SNAME
        JRST POPJ1              ;RETURN, SAYING WE HAVE SPEC'D THE DEVICE NAME.

.SEE UDT        ;THESE TABLES ARE IN PARALLEL WITH UDT
RCHDRD: 'UT0,, ? 'CLU,, ? 'DSK,, ? 'DSK,,
        'ERR,, ? 'TTY,, ? 'COR,,
IF2 IFN .-UDTLN-RCHDRD,.ERR RCHDRD WRONG LENGTH

RCHDR1: '.FILE. ? '.FILE. ? '.FILE. ? 'M.F.D.
        3 ? '.FILE. ? '.FILE.
IF2 IFN .-UDTLN-RCHDR1,.ERR RCHDR1 WRONG LENGTH

RCHDR2: SIXBIT /(DIR)/ ? SIXBIT /(DIR)/ ? SIXBIT /(DIR)/ ? SIXBIT /(FILE)/
        0 ? SIXBIT /(DIR)/ ? SIXBIT /(DIR)/
IF2 IFN .-UDTLN-RCHDR2,.ERR RCHDR2 WRONG LENGTH



;CORE LINK .RCHST ROUTINE

RCHCLO: CONO PI,CLKOFF
        MOVE B,CLN1(A)  ;GET FN1
        MOVE C,CLN2(A)  ;GET FN2
        MOVE D,CLSYN(A) ;GET SYSTEM NAME
        JRST CLKONJ

;RFNAME ROUTINE FOR DSK

RCHQSK: MOVE H,QUDPR(A) ;FILE STATUS FOR DISK PICKUP USER DIR POINTER
        PUSHJ P,QUDLK   ;LOCK DIRECTORY
        MOVE C,QSNLCN(H)        ;LOCATION OF DIRECTORY
        MOVE D,UDNAME(C)
        ADD C,QUDFPR(A) ;ADD LOCN OF FILE WITHIN DIRECTORY
        MOVE B,(C)      ;GET FIRST FILE NAME
        MOVE C,1(C)     ;GET SECOND FILE NAME
        PUSHJ P,QUDULK
        MOVE H,QSRAC(A)
        TLNE H,%QALNK
         TRO E,20       ;LINK MODE
        MOVE H,(R)      ;PRESERVE H
        POPJ P,

;RFNAME ROUTINE FOR BOJ:

RCHBOJ: CONO PI,CLKOFF  ;BOJ DEVICE .RCHST ROUTINE
        MOVE T,JBCUI(A) ;RETURNS CREATOR'S NAME
        MOVE B,UNAME(T)
        MOVE C,JNAME(T)
        SKIPGE JBCG(A)
         SETZB B,C      ;CREATOR GONE, RETURN BLANK NAMES
        JRST CLKONJ
\f
;RFNAME ROUTINE FOR JOB:

RFNJOB: SKIPE Q
         PUSHJ P,RFNJ1
        CONO PI,CLKOFF
        MOVE B,JBFN1(A)
        MOVE C,JBFN2(A)
        MOVE D,JBSYS(A)
        MOVE E,JBOPNM(A)
        MOVE J,JBDEV(A)
        JRST CLKOJ1

;COPY THE BOJ JOB'S ASCIZ FILENAME STRING INTO OUR CALLER'S STRING.
;THE CALLER'S BP IS IN Q, AND HIS MAX CHARS TO STORE IS IN W.
RFNJ1:  SKIPN B,JBFNP(A)
         POPJ P,
        PUSH P,TT
        PUSH P,T
        MOVE J,JBCJUI(A)
        AOS DIELOK(J)   ;PREVENT THE JOB FROM DIEING.
        PUSHJ P,SOSSET
         DIELOK(J)
        TLZ B,37
        MOVE D,B
        PUSHJ P,RFNJ3
        MOVEI TT,1
;D HAS BP TO FETCH WITH, POINTING INTO C, WHICH CONTAINS WORD FETCHED FROM BOJ JOB.
;RH(B) HAS ADDR OF NEXT WORD TO FETCH FROM THE BOJ JOB.
;TT CONTAINS THE PREVIOUS CHARACTER TRANSFERRED, OR 1
;IF THE PREVIOUS CHARACTER WAS QUOTED WITH A ^Q.
RFNJ2:  ILDB E,D
        TRNN D,#C               ;IF THE BP IN D ADVANCES PAST C,
         JRST RFNJ4
        PUSHJ P,RFNJ3           ;FETCH ANOTHER WORD INTO C, MAKE D POINT THERE AGAIN,
        LDB E,D                 ;AND FETCH THE SAME BYTE OVER AGAIN.
RFNJ4:  SOJL W,RFNJ5
        EXCH TT,E
        PUSHJ P,NRFNSB          ;STORE BYTE INTO CALLER, UNLESS HIS STRING IS FULL.
        EXCH TT,E
        CAIN TT,^Q              ;A QUOTED CHAR DOES NOT TERMINATE AND DOES NOT QUOTE.
         MOVEI E,1
        MOVE TT,E
        JUMPN E,RFNJ2           ;STOP STORING AFTER A NULL WHICH ISN'T QUOTED.
RFNJ5:  SETZ Q,
        POP P,T
        POP P,TT
        JRST LSWPOP

;READ THE NEXT WORD (ADDR IN B) FROM THE BOJ JOB.
RFNJ3:  SETZ C,
        PUSH P,U
        PUSH P,A
        PUSH P,Q
        MOVE U,JBCJUI(A)
        LDB A,[121000,,B]
        PUSHJ P,UPLC            ;LOOK UP THE BOJ JOB'S PAGE.
        POP P,Q
        POP P,A
        POP P,U
        LDB J,T                 ;IF IT DOESN'T EXIST, LOAD A ZERO,
        JUMPE J,RFNJ6           ;AVOID GETTING MPV.
        MOVE J,JBCJUI(A)
        PUSHJ P,MPLDJ
        UMOVE C,(B)
RFNJ6:  HRRI D,C
        AOJA B,MPLDZ
\f
;RFPNTR FOR USR:

RFPUSR: HRRZ A,IOCHST-IOCHNM(R) ;GET THE ACCESS PTR
        MOVEI B,36.             ;BYTE SIZE IS ALWAYS FULL WORD.
        JRST POPJ1

;RFPNTR FOR DISK

RFPQSK: LDB B,[QSBSIZ(A)]       ;GET FILE BYTE SIZE
        MOVSI T,%QAACC
        TDNN T,QSRAC(A)         ;IF .ACCESS WAS DONE AND NOT HANDLED,
         JRST RFPQS1
        MOVE A,QRADAD(A)        ;GET WHAT THE .ACCESS SPECIFIED.
        JRST POPJ1

RFPQS1: MOVE J,QFBLNO(A)        ;GET BYTE # OF STRAT OF CURRENT BLOCK.
        SKIPGE QSMDN(A)         ;SKIP ON A BUFFER ACTIVE
         JRST RFPQS2            ;NONE ACTIVE => QFBLNO POINTS TO NEXT BLOCK TO BE READ.
        ADD J,QMPBSZ(A)         ;ELSE CORRECT FOR THE NUMBER OF BYTES WE'VE PROCESSED
        SUB J,QSMPRC(A)         ;IN THE ACTIVE BLOCK (QFBLNO -> 1ST WD OF BLOCK).
RFPQS2: MOVE A,J
        JRST POPJ1
\f
SUBTTL RESET,IOPUSH,IOPOP,IOPDL,FORCE,FLUSH .CALLS

;.RESET CH,     ;RESET BUFFERED INFO ON CHANNEL CH
                ;NOT IMPLEMENTED FOR MANY DEVICES
                ;HAS SPECIAL EFFECTS ON "USR" DEVICE
;.CALL RESET
;ARG 1 - CHANNEL NUMBER

NRESET: HRRZ A,H
        AOSA (P)
ARESET:  HRRZ A,(R)     ;PICK UP INDEX FROM I/O CH WORD
        SKIPA T,[HRRZ T,RSTB1(A)]       ;.RESET USES RH OF TABLE
AIOPP1:  MOVE T,[HLRZ T,RSTB1(A)]       ;.IOPUSH, .IOPOP USE LH OF TABLE
        IDIVI A,7       ;TABLE IS IN 5-BIT BYTES TO SAVE SPACE
        ADD A,[440500,,RSTB]
        IBP A
        SOJGE B,.-1
        LDB A,A         ;GET BYTE FROM TABLE
        XCT T           ;GET REAL TABLE ENTRY IN T
        JRST (T)        ;DISPATCH

;IO CHANNEL PUSH DOWN LIST ROUTINES
;C(I) =0 AT DSP => IOPUSH =1 => IOPOP

NIOPUS: AOS (P)
AIOPUSH:MOVE T,SIOCP(U) ;PICK UP PDL POINTER
        CAML T,[LUIOP-1,,0]     ;LUIOP-2,,<ptr> is OK, leaves room for 1 more.
         JRST IOCER6    ;OVER PUSH ERROR
        PUSH T,(R)      ;PUSH CURRENT IOCHNM
        PUSH T,IOCHST-IOCHNM(R) ;&IOCHST
        HRRZ A,(R)
        HRRZ J,UUAC(U)
        DPB J,[400400,,(T)]     ;STORE CHANNEL NUM FOR POSSIBLE USE BY AIOPDL
        MOVEM T,SIOCP(U)        ;STORE BACK PDL POINTER
        MOVEI I,0       ;INDICATE IOPUSH
        PUSH P,R
        PUSHJ P,AIOPP1  ;CALL DEVICE'S IOPDL HANDLER.  SHOULD NOT HANG
        POP P,R
        SETZM (R)       ;CLEAR OUT IOCHNM
        SETZM IOCHST-IOCHNM(R)  ;&IOCHST
        POPJ P,

NIOPOP: AOS (P)
AIOPOP: PUSHJ P,ACLOSE  ;CLOSE WHATEVER MAY BE OPEN ON CHANNEL POPPING INTO
        MOVE T,SIOCP(U) ;PICK UP PDL POINTER
        TLNN T,-1
         JRST IOCER5    ;OVER POP ERROR
        POP T,IOCHST-IOCHNM(R)  ;POP BACK IOCHST
        POP T,(R)               ;&IOCHNM
        HRRZ A,(R)
        SETZM 1(T)      ;CLEAR OUT PDL WORD TO AVOID CONFUSION IN
                        ;ROUTINES THAT GROVEL OVER I/O PDL
        MOVEM T,SIOCP(U)        ;STORE BACK PDL POINTER
        MOVEI I,1       ;INDICATE IOPOP
        JRST AIOPP1     ;CALL DEVICE'S IOPDL HANDLER

AIOPDL: MOVE T,SIOCP(U) ;PICK UP PDL POINTER
        TLNN T,-1       ;SKIP UNLESS IO PDL EMPTY
        POPJ P,
        LDB R,[400400,,(T)]     ;FIND OUT WHAT CHNL TOP ENTRY WAS PUSHED FROM
        ADDI R,IOCHNM(U)
        PUSHJ P,AIOPOP  ;POP BACK INTO CHNL PUSHED FROM
        JRST AIOPDL

IIOPPR: JUMPE I,[JRST 4,CPOPJ]  ;IOPUSH
        SETZM (R)       ;CLOSE CHANNEL
        SUBI R,IOCHNM(U)        ;GET CHANNEL NUMBER
        MOVE R,CHNBIT(R)        ;SECOND WORD INTERRUPT BIT
        IORM R,IFPIR(U) ;GIVE TO USER
        POPJ P,
\f
;.CALL FORCE
;ARG 1 - CHANNEL NUMBER
;IF ANY OUTPUT IS BUFFERED UP, CAUSES IT TO BE SENT TO THE DEVICE
;(IF FORCE WAS NOT DONE, IT MIGHT NOT BE SENT UNTIL A COMPLETE
;BUFFERFULL HAD BEEN OUTPUT BY THE USER.)

NFORCE: SKIPA T,[HLRZ T,DFRCTB(D)]      ;FORCE USES LH OF TABLE
NFINI1:  MOVE T,[HRRZ T,DFRCTB(D)]      ;FINISH USES RH OF TABLE
        HLRZ A,(R)      ;PASS LH(IOCHNM) TO DEVICE ROUTINES
        HRRZ D,(R)      ;USE RH(IOCHNM) AS BYTE INDEX INTO RSTB
        IDIVI D,7       ;TABLE IS IN 5-BIT BYTES TO SAVE SPACE
        ADD D,[440500,,RSTB]
        IBP D
        SOJGE E,.-1
        LDB D,D         ;GET BYTE FROM TABLE
        XCT T           ;GET REAL TABLE ENTRY IN T
        JRST (T)        ;DISPATCH

;.CALL FINISH
;ARG 1 - CHANNEL NUMBER
;FIRST DOES A FORCE, THEN WAITS FOR ALL OUTPUT TO GET TO THE DEVICE

NFINIS: PUSHJ P,NFORCE  ;CALL DEV ROUTINE FOR FORCING
         POPJ P,
        JRST NFINI1     ;THEN CALL DEV ROUTINE FOR WAITING

;.NETS CH, - UUO VERSION OF .CALL FORCE.
ANETS:  PUSHJ P,NFORCE
         JRST IOCER1    ;ILLEGAL HARDWARE OPERATION
        POPJ P,
\f
SUBTTL I/O DEVICE DISPATCH TABLES

COMMENT |
        This page tries to document the ITS I/O device dispatch tables and
dispatch environment.  It is not completed yet.

The tables use several different indices, which are:
        opnidx - result of device name lookup in DEVTAB
        ioidx  - result of OPEN; has symbolic values.  This is the index
                stored in RH of IOCHNM (per-job channel table)
        sidx  - secondary index from DCHSTB(ioidx)
        ridx  - secondary index from RSTB(ioidx)

The following system calls are dispatched through these tables.
There are 11 dispatch routines that each device must specify.
The format is "CALL [table name(index-used) -> device-routine]"

OPEN [DEVADR(opnidx) -> devO]
        "opnidx" is looked up from DEVTAB which holds the device names.
        The device's OPEN routine is in the RH of DEVADR.
        It must set up the user's IOCHNM word for the channel,
        by setting the RH to the right "ioidx" and the LH to whatever
        the device wants.

        Context:

CLOSE [CLSTB(ioidx) -> devCLS]
        The device's CLOSE routine is in the RH of CLSTB.
        It must zero the user's IOCHNM word for the channel.

        Context:

IOT, SIOT [IOTTB(ioidx) -> devVarious]
        These routines do I/O transfers.  The main reason "ioidx"
        has so many possible values (causing IOTTB to be large) is
        because lots of devices specify different ioidx's for different
        modes - input/output, block/unit, image/ascii, etc - in order
        to speed up actual I/O transfers, which are probably the most
        common device-related system calls.

        Context:

STATUS  [LH(DTSTB(sidx)) -> devSTA]
        

WHYINT  [RH(DTSTB(sidx)) -> devWHY]

RCHST, RFNAME   [LH(DRFNTB(sidx)) -> devRCH]

RFPNTR  [RH(DRFNTB(sidx)) -> devRFP]

IOPUSH, IOPOP   [LH(RSTBI(ridx)) -> devIOP]

RESET   [RH(RSTBI(ridx)) -> devRST]

FORCE   [LH(DFRCTB(ridx)) -> devFRC]

FINISH  [RH(DFRCTB(ridx)) -> devFIN]

|
\f
;DISPATCH TABLE FOR .CLOSE UUO
;TRANSFERED THROUGH USING RIGHT HALF OF IOCHNM WORD AS AN INDEX
;R HAS THE ADDRESS OF THE IOCHNM WORD.
;
;VARIOUS ROUTINES USE THE BITS IN THE L.H. TO DECIDE WHETHER
;A CHANNEL IS ACCEPTABLE FOR SOME OPERATION.
%CLS==1,,525252
%CLSU==400000   ;USR DEVICE (INFERIOR)
%CLSDO==200000  ;DECTAPE OUTPUT
%CLSJI==100000  ;JOB INPUT
%CLSDI==40000   ;DECTAPE INPUT
%CLSTI==20000   ;TTY INPUT
%CLSCL==10000   ;CORE-LINK DEVICE
%CLSBJ==4000    ;BOJ DEVICE
%CLSQO==2000    ;DISK OUTPUT
%CLSFU==1000    ;NON-INFERIOR USR
%CLSNRM==400    ;STANDARD CLOSE ROUTINE USED FOR THIS DEVICE.
                ;RH SHOULD POINT, NOT AT THEROUTINE, BUT AT THE USR-USE PAIR
%CLSQ==200      ;DISK
%CLS6==100      ;PDP6
%CLSJO==40      ;JOB OUTPUT
%CLSST==20      ;STY DEVICE
%CLST==10       ;TRAP DEVICE

%CLSJ==%CLSJI\%CLSJO    ;EITHER DIRECTION OF JOB DEVICE
%CL1QO==%CLSQO\%CLSQ    ;BOTH BITS FOR DISK OUTPUT

CLSTB:                                          CPOPJ
        OFFSET -CLSTB
TYIDN::                 REPEAT 2,       %CLSTI,,TYICLS  ;TYI
TYODN::                 REPEAT 2,               TYOCLS  ;TYO
NLIDN::                 REPEAT 4,               CPOPJ   ;NULL
UWIDN::                 REPEAT 4,       %CLSU ,,CPOPJ   ;USER
FUWIDN::                REPEAT 2,       %CLSFU,,CPOPJ   ;FOREIGN USER
DNDIRH::                                        DIRHCL  ;DIRHNG
DNTRAP::                                %CLST,,CPOPJ    ;TRAP
IFN CHAOSP,CHAIDN::     REPEAT 2,               CHACLS  ;CHAOS NET
IFN NUNITS,[
DNUACII::               REPEAT 3,[
                                        %CLSDI,,UTICL   ;UTAPE.
                                        %CLSDO,,UTOCL
]]
IFN OLPTP,LPTDN::       REPEAT 2,               LPTCLS  ;LPT
IFN NLPTP,[
NLPTDN::                                        NLPDCL
                                                NLPTCL
]
IFN GLPTP,GLPTDN::      REPEAT 2,               GLPCLS
DIRCHN::                REPEAT 4,               UTDCLS  ;DIRECTORY DEVICE
IFN VIDP,NVIDOP::       REPEAT 2,               NVDCLS  ;NVIDI
IFN PLTP,PLTDN::        REPEAT 2,       %CLSNR,,PLTUSR  ;PLOTTER
IFN PTRP,[
PTPI::                  REPEAT 5,       %CLSNR,,PTPUSR  ;PAPER  TAPE PUNCH
]
IFN IMXP,IMPXDN::       REPEAT 4,               IMPXCL  ;IMX
IFN OMXP,OMPXDN::       REPEAT 4,               OMPXCL  ;OMX
DCLUAI::                                %CLSCL,,CLCLRA  ;CORE LINK
                                        %CLSCL,,CLCLWU
                        REPEAT 2,[
                                        %CLSCL,,CLCLRB
                                        %CLSCL,,CLCLWB
                        ]
IFN PTRP,[
REDUAI::                REPEAT 5,               PTRCLS  ;PAPER TAPE READER
]
IFN 340P,[
DN340B::                REPEAT 4,               ADCL1   ;340
;                                               ADCL1   ;IDS
]
IFN CODP,[
CODDN::                 REPEAT 2,               CODCLS  ;CODE DEV
]
DQUAI::                                 %CLSQ ,,QICL    ;DISK
                                        %CL1QO,,QOCLR
                                        %CLSQ ,,QICL
                                        %CL1QO,,QOCL
                                        %CLSQ ,,QICL
                                        %CL1QO,,QOCL
IFN VIDP,DNVDIU::       REPEAT 4,               TVCCLS  ;TVC
IFN PDP6P,PDPUIO::      REPEAT 4,       %CLS6 ,,PDPCLS  ;USR IN PDP10 MODE
IFN TABP,DTABUI::       REPEAT 2,       %CLSNR,,TABUSR  ;TABLET
IFN NMTCS,[
MTUAIX::                REPEAT 3,               MTICL   ;MAG TAPE
                        REPEAT 3,               MTOCL
        ]
JDUAI::         REPEAT 3,[
                                        %CLSJI,,JOBCLS  ;JOB DEVICE
                                        %CLSJO,,JOBCLS
                        ]
BDUAI::                 REPEAT 6,       %CLSBJ,,CPOPJ   ;BOJ
IIOPOP::                                [JRST 4,CPOPJ]  ;INTERRUPT ON IOPOP DEVICE
ISPY::                                          CPOPJ   ;SPY
STYDUI::        REPEAT 2,[                              ;PSEUDO TTY
                                        %CLSST,,STYICL
                                        %CLSST,,STYOCL
                        ]
IFN NCPP,NETDUI::       REPEAT 4,               NETCLS  ; Arpanet NCP
IFN TCPP,TCPDUI::       REPEAT 4,               TCPCLS  ; Internet TCP
IFN INETP,IPQDN::                               IPQCLS  ; Internet Queue
IFN MSPP,MSPIO::                                MSCLOS  ;MESS SWITCHER (DM)
IFN STKP,STKDP::                                STKCLS  ;STANFORD KEYBOARD
IFN NTYP,NTYIT::        REPEAT 4,               NTYCLS  ;A KLUDGE ON THE NTY
        OFFSET 0
IF2,IFN .-CLSTB-LIOTTB,.ERR BARF AT CLSTB
\f
;DISPATCH TABLE FOR .IOT UUO
;TRANSFERED THROUGH USING RIGHT HALF OF I/O CHANNEL WORD AS AN INDEX
%IOT==1,,525252
%IOTBK==400000  ;4.9 = 1 => BLOCK  = 0 => UNIT
%IOTOT==200000  ;4.8 = 1 => OUTPUT  = 0 => INPUT     "
%IOTBP==100000  ;4.7 = 1 => THERE IS A SPECIAL ROUTINE FOR SIOT,
                 ;AND ITS ADDRESS IS -1 + RH(IOTTB WORD).
%IOTSP==40000   ;4.6 => THIS DEVICE IS FUNNY. SIOT ISN'T ALLOWED,
                 ;AND IOT LETS THE DEVICE RTN DO ALL THE WORK.
                ;PRESENT ONLY FOR UNIT INPUT MODES.
%IOT10==20000   ;4.5 => THIS CHANNEL WAS OPENED WITH BIT 1.4 SET IN MODE
%IOTIM==10000   ;4.4 => THIS CHANNEL WAS OPENED WITH BIT 1.3 (IMAGE MODE) SET IN MODE
;       4000    ;4.3 COPIES %IOTBK.   THUS, BITS 4.5-4.2 REFLECT THE BOTTOM 4 BITS
;       2000    ;4.2 COPIES %IOTOT.    OF THE OPEN-MODE.
%IOTOM==36000   ;BITS 4.5 - 4.2

%IOTBO==606000  ;BLOCK OUTPUT.
%IOTBI==404000  ;BLOCK INPUT.
%IOTUO==202000  ;UNIT OUTPUT.
%IOTUI==000000  ;UNIT INPUT.

IOTTB:          IOCER8
        OFFSET -IOTTB
TYIDN::         %IOTUI,,TYI     ;TTY ENTRIES MUST BE COMPACT
TYIBN::         %IOTBI,,TTYBI
TYODN::         %IOTUO,,TYO (%IOTBP)
TYOBN::         %IOTBO,,TTYBO   ;LAST TTY DEVICE
NLIDN::         %IOTUI,,NULI
NLBIDN::        %IOTBI,,NULBI
NLODN::         %IOTUO,,CPOPJ
NLBDN::         %IOTBO,,NULBOD
UWIDN::         %IOTUI,,UWI (%IOTIM)
UBIDN::         %IOTBI,,UBI
UWODN::         %IOTUO,,UWO (%IOTIM)
UBODN::         %IOTBO,,UBO
FUWIDN::        %IOTUI,,UWI (%IOT10)
FUBIDN::        %IOTBI,,UBI (%IOT10)
DNDIRH::        IOCR10
DNTRAP::        TRPDEV
IFN CHAOSP,[
CHAIDN::        %IOTUI+%IOTBP,,CHAUI
CHAODN::        %IOTUO+%IOTBP,,CHAUO
];CHAOSP
IFN NUNITS,[
DNUACII::       %IOTUI,,UASCII
DNUACCO::       %IOTUO,,UASCCO
DNUBKI::        %IOTBI,,UBLKI
DNUBKO::        %IOTBO,,UBLKO
DNUDTI::        %IOTUI,,UDATAI (%IOTIM)
DNUDTO::        %IOTUO,,UDATAO (%IOTIM)
]
IFN OLPTP,[
LPTDN::         %IOTUO,,PILPT1
LPTBN::         %IOTBO,,BLPTO
]
IFN NLPTP,[
NLPTDN::        %IOTUO,,NLPT1
NLPTBN::        %IOTBO,,BNLPTO
]
IFN GLPTP,[
GLPTDN::        %IOTUO,,GLPTDO (%IOTBP)
GLPTBN::        %IOTBO,,GLPTBO
]
DIRCHN::        %IOTUI,,DIRCH
DIRBN::         %IOTBI,,DIRB
NDATAI::        %IOTUI,,DDATAI (%IOTIM+%IOTBP)
NBLKI::         %IOTBI,,DBLKI (%IOTIM)
IFN VIDP,[
NVIDOP::        %IOTUI,,NVIDIT (%IOTSP)
BNVIDO::        %IOTBI,,BNVIDI
]
IFN PLTP,[
PLTDN::         %IOTUO,,PLOT
PLTBN::         %IOTBO,,BPLOT
]
IFN PTRP,[
PTPI::          %IOTUO,,PIPUN (%IOT10)
PTPA::          %IOTUO,,APIPUN
PTPB::          %IOTBO,,BPIPUN
PTPWA::         %IOTUO,,WAPIPN (%IOTIM)
PTPWB::         %IOTBO,,WBPIPN (%IOTIM)
]
IFN IMXP,[
IMPXDN::        %IOTUI,,IMPXS (%IOTSP)
IMXDN::         %IOTUI,,IMPXS1 (%IOTSP)
BIMXDN::        %IOTBI,,BIMXS1 (%IOTSP)
BIMPXD::        %IOTBI,,BIMPXS (%IOTSP)
]
IFN OMXP,[
OMPXDN::        %IOTUO,,OMPXS (%IOTSP)
OMXDN::         %IOTUO,,OMXDS (%IOTSP)
BOMXDN::        %IOTBO,,BOMXDS (%IOTSP)
BOMPXD::        %IOTBO,,BOMPXS (%IOTSP)
]
DCLUAI::        %IOTUI,,CLUAI
DCLUAO::        %IOTUO,,CLUAO
DCLBI::         %IOTBI,,CLBI
DCLBO::         %IOTBO,,CLBO
DCLUBI::        %IOTUI,,CLUBI (%IOTIM)
DCLUBO::        %IOTUO,,CLUBO (%IOTIM)
IFN PTRP,[
REDUAI::        %IOTUI,,PTRUAI
REDBAI::        %IOTBI,,PTRBAI
REDUII::        %IOTUI,,PTRUII (%IOTIM)
REDBII::        %IOTBI,,PTRBII (%IOTIM)
REDUTI::        %IOTUI,,PTRUTI (%IOT10)
]
IFN 340P,[
DN340B::        %IOTBO,,340B    ;340 ENTRIES MUST BE COMPACT; BLOCK FIRST, THEN UNIT
DN340W::        %IOTUO,,340W (%IOTSP)
DN340C::        %IOTUO,,340C (%IOTSP)
DN340H::        %IOTUO,,340H (%IOTSP)
;DN340I::       %IOTUO,,340I (%IOTSP)
DN340L::        ;LAST 340 DEVICE ENTRY
]
IFN CODP,[
CODDN::         %IOTUO,,SEND
CODBN::         %IOTBO,,BSEND
]
DQUAI::         %IOTUI,,QUAI (%IOTBP)
DQUAO::         %IOTUO,,QUAO (%IOTBP)
DQBI::          %IOTBI,,QBI
DQBO::          %IOTBO,,QBO
DQUII::         %IOTUI,,QUII (%IOTIM %IOTBP)
DQUIO::         %IOTUO,,QUIO (%IOTIM %IOTBP)
IFN VIDP,[
DNVDIU::        %IOTUI,,RNVDIU (%IOTSP)
DNVDIB::        %IOTBI,,RNVDIB (%IOTSP)
DNVDOU::        %IOTUO,,RNVDOU (%IOTSP)
DNVDOB::        %IOTBO,,RNVDOB (%IOTSP)
]
IFN PDP6P,[
PDPUIO::        %IOTUO,,UWO     ;BUT JOB WILL BE -1 TO INDICATE PDP6
PDPBIO::        %IOTBO,,UBO
PDPUII::        %IOTUI,,UWI
PDPBII::        %IOTBI,,UBI
]
IFN TABP,[
DTABUI::        %IOTUI,,UTABI
DTABBI::        %IOTBI,,BTABI
]
IFN NMTCS,[
MTUAIX::        %IOTUI,,MTUAI (%IOTBP)  ;MAGTAPE
MTUIIX::        %IOTUI,,MTUII (%IOTIM %IOTBP)
MTBIX::         %IOTBI,,MTBI
MTUAOX::        %IOTUO,,MTUAO (%IOTBP)
MTUIOX::        %IOTUO,,MTUIO (%IOTIM %IOTBP)
MTBOX::         %IOTBO,,MTBO
]
JDUAI::         %IOTUI,,JBUI(%IOTBP)
JDUAO::         %IOTUO,,JBUI(%IOTBP)
JDBI::          %IOTBI,,JBBI
JDBO::          %IOTBO,,JBBI
JDUII::         %IOTUI,,JBUI (%IOTBP %IOTIM)
JDUIO::         %IOTUO,,JBUI (%IOTBP %IOTIM)
BDUAI::         %IOTUI,,BJUI
BDUAO::         %IOTUO,,BJUO
BDBI::          %IOTBI,,BJBI
BDBO::          %IOTBO,,BJBO
BDUII::         %IOTUI,,BJUI (%IOTIM)
BDUIO::         %IOTUO,,BJUO (%IOTIM)
IIOPOP::                [JRST 4,CPOPJ]  ;INTERRUPT ON IOPOP DEVICE
ISPY::          %IOTUI,,SPYI
STYDUI::        %IOTUI,,STTYI   ;PSEUDO TTY
STYDUO::        %IOTUO,,STTYW
STYDBI::        %IOTBI,,STTBI
STYDBO::        %IOTBO,,STTBO
IFN NCPP,[
NETDUI::        %IOTUI,,NETI
NETDUO::        %IOTUO,,NETW (%IOTBP)
NETDBI::        %IOTBI,,NETBI
NETDBO::        %IOTBO,,NETBO
]
IFN TCPP,[
TCPDUI::        %IOTUI,,TCPI (%IOTBP)
TCPDUO::        %IOTUO,,TCPW (%IOTBP)
TCPDBI::        %IOTBI,,TCPBI
TCPDBO::        %IOTBO,,TCPBO
]
IFN INETP,[
IPQDN::         IPQIO           ; No I/O calls used on this dev!
]
IFN MSPP,[
MSPIO::         IOCR10
]
IFN STKP,[
STKDP::         STKI
]
IFN NTYP,[
NTYIT::         %IOTUI,,NTYTI   ;KLUDGE FOR FAST, LARGE BUFFER ON NTY
NTYOT::         %IOTUO,,NTYTO
NTYBIT::        %IOTBI,,NTYBI
NTYBOT::        %IOTBO,,NTYBO
]
        OFFSET 0
LIOTTB==.-IOTTB
\f
;TABLES FOR VARIOUS CHANNEL STATUS CALLS

;DCHSTB - INDEXED BY IOTTB INDEX (RH OF IOCHNM)
;LH SIXBIT MAIN DEVICE NAME
;1.1-2.3 INDEX INTO THE NEXT TWO TABLES
;2.4-2.9 SYSTEM PERIPHERAL DEVICE CODE (FOR .STATUS)
.SEE DCHSTB     ;ASSEMBLED SECOND TO GET VALUES OF THE TEMPORARY %%dev SYMBOLS.

;DSTSTB - INDEX FROM DCHSTB
;LH STATUS ROUTINE, RH WHYINT ROUTINE (OPNL34 IF DEVICE DOESN'T GIVE 2ND WD INTS)

DSTSTB:         CPOPJ,,OPNL44   ;0 CHANNEL NOT OPEN
                STDSTA,,OPNL34  ;1 RANDOM DEVICE
                CPOPJ,,OPNL34   ;2 OTHER KIND OF RANDOM DEVICE
                STATYI,,TYIWHY  ;3 TTY INPUT
                STATYO,,TYOWHY  ;4 TTY OUTPUT
                CPOPJ,,OPNL34   ;5 USR DEVICE
                CPOPJ,,OPNL34   ;6 DIR "DEVICE"
                CLISTA,,OPNL34  ;7 CORE LINK INPUT
                STDSTA,,OPNL34  ;10 CORE LINK OUTPUT
                CPOPJ,,OPNL34   ;11 DISK
                JBSTAT,,OPNL22  ;12 JOB DEVICES (WHYINT SHOULDN'T GET HERE)
                CPOPJ,,OPNL34   ;13 BOJ DEVICE
                STASTI,,STIWHY  ;14 STY INPUT
                STASTO,,STOWHY  ;15 STY OUTPUT
                CPOPJ,,TRPDEV   ;16 TRAP DEVICE
                CPOPJ,,OPNL34   ;17 DIRHNG DEVICE
                CPOPJ,,OPNL34   ;20 SPY DEVICE
OFFSET -DSTSTB          ;BEGIN OPTIONAL DEVICES
IFN NMTCS, %%MT::  STAMTC,,OPNL34
IFN NUNITS,%%UTP:: CPOPJ,,OPNL34
IFN OLPTP, %%OLP:: STALPT,,OPNL34
IFN NCPP,  %%NET:: STANET,,NETWHY
IFN TCPP,  %%TCP:: TCPSTA,,TCPWHY
IFN INETP, %%IPQ:: IPQSTA,,IPQWHY
IFN CHAOSP,%%CHA:: CPOPJ,,CHAWHY
OFFSET 0

;DRFNTB - INDEX FROM DCHSTB
;LH RFNAME ROUTINE, RH RFPNTR ROUTINE OR OPNL34 IF NOT RANDOM ACCESS

DRFNTB:         CPOPJ,,OPNL44   ;0 CHNL NOT OPEN
                CPOPJ,,OPNL34   ;1 RANDOM DEVICE
                CPOPJ,,OPNL34   ;2 OTHER KIND OF RANDOM DEVICE
                RCHTTY,,OPNL34  ;3 TTY INPUT
                RCHTTY,,OPNL34  ;4 TTY OUTPUT
                RCHUSR,,RFPUSR  ;5 USR DEVICE
                RCHDIR,,OPNL34  ;6 DIR "DEVICE"
                RCHCLO,,OPNL34  ;7 CORE LINK INPUT
                RCHCLO,,OPNL34  ;10 CORE LINK OUTPUT
                RCHQSK,,RFPQSK  ;11 DISK
                RFNJOB,,RFPJOB  ;12 JOB DEVICES
                RCHBOJ,,OPNL34  ;13 BOJ DEVICE
                RCHSTY,,OPNL34  ;14 STY INPUT
                RCHSTY,,OPNL34  ;15 STY OUTPUT
                CPOPJ,,CPOPJ    ;16 TRAP DEVICE
                RCHDRH,,OPNL34  ;17 DIRHNG DEVICE
                SPYRCH,,OPNL34  ;20 SPY DEVICE
OFFSET -DRFNTB          ;BEGIN OPTIONAL DEVICES
IFN NMTCS, %%MT::  RCHMGT,,OPNL34
IFN NUNITS,%%UTP:: RCHUTP,,OPNL34
IFN OLPTP, %%OLP:: CPOPJ,,OPNL34
IFN NCPP,  %%NET:: NETRCH,,OPNL34
IFN TCPP,  %%TCP:: TCPRCH,,TCPRFP
IFN INETP, %%IPQ:: IPQRCH,,IPQRFP
IFN CHAOSP,%%CHA:: CHARCH,,OPNL34
OFFSET 0
IFN <.-DRFNTB>-<DRFNTB-DSTSTB>, .ERR DRFNTB & DSTSTB NOT SAME LENGTH
\f
DEFINE XX NTIMES,DEVNAM,DN,SNXXX,IDX
IFNB DN, DN==:.-DCHSTB  ;CHECK THAT DCHSTB IS IN SAME ORDER AS IOTTB
IFG SIXBIT/DEVNAM/, ZZ==[SIXBIT/DEVNAM/]  ;DECIDE WHETHER FITS IN LH
.ELSE [
IFE SIXBIT/DEVNAM/&777777, ZZ==(SIXBIT/DEVNAM/)
.ELSE ZZ==[SIXBIT/DEVNAM/]
]
REPEAT NTIMES, ZZ,,SNXXX_14+IDX
TERMIN

DCHSTB: XX 1,,,,0                       ;CHNL NOT OPEN
        XX 2,TTY,TYIDN,,3               ;TTY INPUT
        XX 2,TTY,TYODN,,4               ;TTY OUTPUT
        XX 4,NUL,NLIDN,SNNUL,1          ;NUL DEVICE
        XX 4,USR,UWIDN,SNUSR,5          ;USR DEVICE
        XX 2,USR,FUWIDN,SNFUSR,5        ;FOREIGN USR
        XX 1,DIRHNG,DNDIRH,SNDIRH,17    ;DIRHNG
        XX 1,TRAP,DNTRAP,SNTRAP,16      ;TRAP
IFN CHAOSP, XX 2,CHAOS,CHAIDN,SNCHA,%%CHA       ;CHAOS NET
IFN NUNITS, XX 6,UT,DNUACII,SNUTC,%%UTP ;MICRO TAPE
IFG LPTP-1, XX 2,OLP,LPTDN,SNLPD,%%OLP  ;DATA PRODUCTS LPT IN 2-LPT SYSTEM
.ELSE IFN OLPTP, XX 2,LPT,LPTDN,SNLPD,%%OLP     ;DATA PRODUCTS LPT
IFN NLPTP,  XX 2,LPT,NLPTDN,SNLPV,1     ;"VOGUE" LPT (ACTUALLY ODEC)
IFN GLPTP,  XX 2,LPT,GLPTDN,SNLPV,1     ;GOULD LPT
        XX 4,DIR,DIRCHN,SNDIR,6         ;DIR "DEVICE"
IFN VIDP,   XX 2,NVD,NVIDOP,SNBAT,2     ;VIDISSECTOR
IFN PLTP,   XX 2,PLT,PLTDN,SNPLT,1      ;PLOTTER
IFN PTRP,   XX 5,PTP,PTPI,SNPTP,1       ;PAPER TAPE PUNCH
IFN IMXP,   XX 4,IMX,IMPXDN,SNIMPX,1    ;INPUT A/D MULTIPLEXOR
IFN OMXP,   XX 4,OMX,OMPXDN,SNOMPX,1    ;OUTPUT A/D MULTIPLEXOR
        XX 3,CLO,DCLUAI,SNCLK,7         ;CORE LINK INPUT
        XX 3,CLO,DCLBO,SNCLK,10         ;CORE LINK OUTPUT
IFN PTRP,   XX 5,PTR,REDUAI,SNPTR,1     ;PAPER TAPE READER
IFN 340P,   XX 4,DIS,DN340B,SN340,2     ;340 DISPLAY
;IFN 340P,  XX 1,IDS,DN340I,SN340I,2    ;340 INTERPRETIVE DISPLAY
IFN CODP,   XX 2,COD,CODDN,SNCOD,1      ;CODE
        XX 6,DSK,DQUAI,SN2311,11        ;DISK
IFN VIDP,   XX 4,TVC,DNVDIU,SNBAT,2     ;TV CAMERA
IFN PDP6P,  XX 4,PDP,PDPUIO,SNPDP,5     ;PDP-6 DEVICE
IFN TABP,   XX 2,TAB,DTABUI,SNTAB,2     ;TABLET
IFN NMTCS,  XX 6,MT0,MTUAIX,SNMTC,%%MT  ;MAGTAPE
        XX 6,JOB,JDUAI,SNJOB,12         ;JOB DEVICES
        XX 6,BOJ,BDUAI,SNBOJ,13         ;BOJ DEVICE
        XX 1,IIP,IIOPOP,0,2             ;INTERRUPT-ON-IOPOP DEVICE
        XX 1,SPY,ISPY,SNSPY,20          ;SPY
REPEAT 2,[
        XX 1,STY,,SNSTY,14              ;STY INPUT
        XX 1,STY,,SNSTY,15              ;STY OUTPUT
]
IFN NCPP,  XX 4,NET,NETDUI,SNNET,%%NET  ; Arpanet NCP
IFN TCPP,  XX 4,TCP,TCPDUI,SNTCP,%%TCP  ; Internet TCP
IFN INETP, XX 1,IPQ,IPQDN,SNIPQ,%%IPQ   ; Internet Queue
IFN MSPP,  XX 1,MSP,MSPIO,SNMSP,2       ;MS SWITCH HACK
IFN STKP,  XX 1,STK,STKDP,SNSTK,2       ;STANFORD KEYBOARD
IFN NTYP,  XX 4,NTY,NTYIT,SNNUL,2       ;NTY 11 KLUDGE

IFN .-DCHSTB-LIOTTB,.ERR BARF AT DCHSTB
EXPUNGE XX,%%MT,%%UTP,%%OLP,%%NET,%%TCP,%%CHA,%%IPQ

DCHSTE==.-1     ;END FOR GETSYS (CHDEVS)
\f
;RSTB - INDEXED BY IOTTB INDEX FROM RH(IOCHNM)
;THIS TABLE IS IN 5-BIT BYTES; THE VALUES ARE THE INDICES
;INTO THE RSTB1 AND DFRCTB TABLES.
.SEE RSTB       ;ASSEMBLED SECOND TO GET VALUES OF TEMPORARY %%dev SYMBOLS.

;RSTB1 - INDEX FROM RSTB (BELOW)
;LH IOPUSH/POP ROUTINE, RH RESET ROUTINE
RSTB1:  CPOPJ,,CPOPJ    ;0 RANDOM DEVICE
        TYIIOP,,TYIRS   ;1 TTY INPUT
        TYOIOP,,TYORS   ;2 TTY OUTPUT
        CPOPJ,,USRST    ;3 USR DEVICE
        CPOPJ,,JBIRS    ;4 JOB INPUT
        CPOPJ,,JBORS    ;5 JOB OUTPUT
        IIOPPR,,[JRST 4,CPOPJ]  ;6 INTERRUPT ON IOPOP DEVICE
        STYIIP,,STYIRS  ;7 STY INPUT
        STYOIP,,STYORS  ;10 STY OUTPUT
        CPOPJ,,CPOPJ    ;11 DISK OUTPUT
        DIRHIP,,CPOPJ   ;12 DIRHNG
        CPOPJ,,TRPDEV   ;13 TRAP
        OFFSET -RSTB1   ;OPTIONAL DEVICES BEGIN HERE
IFN OLPTP, %%LPT:: CPOPJ,,LPTRS
IFN NLPTP, %%NLP:: CPOPJ,,NLPTRS
IFN PLTP,  %%PLT:: CPOPJ,,PLTRS
IFN PTRP,  %%PTR:: CPOPJ,,PTRRS
IFN PTRP,  %%PTP:: CPOPJ,,PUNCLR
IFN IMXP,  %%IMX:: CPOPJ,,IMPXRS
IFN 340P,  %%340:: CPOPJ,,DSIZAP
IFN CODP,  %%COD:: CODIOP,,CODRS
IFN PDP6P, %%PDP:: PDPIOP,,PDPRST
IFN TABP,  %%TAB:: CPOPJ,,TABCLR
IFN NCPP,  %%NET:: NETIOP,,NETRS
IFN TCPP,  %%TCP:: TCPIOP,,TCPRST
IFN INETP, %%IPQ:: IPQIOP,,IPQRST
IFN STKP,  %%STK:: CPOPJ,,STKRS
IFN CHAOSP,%%CHA:: CHAIOP,,CPOPJ
        OFFSET 0

;DFRCTB - INDEX FROM RSTB (BELOW)
;LH FORCE ROUTINE, RH FINISH ROUTINE
DFRCTB: OPNL34,,OPNL34  ;0 RANDOM DEVICE
        OPNL2,,OPNL2    ;1 TTY INPUT (ILLEGAL)
        POPJ1,,TTYFIN   ;2 TTY OUTPUT
        OPNL34,,OPNL34  ;3 USR
        OPNL2,,OPNL2    ;4 JOB (SHOULDN'T GET HERE?)
        OPNL22,,OPNL22  ;5 JOB (SHOULDN'T GET HERE?)
        OPNL22,,OPNL22  ;6 IIP (SHOULDN'T GET HERE)
        OPNL2,,OPNL2    ;7 STY INPUT (ILLEGAL)
        POPJ1,,STYFIN   ;10 STY OUTPUT
        QSKFRC,,QSKFIN  ;11 DISK OUTPUT
        OPNL34,,OPNL34  ;12 DIRHNG
        TRPDEV,,TRPDEV  ;13 TRAP
        OFFSET -DFRCTB  ;OPTIONAL DEVICES BEGIN HERE
IFN OLPTP, %%LPT:: POPJ1,,POPJ1 ;NEED TO WRITE THESE
IFN NLPTP, %%NLP:: POPJ1,,POPJ1 ;NEED TO WRITE THESE
IFN PLTP,  %%PLT:: POPJ1,,POPJ1 ;NEED TO WRITE THESE
IFN PTRP,  %%PTR:: OPNL34,,OPNL34
IFN PTRP,  %%PTP:: POPJ1,,PUNFIN
IFN IMXP,  %%IMX:: OPNL34,,OPNL34
IFN 340P,  %%340:: OPNL34,,OPNL34
IFN CODP,  %%COD:: POPJ1,,CODFIN
IFN PDP6P, %%PDP:: OPNL34,,OPNL34
IFN TABP,  %%TAB:: OPNL34,,OPNL34
IFN NCPP,  %%NET:: NETFRC,,NETFIN
IFN TCPP,  %%TCP:: TCPFRC,,TCPFIN
IFN INETP, %%IPQ:: IPQFRC,,IPQFIN
IFN STKP,  %%STK:: OPNL34,,OPNL34
IFN CHAOSP,%%CHA:: CHAFRC,,CHAFIN
        OFFSET 0
\f
;TABLE OF INDICES INTO THE RSTB1, DFRCTB TABLES ON THE PRECEDING PAGE
;THESE INDICES ARE UNRELATED TO THE INDICES IN DCHSTB A COUPLE PAGES BACK.
;NOTE THAT THE %% SYMBOLS ARE PURELY TEMPORARY AND EXPUNGED AT THE BOTTOM OF THIS PAGE.

RSTB:   .BYTE 5

                        0       ;CHNL NOT OPEN
                REPEAT 2,1      ;TTY INPUT
                REPEAT 2,2      ;TTY OUTPUT
                REPEAT 4,0      ;NUL DEVICE
                REPEAT 4,3      ;USR DEVICE
                REPEAT 2,0      ;FOREIGN USR
                        12      ;DIRHNG
                        13      ;TRAP
IFN CHAOSP,     REPEAT 2,%%CHA
IFN NUNITS,     REPEAT 6,0      ;DEC TAPE
IFN OLPTP,      REPEAT 2,%%LPT
IFN NLPTP,      REPEAT 2,%%NLP
IFN GLPTP,      REPEAT 2,0
                REPEAT 4,0      ;DIR "DEVICE"
IFN VIDP,       REPEAT 2,0
IFN PLTP,       REPEAT 2,%%PLT
IFN PTRP,       REPEAT 5,%%PTP
IFN IMXP,       REPEAT 4,%%IMX
IFN OMXP,       REPEAT 4,0
                REPEAT 6,0      ;CORE LINK.
IFN PTRP,       REPEAT 5,%%PTR
IFN 340P,       REPEAT 4,%%340
;IFN 340P,              0
IFN CODP,       REPEAT 2,%%COD  ;CODE
                REPEAT 3, 0 ? 11 ;DISK IN, DISK OUT
IFN VIDP,       REPEAT 4,0
IFN PDP6P,      REPEAT 4,%%PDP  ;PDP-6 DEVICE
IFN TABP,       REPEAT 2,%%TAB
IFN NMTCS,      REPEAT 6,0      ;MAGTAPE
                REPEAT 3,[4
                          5
                ]               ;JOB
                REPEAT 3,[0     ;BOJ INPUT
                          0     ;BOJ OUTPUT
                ]               ;BOJ
                        6       ;INTERRUPT ON IOPOP DEVICE
                        0       ;SPY
                7 ? 10 ? 7 ? 10 ;PSEUDO-TTY
IFN NCPP,       REPEAT 4,%%NET  ;NET RESET INR/INS
IFN TCPP,       REPEAT 4,%%TCP  ; TCP RESET
IFN INETP,      %%IPQ           ; Internet Queue
IFN MSPP,               0       ;MS SWITCH HACK
IFN STKP,               %%STK   ;STANFORD KEYBOARD
IFN NTYP,       REPEAT 4,0      ;NTY 11 KLUDGE

IFN LIOTTB-.BYTC,.ERR BARF AT RSTB
        .BYTE
EXPUNGE %%LPT,%%NLP,%%PLT,%%PTR,%%PTP,%%IMX,%%340,%%COD,%%PDP,%%TAB,%%NET,%%TCP,%%STK,%%CHA,%%IPQ
\f
DEFINE DVHR X,Y
X!Y!TERMIN

DEFINE DV NAME,OPNRTE,BITS,TAG
        SIXBIT/NAME/
DVHR [DEFINE DVHR X,Y
X!][TAG BITS,,OPNRTE
Y!TERMIN]
TERMIN

;DEVICE TABLES FOR AOPEN
;
;DEVTAB  SIXBIT NAME
;DEVADR
 %DVIN==400000  ;4.9 DEVICE CAN DO INPUT
 %DVOUT==200000 ;4.8 DEVICE CAN DO OUTPUT
 %DVDIR==100000 ;4.7 DEVICE CAN GIVE DIRECTORY
 %DVDEL==40000  ;4.6 ALLOW DELETE/RENAME
 %DVLNK==20000  ;4.5 ALLOW MLINK
                ;RIGHT HALF, OPEN ROUTINE ADDRESS
%DV==1,,520000  ;BIT TYPEOUT MASK

DEVTAB:
IFN NLPTP,      DV LPT,NLPTO,%DVOUT
IFG OLPTP-NLPTP,DV LPT,LPTO,%DVOUT
IFG LPTP-1,     DV OLP,LPTO,%DVOUT
IFN GLPTP,      DV LPT,GLPTO,%DVOUT
IFN TTLPTP,     DV LPT,LPTO,%DVOUT

                DV DSK,QSKO,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK,DVAQSK:
                DV COM,COMO,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK
        MNAME [ DV ],QSKO,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK     ;"AI:" ON
                                                                ; AI, ETC.
IFE MCOND MC,[  ; When MC and MX swap names, these names will stay
IFN KL10P,      DV KL,QSKO,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK
IFN KS10P,      DV KS,QSKO,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK
] ;MC
IFE MCOND MX,[
IFN KL10P,      DV KL,QSKO,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK
IFN KS10P,      DV KS,QSKO,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK
] ;MX
                DV SYS,SYSO,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK
                DV DNRF,DNRFO,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK ;DSK NO REF DATE
                DV DNR,DNRFO,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK ;DSK NO REF DATE
                DV DIRHNG,DIRHO,%DVIN+%DVDIR
                DV TRAP,TRPDEV,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK
                DV TTY,TTYO1,%DVIN+%DVOUT+%DVDIR
                DV NUL,NULO,%DVIN+%DVOUT
                DV USR,USRO,%DVIN+%DVOUT
IFN VIDP,       DV NVD,NVIDI,%DVIN+%DVOUT
IFN CHAOSP,     DV CHAOS,CHASO,%DVIN+%DVOUT
IFN NCPP,       DV NET,NETO,%DVIN+%DVOUT
IFN TCPP,       DV TCP,TCPO,%DVIN+%DVOUT
IFN INETP,      DV IPQ,IPQO,%DVIN+%DVOUT
IFN MSPP,       DV IPC,IPCO,%DVIN+%DVOUT
                DV STY,STTYO,%DVIN+%DVOUT
                DV JOB,JOBO,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK,DVAJOB:
                DV BOJ,BOJO,%DVIN+%DVOUT
                DV OJB,JOBO,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK
IFN STKP,       DV STK,STKO,%DVIN
IFN PLTP,       DV PLT,PLOTO,%DVOUT
IFN PLTP,       DV IPL,IPLO,%DVOUT              ;INTERPRETED PLOTTER
IFN XGP,        DV XPL,XPLO,%DVOUT
IFN IMXP,       DV IMX,IMPXO,%DVIN
IFN OMXP,       DV OMX,OMPXO,%DVOUT
IFN PTRP,       DV PTR,PTRO,%DVIN
IFN PTPP,       DV PTP,PTPO,%DVOUT
IFN 340P,       DV DIS,DISO,%DVOUT              ;340 AS OUTPUT DEVICE
;IFN 340P,      DV IDS,IDISO,%DVOUT             ;340 AS INTERPRETED DISPLAY
                DV CLU,CLUO,%DVIN+%DVOUT+%DVDIR+%DVDEL
                DV CLO,CLOO,%DVIN+%DVOUT+%DVDIR+%DVDEL
                DV CLI,CLIO,%DVOUT+%DVDIR+%DVDEL
                DV CLA,CLAO,%DVIN+%DVDIR+%DVDEL
IFN CODP,       DV COD,CODO,%DVOUT
IFN VIDP,       DV TVC,TVCO,%DVIN+%DVOUT
                DV ERR,ERRO,%DVIN
IFN TPLP+TTLPTP&DEMON, DV TPL,TPLO,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK
IFN TABP,       DV TAB,TABO,%DVIN
                DV SPY,SPYO,%DVIN
                DV COR,CORO,%DVDIR              ;DIR=LAST LINE OF TTY^F
IFN NTYP,       DV NTY,NTYOPN,%DVIN+%DVOUT      ;NTY 11 KLUDGE

NDEVS==.-DEVTAB

DVT1:           DV TTY,TTYO,%DVIN+%DVOUT+%DVDIR
                DV TY,TTYO,%DVIN+%DVOUT+%DVDIR
                DV T,TTYO,%DVIN+%DVOUT+%DVDIR
IFN NUNITS,     DV UT,UTO,%DVIN+%DVOUT+%DVDIR+%DVDEL,DVAUT:
                DV STY,STTYOA,%DVIN+%DVOUT
                DV ST,STTYOA,%DVIN+%DVOUT
                DV S,STTYOA,%DVIN+%DVOUT
                DV DSK,QSKUO,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK  ;PARTICULAR UNIT
                DV DK,QSKUO,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK   ;PARTICULAR UNIT
                DV PK,QSKPO,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK   ;PARTICULAR PACK
                DV P,QSKPO,%DVIN+%DVOUT+%DVDIR+%DVDEL+%DVLNK    ;PARTICULAR PACK
IFN NMTCS,      DV MT,MAGTO,%DVIN+%DVOUT        ;MAGTAPE

NDV1==.-DVT1
EDEVS==.-1      ;END FOR GETSYS (DEVS)

DEVADR: DVHR
IFN .-DEVADR-NDEVS-NDV1,.ERR DVHR LOST
\f
SUBTTL .OPER, .CALL DISPATCH

AOPER:  MOVE J,R        ;AC FIELD OF UUO
        ADDI R,IOCHNM(U)        ;SET UP IO CHANNEL REFERENCE POINTER
        CAIL C,MXOPR    ;SKIP IF UUO E FIELD IS LESS THAN MAX OPR
        JRST ILUUO      ;ILLEGAL OPER
        JRST @OPRDSP(C) ;LEGAL OPER-- DISPATCH ON E FIELD OF UUO

OPRDSP: ILUUO
        OPRIRP A!X      ;AITYI,ALISTEN,ASLEEP,ETC.

;
;CALL DISPATCH
;
ACALL:  MOVE B,C        ;SET UP COPY OF ERR ADR NOT TO BE RELOCATED
        JRST @CALDIS(R) ;DISPATCH INDEX OF UUO'S AC FIELD

CALDIS: ASYSC
        ADISMIS
        ALOSE
        ATRANAD
        AVALRET ;4
        AUTRAN
        UACORE
        ATRNDL
        ADSTART ;10
        AFDELE
        ADSTL
        ASUSET
        ALTPEN  ;14
        AVSCAN
        APOTSET
REPEAT 20-.+CALDIS,ILUUO
\f
SUBTTL MISCELLANEOUS UUO'S

;SHUT DOWN SYSTEM

ASHUTD: UMOVE C,(J)             ;Arg is time to down in thirtieths.
        JUMPL C,AREVIV          ;Negative time means REVIVE.
        CAMG C,[43200.*30.*60.] ;If time is longer than thirty days
         CAIGE C,5*60.*30.      ; or less than five minutes
          POPJ P,               ;   Fail (prevent clock delta-T from losing).
        ADD C,TIME              ;Interval+now is when we will die.
        PUSHJ P,SWTL            ;Seize shutdown lock.
            SHUTLK
        SKIPGE SHUTDN           ;Already down?
         JRST LSWPOP            ; Yes.
        PUSHJ P,CLQDEL          ;Flush obsolete clock queue entry, if any.
            DEDBLK
        MOVEM C,SHUTDN          ;Remember time we will die.
        SUB C,TIME              ;Interval until death.
        LSH C,1                 ;Time till death after next clock-queue int.
        MOVEM C,DEDTIM          ;Remember time until death.
        PUSHJ P,DEATHX          ;Make DEATH entry on clock queue.
         BUG                    ; DEDTIM says time to die already?
        JRST LSWPJ1             ;Unlock shutdowns.

;READ TIME TILL SYSTEM DOWN

ADIETI: XCTR XW,[SETOM (J)]     ;READ -1 IF NOT GOING DOWN
        SKIPG A,SHUTDN
         POPJ P,                ;NOT DYING
        SUB A,TIME
        JRST APTUAJ             ;GIVE TO USER

;REVIVE SYS

AREVIV: PUSHJ P,SWTL
            SHUTLK
        SKIPN SHUTDN
         JRST LSWPOP            ;NOT DYING
        PUSHJ P,CLQDEL
            DEDBLK
        SETZM SHUTDN
        SETZM DEDTIM
        PUSHJ P,DEATHM
        JRST LSWPOP

;FROM CLOCK QUEUE BLOCK

DEATHZ: PUSHJ P,DEATHX
         SKIPA
          JRST CLQRET
        MOVSI T,SCLOUT
        PUSHJ P,SUPSET  ;DIE
        SETOM DEDTIM
        JRST CLQRET

;GET VARIOUS SYS STATUS

ASSTAT: CONO PI,CLKOFF
        SKIPLE A,SHUTDN
         SUB A,TIME
        SKIPG SHUTDN
         SUBI A,1       ;TIME TILL DOWN IF > 0,  -1 IF UP,  -2 IF DOWN
        CONO PI,CLKON
        MOVE B,SYSDBG
        MOVE C,SUSRS
        MOVE D,PARERR
        ADD D,NXMERR
        MOVE E,TIME
        MOVE TT,[ITSMCH]        ;SIXBIT NAME OF THIS MACHINE.
        MOVE I,[ITSVRS]
        MOVN Q,USRHI            ;Q GETS NUMBER OF FREE JOB SLOTS
        IDIVI Q,LUBLK
        ADDI Q,MAXJ
        MOVE J,USRHI
ASSTT1: SUBI J,LUBLK
        SKIPN UNAME(J)
         ADDI Q,1
        JUMPG J,ASSTT1
        JRST POPJ1
\f
SUBTTL SYMBOLIC SYSTEM CALL HANDLER

;IN ORDER @A...Z[\]^_ !".../0...9:;,=.? (THAT IS IN NUMERICAL ORDER)

SYSCTB: SIXBIT /ACCESS/ ;IOCHNL, ADR
        SIXBIT /ATTACH/
        SIXBIT /ATTY/
        SIXBIT /CALL/   ;SIXBIT /<NEXT CALL>/
IFN CHAOSP,[
        SIXBIT /CHAOSO/
        SIXBIT /CHAOSQ/
];CHAOSP
        SIXBIT /CLOSE/  ;IOCHNL
        SIXBIT /CNSGET/ ;GET SEMIPERMANENT TTY INFO
        SIXBIT /CNSSET/ ;SET SEMIPERMANENT INFO (TCMXH, TCTYP, TTYOPT, TTYCOM, ETC)
        SIXBIT /CORBLK/ ;HACK PAGE MAP
        SIXBIT /CORTYP/ ;READ STATUS OF PAGE.
        SIXBIT /DELETE/ ;FILE DELETE
        SIXBIT /DELEWO/ ;DELETE FILE OPEN ON SPEC'D CHANNEL
IFN DEMON,SIXBIT /DEMSIG/       ;SIGNAL DAEMON
        SIXBIT /DETACH/ ;DISOWN ENTIRE TREE
        SIXBIT /DIRSIZ/
        SIXBIT /DISMIS/
        SIXBIT /DISOWN/ ;DISOWN AN INFERIOR JOB
IFN DL10P, SIXBIT /DL10MP/
        SIXBIT /DSKUPD/ ;SIMULATE REFERENCE OF FILE
        SIXBIT /ECHOIN/ ;ECHO-NEGOTIATE
        SIXBIT /FILBLK/ ; READ NAME AREA OF FILE
        SIXBIT /FILLEN/ ;READ FILE LENGTH
        SIXBIT /FINISH/
        SIXBIT /FLAP/   ;TAPE #
        SIXBIT /FLUSH/  ;OLD NAME FOR FINISH, EVENTUALLY "
        SIXBIT /FORCE/
        SIXBIT /IOPOP/
        SIXBIT /IOPUSH/
        SIXBIT /IOT/    ;IOCHNL, QUAN OR BLK POINTER
IFN INETP,SIXBIT /IPKIOT/
        SIXBIT /ITYIC/
        SIXBIT /JOBCAL/ ;GENERAL JOBGET
        SIXBIT /JOBGET/ ;JOB CHNL
        SIXBIT /JOBINT/ ;JOB CHNL
        SIXBIT /JOBIOC/
        SIXBIT /JOBRET/ ;JOB CHNL
        SIXBIT /JOBREU/
        SIXBIT /JOBSTS/ ;SET JOB CHNL STATUS
IFN KL10P,SIXBIT /KLPERF/ ;ACTIVATE & CONTROL PERFORMANCE METER
        SIXBIT /LISTEN/ ;IOCHNL, ADR
        SIXBIT /LNKEDP/ ;DISK CH.  RETURNS NONZERO IF LINKS WERE TRACED TO OPEN IT.
        SIXBIT /LOAD/   ;USER CH, I/O CH, VARBLK
        SIXBIT /LOGIN/  ;SIXBIT /<NAME>/
        SIXBIT /LOGOUT/ ;. . .
        SIXBIT /LOSE/
        SIXBIT /MLINK/  ;MAKE LINK
IFN NCPP,       SIXBIT /NETAC/
        SIXBIT /NETBLK/ ;HANG ON NCP STATE
IFN IMPP,[
        SIXBIT /NETHST/ ;GETS STATUS OF HOST
        SIXBIT /NETIMP/ ;GETS STATUS OF IMP
];IMPP
IFN NCPP,       SIXBIT /NETINT/
IFN INETP,[     ; A temporary cond, should become permanent.
        SIXBIT /NETRFC/ ; Get pending request for connection
]
        SIXBIT /OPEN/   ;FILE OPEN
        SIXBIT /PDUMP/  ;USER CH, I/O CH, VARBLK
        SIXBIT /PGDUMP/ ;OLD NAME FOR PGWRIT, EVENTUALLY DELETE
        SIXBIT /PGWRIT/ ;DUMP PAGE OUT OF CORE
IFN CHAOSP,     SIXBIT /PKTIOT/
IFN QAUTHP,     SIXBIT /RAUTH/  ;READ AUTHOR OF FILE
        SIXBIT /RCHST/  ;READ OPENED FILENAMES & ACCESS POINTER
        SIXBIT /RCPOS/  ;READ CURSOR POS
IFN DEMON,SIXBIT /RDDMST/       ;READ DEAMON STATUS
        SIXBIT /RDMPBT/ ;READ FILE DUMPED BIT IOCHN, ADR
        SIXBIT /RELOAD/
        SIXBIT /RENAME/ ;FILE RENAME
        SIXBIT /RENMWO/ ;RENAME WHILE OPEN
        SIXBIT /REOWN/
        SIXBIT /RESET/
        SIXBIT /RESRDT/ ;RESTORE REFERENCE DATE
        SIXBIT /RFDATE/ ;READ TIME OF CREATION OF FILE IOCHN, ADR
        SIXBIT /RFNAME/ ;READ FILE NAME AND MODE CHANNEL OPEN TO
        SIXBIT /RFPNTR/ ;READ ACCESS POINTER
        SIXBIT /RQDATE/ ;READ DSK DATE
        SIXBIT /RSSIZE/ ;READ SCREEN SIZE
IFN QAUTHP,     SIXBIT /SAUTH/  ;SET AUTHOR OF FILE
        SIXBIT /SCML/   ;SET # COMMAND LINES
        SIXBIT /SCPOS/  ;SET TTY CURSOR POSITION
        SIXBIT /SDMPBT/ ;SET FILE DUMPED BIT IOCHN, ADR
        SIXBIT /SETIOC/ ;CAUSE IO CHANNEL ERROR IN JOB/BOJ CHANNEL
        SIXBIT /SFDATE/ ;SET TIME OF CREATION OF FILE IOCHN, ADR
        SIXBIT /SIOT/   ;IOT A STRING GIVEN B.P. AND LENGTH
        SIXBIT /SOPEN/  ;OPEN, TAKING MODE,,CHNL AND BP.
        SIXBIT /SRDATE/ ;SET REFERENCE DATE
        SIXBIT /SREAPB/ ;SET THE DO NOT REAP BIT
        SIXBIT /SSERVE/ ;Set .SERVER without timing errors
        SIXBIT /SSTATU/ ;READS VARIOUS SYSTEM STATUS
        SIXBIT /STATUS/
IFN DEMON,SIXBIT /STDMST/       ;SET DEAMON STATUS
        SIXBIT /STLGET/ ;GET INFO ON SERVER TELNET CONTROLLING A STY
        SIXBIT /STYGET/ ;GET INFO ABOUT SPECIFIED STY
IFN NETP,SIXBIT /STYNET/        ;CONNECT STY TO NETWORK SOCKETS, FOR TELNET SERVERS.
        SIXBIT /T11MP/  ;TEMP ? TEN11 HACKER
IFN TCPP,SIXBIT /TCPOPN/        ; Open TCP Internet connection
        SIXBIT /TRANAD/ ;CREATE TRANSLATION ENTRY
        SIXBIT /TRANCL/ ;CLEAR TRANSL. LIST(S) FOR A JOB.
        SIXBIT /TRANDL/ ;DELETE A TRANSL. ENTRY.
        SIXBIT /TRANEX/ ;READ A JOB'S TRANSL. LIST.
        SIXBIT /TRANS/  ;TRANSLATE A FILENAME.
        SIXBIT /TRPOPN/ ;OPEN TRAP DEVICE FOR AN INFERIOR
        SIXBIT /TTYESC/ ;SIMULATE TYPING OF ^_
        SIXBIT /TTYFLS/ ;FLUSH ITYIC'ED INPUT
        SIXBIT /TTYGET/ ;SUPPLY TTY CH, RETURNS THREE WORDS OF TTY STATUS
        SIXBIT /TTYSET/ ;SUPPLY TTY CH AND THREE WORDS OF TTY STATUS
        SIXBIT /TTYVAR/ ;HACK TTY VARIABLES
        SIXBIT /TVWHER/
        SIXBIT /UNLOCK/ ;UNLOCK A SPEC'D JOBS LOCKS.
        SIXBIT /USRMEM/ ;READ OR WRITE A JOB'S MEMORY.
        SIXBIT /USRVAR/ ;HACK USER VARIABLES
        SIXBIT /VIDBUF/ ;ASSIGN/DEASSIGN VIDEO BUFFER.
        SIXBIT /VIDSW/  ;SET VIDEO SWITCH.
        SIXBIT /WHOLIN/ ;GET OR SET WHO-LINE MODE AND JOB.
        SIXBIT /WHYINT/ ;FIND OUT WHY AN I/O CHANNEL INTERRUPTED
        SIXBIT /XGPIM/  ;OUTPUT TO XGP IN IMAGE MODE
LSYSCT==:.-SYSCTB

ZZ==.-SYSCTB-1
RADIX 2
ZZ2==CONC [.LENGTH /]\ZZ,/
RADIX 8
REPEAT 1_<ZZ2>-ZZ-1,377777,,-1
;4.X BIT IMPLIES SUPPLY ROUTINE WITH POINTER TO X'TH ARG, NOT ARG ITSELF
;3.9-3.7 = MINIMUM NUMBER OF ARGS
;3.1 => DECODE 1ST ARG AS IO CHNL, LEAVING IOCHNM WD ADDR IN RH(R),
; IOCHNM WD CONTENTS IN H, CLSTB ENTRY'S LH IN LH(R).
;3.2 => NEVER PASS TO SPECIAL CHECKER FOR JOB CHNL
;3.3 => DON'T BARF IF CHNL NOT OPEN, CALLED ROUTINE WILL HANDLE IT

;# ARGS ACTUALLY SUPPLIED IN W WHEN DISPATCHING THRU SYSCTD, ARGS IN A...J
SYSCTD: 200,,NACCES
        100,,NATTAC
        100,,NATTY
        100,,NCALL
IFN CHAOSP,[
        200,,CHAOSO
        100,,CHAOSQ
];CHAOSP
        100,,NCLOSE(7)
        100,,NCNSGET
        100,,NCNSSET
        24300,,NCORBL
        100,,NCORTY
        100,,NDEL
        100,,DELEWO(1)
IFN DEMON,100,,ADEMSIG
        NDETAC
        100,,NDIRSIZ(1)
        1100,,NDISMIS
        100,,NDISOWN
IFN DL10P, 100,,DL10MP
        100,,ADSKUP(1)
        6500,,NECHOIN(1)
        100,,NFILBLK(1)
        100,,NFILLEN(1)
        100,,NFINIS(1)
IFN NUNITS,     100,,NFLAP
IFE NUNITS,     100,,OPNL1
        100,,NFINIS(1)  ;OLD NAME FOR FINISH, EVENTUALLY FLUSH
        100,,NFORCE(1)
        100,,NIOPOP(7)
        100,,NIOPUS(7)
        2100,,NIOT(7)   ;(7) FOR CHNL NOT OPEN TO BE IOC ERROR, (3) TO BE OPEN LOSS
IFN INETP, 100,,IPKIOT(1)       ; Requires at least 1 arg
        100,,NITYIC
        100,,NJBCL(1)
        100,,NJBGT(1)
        100,,NJBINT(1)
        100,,NSTIOC(1)
        100,,NJBRT(1)
        20500,,NJBREU
        100,,NJBSTS(1)
IFN KL10P,KLPERF
        100,,NLISTE
        100,,NLNKEDP(1)
        200,,NLOAD
        200,,NLOGIN
        ALOGOU
        100,,NLOSE
        200,,NMLINK
IFN NCPP,       100,,ANETAC(1)
IFE INETP,[
IFE CHAOSP,     4200,,ANETBLK(1)
IFN CHAOSP,     4200,,CHANBK(1)
]
IFN INETP,      4200,,NETBLK(1) ; Block (.hang) on net I/O channel
IFN IMPP,[
        100,,ANETHST
        ANETIMP
];IMPP
IFN NCPP,       100,,NNETINT(1)
IFN INETP,      100,,NETRFC
        200,,NOPEN
        4300,,PDUMP
        100,,NPGWRT     ;OLD NAME FOR PGWRIT, EVENTUALLY DELETE
        100,,NPGWRT
IFN CHAOSP,     200,,PKTIOT(1)
IFN QAUTHP,     100,,ARAUTH(1)
        100,,NRCHST
        100,,ARCPOS
IFN DEMON,100,,ARDDMST
        100,,NRDMPBT(1)
        000,,NRELOAD
        200,,NRNAM
        200,,NRNWO
        100,,NREOWN(3)
        100,,NRESET(7)
        100,,NRESRDT(1)
        100,,NRFDATE(1)
        100,,NRFNAM
        100,,NRFPNT(3)
        ARQDAT
        100,,ARSSIZ
IFN QAUTHP,     200,,ASAUTH(1)
        200,,ASCML
        100,,NSCPOS
        200,,NSDMPBT(1)
        200,,NSTIOC(1)
        200,,NSFDATE(1)
        6300,,NSIOT(7)  ;(7) FOR IOC ERROR IF CHNL NOT OPEN, (3) FOR OPEN LOSS
        200,,NSOPEN
        200,,NSRDATE(1)
        100,,ASREAP(1)
        100,,NSSERV
        ASSTAT
        100,,NSTATUS(7)
IFN DEMON,100,,ASTDMST
        100,,NSTLGT
        100,,NSTYGT
IFN NETP,200,,NSTYNT(3)
        200,,NT11M
IFN TCPP,500,,TCPOPN
        300,,NTRNAD
        100,,NTRNCL
        200,,NTRNDL
        200,,NTRNEX
        100,,NTRNS
        200,,TRPOPN
        100,,NTTYESC
        100,,NTTYFLS
        100,,ATTYGT
        300,,ATTYST
        2200,,NTTYVA
        100,,NTVWHERE
        100,,NUNLOCK
        2200,,NUSRME
        2200,,NUSRVA
        100,,NVDBF
        200,,NVIDSW
        100,,NWHOLI
        100,,NWHYINT(1)
        1100,,NXGPIM

IFN .-SYSCTD-1-ZZ,.ERR NEW SYS CALL DISPATCH LOSES!!!

REPEAT 1_<ZZ2>-ZZ-1,ILUUO
\f
;.CALL ADR1  SKIPS UNLESS SOMETHING WRONG
;ADR1:  SETZ
;       SIXBIT /<CALL NAME>/
;       REPEAT #ARGS,BITS,, <ADDRESS OF ARGUMENT>
;       BITS=   4.9 => LAST ARG
;               4.3 - 4.1 0 = NORMAL ARG
;                         1 = IMMEDIATE
;                         2 = OUTPUT ARG
;                         3 = RETURN THE FAILURE CODE IF FAIL
;                         4 = WORD OF CONTROL BITS
;                         5 = IMMEDIATE CONTROL BITS

ASYSC:  PUSHJ P,ASCGRG  ;B HAS E OF UUO
         JRST OPNL43    ;CALL NAME UNKNOWN.
         JRST OPNL15    ;MORE THAN 8 ARGS
         JRST OPNL30    ;TOO FEW ARGS
        PUSHJ P,ASYSC1  ;DISPATCH TO ROUTINE.
         POPJ P,        ;NO SKIP - OPENL HAS ALREADY BEEN CALLED.
        AOS (P)         ;SKIP - PROPAGATE THE SKIP UP THE PDL
        MOVE U,USER     ;!!
        MOVE R,SYSCVL(U);SUCCESS RETURN, ZERO ERROR CODE ARG IF ANY
        TLNE R,%SCVER
         XCTR XW,[SETZM (R)]
        JUMPGE R,CPOPJ  ;JUMP IF NO OUTPUT VALUES WANTED
SYSCPT: HRRZ W,FORTY    ;VALUES WANTED, PUT INTO USER MEMORY FROM ACS
        ADDI W,2
        MOVSI T,-8
SYSCP2: UMOVE R,(W)
        TLNN R,1000
        TLNN R,2000
         JRST SYSCP3
        PUSHJ P,ASCIND
        MOVE J,1(T)
        UMOVEM J,(R)
        AOBJP T,CPOPJ
SYSCP3: JUMPL R,CPOPJ
        AOJA W,SYSCP2

ASYSC1: MOVE T,SYSCTD(H)
        TLNN T,1        ;DECODE 1ST ARG AS IO CHNL?
         JRST (T)       ;NO, DISPATCH TO CALL.
        TLNE T,2        ;OK TO GIVE TO JOB CHNL CHECKER?
        JRST CHNDCD     ;NO - GO DECODE CHANNEL
        HRL J,T         ;SAVE DISPATCH ADDR
        HRRI T,AIOCAL   ;MAKE DECODER RETURN TO CHECK FOR JOB DEVICE
        JRST CHNDCD

NCALL:  MOVE T,A
        MOVE R,[B,,A]
        BLT R,A+6
        SETZM A+7       ;MAX 8 ARGS, 1 USED FOR NAME
        SOS W
        PUSHJ P,ASCRCH
         JRST OPNL43
        MOVEI J,ASYSC+2 ;LOOK LIKE PUSHJ'ED FROM ASYSC
        MOVEM J,(P)
        LDB J,[331000,,SYSCTD(H)]
        JUMPE J,NCALL2
        AOS B,FORTY
        JRST NCALL3     ;HE WANTS POINTERS, WE HAVE JUST VALUES.
                ;MUST GET ARGS AGAIN

ASCRCH: MOVEI H,0
        REPEAT ZZ2,[CAML T,SYSCTB+1_<ZZ2-.RPCNT-1>(H)
        ADDI H,1_<ZZ2-.RPCNT-1>
        ]
        CAMN T,SYSCTB(H)
        AOS (P)
        POPJ P,
\f
;JSP T,HERE TO DECODE IO CHNL IN A, MODIFIERS IN 3.1-3.3 OF T.
;IF RH(T) = AIOCAL, LH(J) IS REAL RETURN ADDRESS.
;RETURNS IOCHNM ADDR IN RH(R), IOCHNM WD CONTENTS IN H, CLSTB BITS IN LH(R)
;CAN POPJ OUT FOR INVALID CHANNEL.

CHNDCD: TRNE A,-NIOCHN  ;IS 1ST ARG A LEGAL CHNL NUM?
         JRST OPNL14
        CAMN U,USER
         HRROM A,UUAC(U);REMEMBER CHNL # FOR IOC ERRORS, ETC.
        MOVEI R,(A)
        ADDI R,IOCHNM(U) ;YES, COMPUTE IOCHNM WD ADDR
        MOVE H,(R)      ;RETURN CONTENTS IN H.
        HLL R,CLSTB(H)  ;RETURN CLSTB BITS IN LH(R).
        TLNE R,%CLST
         JRST [ CAME U,USER     ;TRAP DEVICE
                 JRST .+1       ;IF CHANNEL BELONGS TO THIS USER, TRAP
                JRST TRPDEV ]   ;OTHERWISE, IS PROBABLY RFNAME, LET IT THROUGH
        TRNN H,-1       ;IF CHNL NOT OPEN
         TLNE T,4       ;AND NOT SPECIALLY OK FOR THIS SYSTEM CALL
          JRST (T)
        JRST OPNL44     ;THEN BARF

;JOB DEVICE CHECKER - PUT AIOCAL IN RH(T), JRST CHNDCD

AIOCAL: HLRZ T,J                ;GET DISPATCH ADR BACK
        TLNN R,%CLSJ            ;IS CHANNEL JOB DEVICE?
         JRST (T)               ;NO - DISPATCH
        HLRZS H                 ;ISOLATE JOB DEVICE INDEX
        DPB W,[230400,,JBSTS(H)]        ;SAVE ARG COUNT
        MOVNS W
        HRLZS W
        HRRI W,1                ;NOW HAVE AOBJN PNTR TO DATA
        MOVE T,(W)              ;COPY ARGS TO JOB AC TABLES
        MOVEM T,@JBACTB-1(W)
        AOBJN W,.-2
        MOVEI W,10              ;SET NON-STANDARD OP-CODE
        HRRM W,JBSTS(H)
        MOVE E,H                ;PUT JOB INDEX IN E FOR JBWT
        CONO PI,CLKOFF
AIOCA1: PUSHJ P,JBWT            ;WAIT FOR JOB TO ANSWER
        MOVE H,E                ;GET JOB INDEX BACK IN H (FOR JBACTB)
        MOVE W,[-8,,1]          ;LOAD ANSWERS INTO ACS
        MOVE T,@JBACTB-1(W)
        MOVEM T,(W)
        AOBJN W,.-2
        LDB T,[350400,,JBSTS(H)]        ;GET SKIP COUNT
        JUMPN T,POPJ1                   ;SKIP COUNT NOT ZERO - SKIP
        LDB C,[270600,,JBSTS(H)]        ;GET OPEN LOSS CODE
        SKIPE C                         ;MAKE SURE IN BOUNDS
        CAILE C,NOPNLS
        MOVEI C,22
        JRST OPNL1-1(C) ;GO REPORT LOSSAGE AND DON'T SKIP
\f
;SYSTEM CALL GET ARGS
ASCGRG: UMOVE T,(B)
        CAME T,[SETZ]
         JRST ILUUO
        UMOVE T,1(B)
        MOVEM T,LSCALL(U)
        PUSHJ P,ASCRCH
         POPJ P,        ;CALL NAME UNRECOGNIZED.
        AOS (P)
        LDB J,[331000,,SYSCTD(H)]       ;GET BITS CORRESP TO ARGS WHICH SAY SUPPLY PNTR TO NTH ONE
NCALL3: MOVEI W,2(B)
        MOVE T,[-9,,A]
        SETZM CTLBTS(U)
ASYSC2: UMOVE R,(W)
        TLNE R,37
         PUSHJ P,ASCIND ;CALC EFFECTIVE ADDRESS
        TLNE R,2000
         JRST ASYSC3    ;OUTPUT OR ERRORCODE ARG
        TLNE R,4000
         JRST ASYSC5    ;CONTROL BITS
        AOBJP T,CPOPJ
        ROT J,-1
        JUMPL J,ASYSC7  ;J IF WANT ADDRESS, NOT VALUE
        TLNE R,1000
         TLZA R,-1      ;IMMEDIATE, GET 0,,ADR
          UMOVE R,(R)   ;ELSE GET WORD POINTED TO
ASYSC7: MOVEM R,-1(T)   ;PUT INTO AC
        JRST ASYSC4

ASYSC5: TLNE R,1000     ;CTL BITS
         TLZA R,-1      ;IMMEDIATE, GET 0,,ADR
          XCTR XR,[HRRZ R,(R)]  ;ELSE WORD ADDRESS
        XORM R,CTLBTS(U)        ;XOR ALL THESE ARGS TOGETHER
ASYSC4: XCTR XR,[SKIPL (W)]     ;SKIP IF TERMINATE BIT ON
         AOJA W,ASYSC2
        HLRE W,T
        ADDI W,9        ;COMPUTE NUMBER OF ARGUMENTS SUPPLIED
NCALL2: LDB T,[300300,,SYSCTD(H)]
        SUB T,W
        JUMPG T,POPJ1   ;NOT ENOUGH ARGS
        JRST POPJ2      ;OK

ASYSC3: TLNE R,1000
         JRST ASYSC8    ;ERROR CODE ARG
        XCTR XRW,[MOVES (R)] ;OUTPUT ARG, JUST MAKE SURE IT'S THERE
        MOVSI R,%SCVOT  ;AND FLAG PRESENCE
ASYSC9: IORM R,SYSCVL(U)
        JRST ASYSC4

ASYSC8: HRLI R,%SCVER   ;ERROR-CODE ARG
        TDNE R,SYSCVL(U);CAN'T HAVE MORE THAN ONE ERRORCODE ARG
         JRST CPOPJ     ;SAY "TOO MANY ARGS"
        XCTR XRW,[MOVES (R)] ;MAKE SURE IT'S THERE; MUSTN'T PCLSR OUT OF OPENL
        JRST ASYSC9
\f
;PERFORM INDEXING AND INDIRECTION ON ADDRESS WORD IN R.
;DON'T CLOBBER BITS 3.6 - 4.9.  SET BITS 3.1 - 3.5 TO ZERO
;PUT ADDR IN RH.
ASCIND: TLNN R,37
        POPJ P,
ASCIN1: PUSH P,R
        LDB R,[220400,,R]
        CAIE R,0
        XCTR XR,[HRRZ R,(R)]
        ADD R,(P)
        HLL R,(P)       ;GET ORIG @, MAY HAVE BEEN CARRIED INTO BY -1(17)
        TLZ R,17
        TLZE R,(@)
        UMOVE R,(R)
        DPB R,[2700,,(P)]
        POP P,R
        TLNN R,37
        POPJ P,
        PUSHJ P,OPBRK   ;ALLOW PCLSR
        JRST ASCIN1

TPFLT:  CONO PI,CLKOFF          ;PREVENT INTERRUPT AFTER IORM SPM ING BACK
                                ; ON TOP OF 1000 BIT
IFN KA10P,[
        SPM UPGML(U)
        PUSH P,B
        MOVSI B,1000
        IORM B,UPQUAN(U)
        POP P,B
        LPMRI UPGML(U)  ;TAKE TRAP, MAYBE DONT COME BACK
        JRST CLKONJ
] ;KA10P
IFN KL10P,[
        POP P,PFOPC1    ;IF RESTART FAULT, RETURN FROM TPFLT
        JRST TPFLT1     ;JOIN REGULAR PAGE FAIL CODE
] ;KL10P
IFN KS10P,[
        POP P,EPTPFO            ; If fault returns, just return from TPFLT
        JRST TPFLT1
] ;KS10P
\f
SUBTTL PURE DUMP

;`PDUMP' SYMBOLIC SYSTEM CALL
; ARG 1 - JOB SPEC FOR JOB TO BE DUMPED
; ARG 2 - DISK CHANNEL TO DUMP ONTO
; ARG 3 - STATE WORD (MODIFIED) INITIALLY 0, THEN 4.9 + PAGE # ABOUT TO DUMP

PDUMP:  MOVE J,A
        JSP T,NCRUI2    ;DECODE JOB SPEC (1ST ARG)
         JFCL
        MOVE A,J
        JUMPL J,OPNL31  ;CAN'T PDUMP THE PDP6.
        MOVE D,B
        JSP T,PDUMDC    ;DECODE 2ND ARG, B-> IOCHNM WORD.
        TLNN J,%CLSQO
         JRST OPNL34    ;NOT DISK WRITE CHANNEL.
        HRRZM D,UUAC(U) ;SO SET IN CASE OF ERROR
        HLRZ D,(B)
        MOVEM D,SRN3(U) ;REMEMBER DISK CHANNEL NUMBER FOR LATER.
        PCLT
        XCTR XRW,[MOVES D,(C)]
        MOVEM C,SRN4(U) ;REMEMBER STATE WORD ADDRESS FOR LATER
        MOVEM A,EPDL(U) ;USER INDEX
PDUMA:  CAIN A,(U)      ;IF PDUMP'ING SELF, MUSTN'T PCLSR,
         PUSHJ P,NULSET ;SO DO A NULSET INSTEAD OF THE SOSSET
        CAIN A,(U)
         JRST PDUMP9    ;SO THAT A LSWPOP CAN BE DEON AT THE END IN EITHER CASE.
        PUSHJ P,RPCLSR  ;HACKING ANOTHER JOB: STOP IT.
        PUSHJ P,SOSSET
          USTP(A)
PDUMP9: MOVE A,SRN3(U)  ;GET DISK CHANNEL NUMBER
        MOVE C,SRN4(U)
        UMOVE D,(C)     ;PICK UP STATE WORD
        JUMPN D,PDUMP5  ;JUMP IF ALREADY WROTE MAP PAGE
        PUSHJ P,PDBWG   ;GET BUFFER AND COMMIT DISK TRACK FOR MAP PAGE
        SETZM (E)       ;CLEAR FIRST WORD OF MAP
                        ;AND DROP INTO PDUMP4
;HANDLE THE NEXT PAGE.
PDUMP4: PUSHJ P,PUPLC   ;GET BYTE POINTERS
        LDB W,Q         ;CIRC POINTER ENTRY
        LDB R,T         ;PAGE MAP ENTRY
        ANDCMI R,PMAGEM ;CLEAR AGE BITS
        CAIN W,-1
         TLO R,(SETZ)   ;ABS PAGE
        SKIPN W
         MOVEI R,0      ;PAGE NON-EXISTANT
        TRNN R,600000
         LSH R,16.      ;SWAPPED OUT
        MOVE W,D        ;VIRTUAL PAGE NUMBER
        ADDI W,1(E)     ;ADDRESS OF ENTRY IN BLOCK
        MOVEM R,(W)     ;STORE ENTRY
        CAIGE D,377
         AOJA D,PDUMP4
        HRLI W,1(W)
        SETZM 1(W)
        HRRI W,2(W)
        BLT W,1777(E)
        MOVE D,EPDL(U)
        MOVEI W,1000(E) ;1000-1017 ACS
        CAMN D,U
         JRST [ XCTR XBR,.+2
                JRST .+3]
        HRLI W,AC0S(D)
        BLT W,1017(E)
        PUSHJ P,QSBWW
        SETZM QSMPRC(A) ;SO NEXT IOT GETS A NEW BUFFER
        MOVSI D,(SETZ)  ;SET STATE WORD TO `DUMPING PAGE 0'
;DROPS THROUGH
\f;DROPS IN
;DUMP NEXT PAGE
PDUMP5: MOVE C,SRN4(U)  ;STORE BACK STATE WORD
        UMOVEM D,(C)
PDUMP8: PUSHJ P,PUPLC
        LDB W,Q
        CAIE W,-1
        SKIPN W
         AOJA D,PDUMP6  ;PAGE ABSOLUTE OR NONEXISTANT
PDUMP3: PUSHJ P,PDBWG   ;GET BUFFER AND COMMIT DISK TRACK TO DUMP THIS PAGE INTO
        MOVE J,EPDL(U)  ;SET UP MAP TO POINT TO USER BEING DUMPED
        PUSHJ P,MPLDJ
        HRLZ J,D        ;GET VIRTUAL ADDRESS OF PAGE BEING DUMPED
        LSH J,10.
        HRR J,E         ;BLT POINTER TO COPY THE PAGE
        XCTR XBR,[BLT J,1777(E)]        ;COPY PAGE INTO DISK BUFFER
        PUSHJ P,MPLDZ   ;RESTORE TO NORMAL MAP
        PUSH P,D
        PUSHJ P,QSBWW   ;WRITE OUT THE COPIED PAGE
        SETZM QSMPRC(A) ;SO NEXT IOT GETS NEW BUFFER
        POP P,D
        AOS D           ;DONE WITH THIS PAGE
PDUMP6: TRNN D,400      ;SKIP IF FINISHED WHOLE ADDRESS SPACE
         JRST PDUMP5
        JRST LSWPJ1     ;UNSTOP USER AND POPJ1

;ROUTINE TO GET DISK BUFFER AND COMMIT TRACK (FOR PDUMP)
;RETURNS BUFFER ADDRESS IN E.  PRESERVES D.

PDBWG:  SKIPL E,QSMDN(A)        ;GET CORE BLOCK # OF DISK BUFFER
         JRST [ LSH E,10.       ;CONVERT TO ADDRESS
                POPJ P, ]
        MOVE E,[444400,,1]      ;NO BUFFER, GET ONE
        MOVEI B,QBOV
        PUSHJ P,QSBWG
         PUSHJ P,UDELAY         ;CAN'T GET MEMORY, WAIT A WHILE
        JRST PDBWG

;ROUTINE TO LOOK UP PAGE (FOR PDUMP AND PURE LOAD)
;PAGE# IN RH(D), USER# IN EPDL(U).  RESULTS FROM UPLC IN Q AND T.

PUPLC:  PUSH P,A
        PUSH P,U
        MOVE U,EPDL(U)
        MOVE A,D
        ANDI A,377
        PUSHJ P,UPLC
        POP P,U
        JRST POPAJ

;DECODE 2ND ARG TO PDUMP & LOAD.
;B GETS IOCHNM WORD ADDR, LH OF J GETS LH OF CLSTB ENTRY, RH GETS LH(IOCHNM).

PDUMDC: TRNE B,-NIOCHN
         JRST OPNL14
        ADDI B,IOCHNM(U)
        HRRZ J,(B)
        HLLZ J,CLSTB(J)
        HLR J,(B)
        JRST (T)
\f
SUBTTL PURE AND SBLK LOAD

;`LOAD' SYMBOLIC SYSTEM CALL
; ARG 1 - JOB SPEC FOR JOB TO BE LOADED
; ARG 2 - DISK CHANNEL TO LOAD FROM
; ARG 3 - (OPTIONAL) FIRST ADDR,,LAST ADDR TO BE LOADED
;         OR ZERO => LOAD ONLY PURE PAGES
;         WHEN LOADING A PDUMPED FILE, FIRST,,LAST ROUNDED OFF TO PAGES
; DEFAULT 3RD ARG IS 0,,-1 NORMALLY, 20,,-1 LOADING SELF, 20,,37777 LOADING PDP6

;PAGE WORD
;4.9=1 ABSOLUTE, 1.1-2.9 = PTW
;4.8=1 SHARED WITH OTHER PAGES AT LEAST ONE OF WHICH IS WRITE
;4.7=1 LINK WITH VIRT PG IN RH 1.8-1.1
;2.9-2.8 0 NXM, 1 RD ONLY, 2 OR 3 READ/WRITE
;2.7=1 WORD ALREADY PROCESSED

NLOAD:  MOVE J,A
        JSP T,NCORUI    ;DECODE THE JOB SPEC.
         JRST NLOAD6     ;JOB GUARANTEED WRITEABLE.
        JSP T,NCORWR    ;ELSE CHECK IF WRITEABLE.
         CAIN J,-1      ;BUT CAN WRITE PDP6.
          CAIA
           JRST OPNL31  ;NOT WRITEABLE.
NLOAD6: HRREI A,(J)     ;MAKE SURE EXTEND SIGN IF PDP6.
        JSP T,PDUMDC    ;DECODE 2ND ARG.
        TLNN J,%CLSQO
         TLNN J,%CLSQ
          JRST OPNL34   ;NOT DISK READ CHANNEL.
        LDB J,[QSBSIZ(J)]
        CAIE J,36.
         JRST OPNL12    ;"MODE NOT AVAILABLE" IF CHANNEL NOT 36-BIT BYTES.
        MOVE R,B        ;IOCHNM ADDRESS IN CASE WE GET TO QICL
        JUMPL A,NLOADE  ;DONT STOP THE 6
        CAMN A,U
         JRST NLOADA    ;DONT STOP IF LOADING INTO SELF
        PUSHJ P,RPCLSR
        PUSHJ P,LSWPOP  ;SOS JOB'S DIELOK - IT CAN'T DIE WHILE STOPPED.
        MOVSI T,BSSTP   ;STOPPING WITH BSSTP INSTEAD OF RH OF USTP
        IORM T,USTP(A)  ;AVOIDS DEADLY EMBRACE WITH CORE JOB (SEE CUSTOP)
        SOS USTP(A)
        PUSHJ P,LOSSET  ;ARRANGE TO CLEAR BSSTP ON PCLSR.
            NLUPCL
        CAIGE W,3
         HRLOI C,0      ;DEFAULT 3RD ARG
        JRST NLOADE

NLOADA: PUSHJ P,LSWPOP  ;DIELOK
        CAIGE W,3
         HRLOI C,20     ;DEFAULT 3RD ARG
NLOADE: MOVEM A,SRN3(U) ;SAVE USER INDEX (-1 => PDP6)
IFN PDP6P,[
        JUMPL A,[HLRZ A,C       ;PDP6, ENSURE LIMITS SMALL ENOUGH
                CAIGE A,20
                 HRLI C,20      ;ACS NOT ACCESSIBLE
                MOVEI A,LPDP6M*2000-1
                CAIGE A,(C)
                 HRR C,A        ;HAS ONLY 16K MEMORY
                JRST .+1]
]
        HLRZ A,(B)
        MOVEM A,SRN4(U) ;SAVE # OF DISK CHANNEL
        SETZM SRN5(U)   ;START LOADING AT VIR PG #0
        MOVEM C,EPDLT1(U) ;SAVE LOAD LIMITS
        HLRZ D,C
        CAILE D,(C)
         JRST OPNL33    ;FIRST > LAST
        HLRZ C,QPCLSR(A)
        JUMPE C,NLOADD
        HRRZ Q,SRN3(U)
        CAIN C,(Q)
         JRST NLDSBB    ;(COMING BACK AFTER PCLSR)
        SETZM QPCLSR(A)
;DROPS THROUGH
\f;DROPS IN
;GET FIRST BLOCK OF FILE BEING LOADED
NLOADD: CAMN U,PCLUSR
        SETZM PCLIDX
        SKIPL TT,QSMDN(A)
         JRST NLOADB
        PCLT
        SKIPG QSBFS(A)
         PUSHJ P,UFLS   ;HANG UNTIL A BLOCK IS READ IN
        MOVE Q,QSRAC(A)
        TLNE Q,%QAACC+%QAMPU+%QAPAR
         JRST OPNL7     ;LOST ONE WAY OR ANOTHER
        MOVE E,[444400,,1]
        MOVEI B,QBIV
        PUSHJ P,QSBGB   ;SET UP CHNL AREA. TT ADDR OF FIRST WORD OF BLOCK
         BUG
         JRST NLOADC    ;QSBGB SKIPS FOR NORMAL RETURN
         JRST OPNL46    ;SKIPPED TWICE => EOF

NLOADB: MOVE J,QMPBSZ(A)
        LSH TT,10.
NLOADC: SKIPE (TT)      ;SKIP IF PURE DUMPED FILE
         JRST NLDSB     ;SBLK
        SKIPGE SRN3(U)
         JRST OPNL34    ;TRYING TO PURE LOAD PDP6
        MOVSI Q,%QAACC  ;WILL GO RANDOM ACCESSING THROUGH FILE
        IORM Q,QSRAC(A) ;THIS ALSO INHIBITS ACTIVATION AT PI LEVEL
        HLRZ H,EPDLT1(U);LOW LOAD BOUNDARY
        SKIPE EPDLT1(U)
         CAIL H,20
          JRST NLOADH   ;ACS NOT BE LOADED
        MOVSI Q,1000(TT);ADDRESS OF DUMPED ACS
        HRLS H
        ADD Q,H
        HRRZ H,EPDLT1(U);HIGH LOAD BOUNDARY
        CAILE H,17
         MOVEI H,17
        HRRZ J,SRN3(U)  ;JOB TO BE LOADED
        PUSHJ P,MPLDJ
        XCTR XBW,[BLT Q,(H)] ;LOAD UP HIS ACS
        PUSHJ P,MPLDZ
NLOADH: MOVEI R,1(TT)   ;ADDRESS OF FIRST WORD OF DUMPED MAP
        MOVEM R,EPDL3(U)        ;SAVE
        MOVEI Q,2000
        PUSHJ P,QFNTR   ;FIND DISK ADDRESS OF SECOND BLOCK
         JRST OPNL46    ;OFF END OF FILE
        SOS QSBI(A)     ;UNDO QFNTR HACK
        AOS QSLGL(A)
        PUSHJ P,QUDULK  ;UNLOCK USER DIRECTORY
        PUSHJ P,SWTL    ;LOCK CIRPSW
            CIRPSW
;DROPS THROUGH
\f;DROPS IN
;HERE TO DO NEXT PAGE (WHEN LOADING PDUMPED FILE)
NLOAD0: PUSHJ P,OPBRK
        MOVE A,@EPDL3(U)
        TRNE A,600000   ;SKIP IF NO ACCESS (IGNORE)
         TRNE A,100000
          JRST NLD14    ;THIS PAGE ALREADY DONE OR NO ACCESS
        MOVE Q,EPDLT1(U)
        TRNE A,400000   ;SKIP IF READ ONLY
         JUMPE Q,NLD14  ;IMPURE NOT BE LOADED
        MOVE A,SRN5(U)  ;VIRTUAL PAGE NUMBER
        JUMPE Q,NLD16
        AND Q,[-2000,,-2000]
        LSH Q,-10.      ;FIRST PAGE,,LAST PAGE
        HLRZ T,Q
        CAIL A,(T)
         CAILE A,(Q)
          JRST NLD14    ;PAGE OUTSIDE OF RANGE TO BE LOADED
NLD16:  MOVE U,SRN3(U)  ;USER INDEX
        PUSHJ P,UPLC
        LDB R,Q         ;LOOK IN CIRCULAR POINTER ENTRY FOR THIS PAGE
        JUMPE R,NLOAD1  ;DOESN'T ALREADY HAVE THIS VIRTUAL PAGE
        PUSH P,T        ;SAVE BYTE POINTER TO PAGE MAP FOR THIS VIRTUAL PAGE
        PUSH P,Q        ;SAVE BYTE POINTER TO CIRCULAR POINTER ENTRY FOR THIS PAGE
        PUSHJ P,PAGERT  ;FLUSH THE ALREADY EXISTING VIRTUAL PAGE
        POP P,Q
        POP P,T
NLOAD1: MOVE U,USER
        MOVE R,@EPDL3(U)        ;PICK UP DUMPED PAGE MAP WORD
        ANDCMI R,PMAGEM ;CLEAR AGE BITS (WOULD LOSE AT NLOAD4+4)
        JUMPGE R,NLOAD3 ;NOT ABSOLUTE PAGE
        ANDI R,PMRCM    ;ABS PG #
        CAIL R,TSYSM
IFE PDP6P,      JRST OPNL32
.ELSE [
        JRST [  CAIGE R,<PDP6BM_-10.+LPDP6M>
                 CAIGE R,<PDP6BM_-10.>
                  JRST OPNL32
                HRRZ R,@EPDL3(U)        ;ALLOW USER TO LOAD WRITABLE PDP6 PAGES.
                ANDCMI R,PMAGEM\PMUNSD  ;GIVE HIM WHATEVER ACCESS HE RQ'S.
                JRST NLOAD5]]
;IFN TEN11P,[           ;NOT NECESSARY SINCE 10-11 PAGES ABOVE TSYSM NOW
;       TRNN R,400
;       JRST .+3
;       MOVE E,T11MP-400(R)
;       AOJN E,NLOAD2   ;DONT ALLOW PAGE TO POINT TO TEN11
;]

        LDB E,[MUR,,MEMBLT(R)]
        CAIN E,MUHOLE
         TDZA R,R       ;IF PAGE NXM TODAY, DON'T ACTUALLY GIVE ACCESS

NLOAD5:   TRO R,200000  ;RD ONLY
        DPB R,T         ;STORE ENTRY IN PAGE MAP
        MOVEI R,-1
        DPB R,Q         ;STORE -1 IN CIRCULAR POINTER
NLOAD2: MOVE E,SRN5(U)  ;VIRTUAL PAGE NUMBER
        MOVE U,SRN3(U)  ;USER INDEX LOADING INTO
        PUSHJ P,GHUSRA  ;RECOMPUTE HUSRAD
NLD14:  MOVE U,USER
        MOVEI R,100000
        IORB R,@EPDL3(U)        ;MARK DUMPED PAGE WORD AS ALREADY DONE
        MOVE A,SRN4(U)  ;DISK CHANNEL
        TLNN R,500000   ;SKIP IF NO CORRESPONDING BLOCK IN FILE
        TRNN R,600000   ;SKIP IF MUST ADVANCE ONE BLOCK
         JRST .+3       ;DON'T ADVANCE FILE POINTER
          PUSHJ P,QFNTN ;ADVANCE TO NEXT DISK ADDRESS
           JRST OPNL46  ;PREMATURE EOF
        AOS R,SRN5(U)   ;NEXT VIRTUAL PAGE
        CAMN U,PCLUSR
         MOVEM R,PCLIDX
        AOS EPDL3(U)    ;NEXT MAP WORD
        CAIGE R,400
         JRST NLOAD0    ;LOOP
        PUSHJ P,LSWPOP  ;RELEASE CIRPSW
        MOVE B,SRN3(U)  ;USER INDEX LOADING INTO
        CAME B,U        ;SKIP IF LOADING INTO SELF
         PUSHJ P,LSWPOP ;UNSTOP USER
        MOVE B,QFBLNO(A)
        SETZM QFBLNO(A)
        MOVEM B,QRADAD(A)
        JRST POPJ1
\f
NLOAD3: TLNN R,100000   ;SKIP IF LINK WITH PAGE IN RH OF R
         JRST NLOAD4
        PUSH P,T        ;SAVE BYTE POINTER TO MAP ENTRY FOR THIS VIRTUAL PAGE
        PUSH P,Q        ;SAVE POINTER TO CIRCULAR POINTER ENTRY FOR THIS PAGE
        LDB A,[1700,,R] ;VIRTUAL PAGE NUMBER BEING LINKED TO
        CAIL A,400
         JRST NLOAD8    ;BAD VIRT PAGE #
        MOVE E,SRN5(U)  ;VIRTUAL PAGE NUMBER OF PAGE BEING LINKED
        MOVE U,SRN3(U)  ;USER INDEX LOADING INTO
        PUSHJ P,UPLC
        LDB W,Q         ;CIRCULAR POINTER OF OTHER ENTRY
        JUMPE W,NLOAD8  ;DIDN'T EXIST
        CAIN W,-1
         JRST NLOAD8    ;POINTS TO AN ABSOLUTE PAGE
        MOVE C,U
        IDIVI C,LUBLK
        SKIPE D
         BUG            ;L DOESN'T DIVIDE U
        LSH C,10        ;USER NUMBER _ 8
        TRZE C,400000
         BUG            ;USER INDEX WAS TOO LARGE
        IOR C,E         ;NEW CIRCULAR POINTER
        POP P,D         ;NEW CIRCULAR POINTER BYTE POINTER
        DPB W,D         ;STORE OTHER ENTRY AS NEW CIRCULAR POINTER ENTRY
        DPB C,Q         ;MAKE OTHER CIRCULAR POINTER ENTRY POINT TO NEW ONE
        LDB E,T         ;OTHER MAP ENTRY
        POP P,T         ;POINTER TO NEW MAP ENTRY
        ANDI R,600000   ;PROTECTION BITS
        TRZN E,600000
         JRST NLD11
        IOR E,R
        JRST NLD10
NLD11:  LSH R,-20
        DPB R,T
NLOAD9: AOS SNSWPG      ;INCR CNT OF SWAPPED OUT FOR SYS
        AOSA NSWPGS(U)  ;USER LOADING INTO HAS ONE MORE SWAPPED OUT PAGE
NLD10:   DPB E,T
NLD13:  AOS NMPGS(U)    ;USER HAS ONE MORE PAGE
        AOS SNMPGS      ;SYSTEM HAS 1 MORE PAGE
NLD15:  MOVE U,USER
        JRST NLOAD2     ;RECOMPUTE HUSRAD AND LOOP

NLOAD4: MOVE A,SRN4(U)  ;DISK CHANNEL
        MOVEI TT,(R)    ;PUT DESIRED ACCESS IN RH(TT),
        ANDI TT,600000
        TDNE R,[200000,,400000]
         IORI TT,%CBCPY ;ALONG WITH INITIAL-SWAPIN BIT IF NEC.
        PUSHJ P,NCORQ7  ;FIND OR CREATE MMP ENTRY.
         JRST OPNL37    ;MMP FULL
        MOVE E,SRN5(U)  ;GET PAGE # IN JOB BEING LOADED
        MOVE U,SRN3(U)  ;TARGET USER.
        PUSHJ P,NCORR1  ;INSERT THE PAGE.
        JRST NLD15

NLOAD8: SUB P,[2,,2]
        JRST OPNL46

NLOADZ: PUSHJ P,LSWPOP  ;FREE CIRPSW
        MOVEI T,3
        CAMLE T,LMEMFR
         PUSHJ P,UFLS
        PUSHJ P,SWTL
            CIRPSW
POPSM2: SOS (P)         ;RETURN TO LOCN BEFORE PUSHJ
        SOS (P)
        POPJ P,

;QTAOS: PUSHJ P,QTLOCK  ;LOCK TUT
QTAOS1: MOVE D,QSLGL(A) ;DISK TRACK
        PUSHJ P,TUTPNT
        SKIPG B
         BUG            ;NOT PART OF ANY FILE
        CAIGE B,TUTMNY
         AOS B
        DPB B,D         ;ADD ONE TO TUT ENTRY FOR THIS TRACK
        JRST QTULK
\f
NLUPCL: MOVSI T,BSSTP   ;THIS IS THE LOSSET ROUTINE TO CLEAR BSSTP.
        SKIPGE A,SRN3(U)
         BUG
        ANDCAM T,USTP(A)
        POPJ P,

NLDSBB: HRRZ J,SRN3(U)  ; (COMING BACK AFTER PCLSRING OUT) A HAS DSK CHNL #)
        PUSHJ P,MPLDJ   ;LOAD MAP (ALSO CLOBBER UMAPS)
        SKIPL C,SRN3(U)
         CAIN U,(C)
          JRST NLDSBH
        PUSHJ P,LSWPOP
        PUSHJ P,LOSSET
            NLUPCL
        MOVSI B,BSSTP
        IORM B,USTP(C)
NLDSBH: HRRZ B,QPCLSR(A)
        JRST (B)

NLDSB:  SKIPN EPDLT1(U)
         JRST OPNL12    ;LOAD ONLY PURE FROM SBLK FILE LOSES
        HRLZ B,SRN3(U)
        HRRI B,NLDSBD
        MOVEM B,QPCLSR(A)       ;RESTART POINT IN CASE OF PCLSR
        MOVEM J,QSMPRC(A)
        MOVEM TT,QSMPRP(A)
        HRRZ J,SRN3(U)
        PUSHJ P,MPLDJ   ;LOAD MAP (ALSO CLOBBER UMAPS)

;DROPS THROUGH
\f
;DROPS IN
NLDSB1: HRROI I,EPDL3(U)
        MOVEM I,SRN4(U) ;SET UP AOBJN PTR TO READ INTO EPDL3
NLDSBD: MOVEI C,SRN4(U) ;SET C UP TO POINT TO AOBJN PTR
        HRLI C,(TRN)    ;INDICATE EXEC MODE ADR
        PUSHJ P,QBI
        SKIPGE SRN4(U)
         JRST NLDSB9    ;PREMATURE EOF
        MOVE I,EPDL3(U)
        CAME I,[JRST 1]
         JRST NLDSB1    ;IGNORE INITIAL STUFF UNTIL JRST 1
NLDSBK: MOVEI B,NLDSBE
        HRRM B,QPCLSR(A)
NLDSBE: HRROI I,QLDPTR(A)
        MOVEM I,SRN4(U)
        MOVEI C,SRN4(U)
        HRLI C,(TRN)
        PUSHJ P,QBI     ;GET AN AOBJN POINTER
        SKIPGE SRN4(U)
         JRST NLDSB9    ;PREMATURE EOF
        SKIPL B,QLDPTR(A)
         JRST NLDSB6    ;NOT AN AOBJN POINTER
        HLRZ C,EPDLT1(U);FIRST ADDRESS TO BE LOADED
        SUBI C,(B)
        JUMPLE C,NLDSB3
        HLROS B         ;SKIP # WDS IN C
        ADD B,C         ;-# WDS REMAINING IN BLOCK
        SKIPLE B
         SUB C,B        ;FLUSH WHOLE BLOCK
        LDB D,[1200,,QSMPRP(A)]
        SKIPGE QSMDN(A)
         MOVEI D,0
        ADD D,QFBLNO(A)
        ADD D,C         ;ADVANCE ACC PTR TO SKIP PART OR ALL OF BLOCK
        MOVEM D,QRADAD(A)
        MOVSI D,%QAACC
        IORM D,QSRAC(A)
        JUMPGE B,[AOS QRADAD(A) ;SKIPPING WHOLE BLOCK, ALSO SKIP CHECKSUM
                  JRST NLDSBK]  ;AND GO READ NEXT BLOCK
        HRLS C
        ADDM C,QLDPTR(A) ;UPDATE AOBJN POINTER
NLDSB3: MOVEI B,NLDSBF  ;MAYBE FLUSH EXISTING MEMORY AND GET NEW
        HRRM B,QPCLSR(A)
NLDSBF: HRRZ E,QLDPTR(A) ;START ADR OF BLOCK
        HLRE C,QLDPTR(A) ;-LENGTH OF BLOCK
        SUB E,C         ;DON'T COMBINE THIS INSN WITH NEXT, MIGHT BE MOBY BLOCK
        SUBI E,1        ;GET END ADR OF BLOCK
        HRRZ T,EPDLT1(U);HIGH LOAD LIMIT
        SUBM E,T        ;NUMBER OF WORDS OF EXCESS IN BLOCK
        MOVEM T,EPDLT2(U) ;SAVE FOR LATER USE
        JUMPLE T,NLDSB7 ;JUMP IF BLOCK HAS NO EXCESS
        SUB E,T         ;ADJUST END ADDRESS
        HRLZS T
        ADDM T,QLDPTR(A);DECREASE COUNT IN AOBJN POINTER
NLDSB7: LSH E,-10.      ;LAST PAGE NEEDED
        PUSH P,A
        PUSH P,R        ;R HAS IOCHNM WD, NEEDED IF REACH QICL VIA QBI.
        PUSH P,E        ;PAGE NO. OF LAST PAGE NEEDED
NLDSB4: MOVE E,(P)
        CAMGE E,SRN5(U)
         JRST NLDSB5    ;ALREADY HAVE NEEDED PAGES
        MOVE A,SRN5(U)
        PUSH P,U
        MOVE U,SRN3(U)  ;LOOK UP THIS PAGE IN MAP OF USER WE'RE HACKING.
        PUSHJ P,UPLC    ;IF THERES A WRITABLE PAGE
        POP P,U
        LDB A,T         ;IN THE SLOT ALREADY, KEEP IT.
        TRNN A,600000
         TRNN A,2
          TRNE A,400000
           JRST NLDSBM
        CAME U,SRN3(U)  ;IF NOT HACKING SELF, NCORLL WILL LSWPOP
         PUSHJ P,NULSET ;WHAT IT THINKS IS A LOSSET LIKE NLUPCL
        PUSHJ P,SWTL
          CIRPSW
        MOVEI R,%JSNEW  ;GET FRESH PAGE
        MOVE TT,SRN3(U) ;INTO THE JOB WE'RE HACKING.
        MOVE C,SRN5(U)  ;PAGE # TO GIVE IT.
        MOVSI A,%CBRED+%CBWRT+%CBNDW    ;WANT WRITE ACCESS.
        PUSHJ P,NCORL   ;UNDOES NULSET AND SWTL.
         JRST NLSBPL    ;COULDNT GET PAGE (CALLED LSWCLR)
NLDSBM: AOS SRN5(U)
        JRST NLDSB4     ;CHECK WHETHER WE NEED MORE PAGES.
\f
NLDSB5: SUB P,[1,,1]    ;NOW WE HAVE ALL PAGES NEEDED TO LOAD THIS BLOCK.
        POP P,R
        POP P,A
NLDSBQ: MOVEI B,NLDSBC
        HRRM B,QPCLSR(A)
NLDSBC: HRRZI C,QLDPTR(A)
        HRLI C,(SETZ)
        PUSHJ P,QBI     ;DO A BLOCK IOT, USING THAT AOBJN POINTER.
        AOSG B,EPDLT2(U);SKIP RESIDUE OF BLOCK AND CHECKSUM
         MOVEI B,1      ;NO RESIDUE, JUST SKIP CHECKSUM
        LDB D,[1200,,QSMPRP(A)]
        SKIPGE QSMDN(A)
         MOVEI D,0
        ADD D,QFBLNO(A)
        ADD D,B
        MOVEM D,QRADAD(A)
        MOVSI D,%QAACC
        IORM D,QSRAC(A)
        JRST NLDSBK

NLDSB6: LDB D,[1200,,QSMPRP(A)]
        SKIPGE QSMDN(A)
         MOVEI D,0
        ADD D,QFBLNO(A)
        SUBI D,1
        MOVEM D,QRADAD(A)
        MOVSI D,%QAACC
        IORM D,QSRAC(A)
NLDSB8: CAME U,SRN3(U)  ;UNLESS HACKING SELF OR PDP6, WE HAVE A SOSSET OF USTP TO POP.
         SKIPGE SRN3(U)
          CAIA
           PUSHJ P,LSWPOP
        AOSA (P)
NLDSB9:  PUSHJ P,OPNL46 ;LOAD FILE NOT IN VALID SBLK FORMAT
NLSBP1: PUSHJ P,MPLDZ
        SETZM QPCLSR(A)
        POPJ P,

NLSBPL: SUB P,[2,,2]    ;FLUSH PUSHES OF E AND R.
        POP P,A
        JRST NLSBP1
\f
SUBTTL .GUN, .LOGOUT

;DESTROY PROCEDURE TREE WHOSE TOP INDEX SUPPLIED BY USER
AGUN:   XCTR XR,[SKIPG A,(J)]
         POPJ P,        ;LOSE, NEG OR SYSTEM JOB
        IMULI A,LUBLK
        CONO PI,CLKOFF
        CAMGE A,USRHI   ;USER INDEX UNREASONABLE => LOSE.
        CAIG A,LUBLK
         JRST CLKONJ
        JRST ALOGO6

ALOGOU: SKIPL SUPPRO(U)
         JUMPN J,ABREAK ;.LOGOUT N, TURNS INTO .BREAK N,33 IF NOT TOP LEVEL
        MOVE A,U        ;.LOGOUT, AND STY CLOSE.
        CONO PI,CLKOFF
;A HAS JOB BEING LOGGED OUT; U HAS JOB THAT'S DOING IT.
;.GUN AND .LOGOUT ACT BY PUTTING THE JOB IN SUCH A STATE THAT
;IT CAN DO NOTHING BUT TRY TO DISAPPEAR. IF THE JOB IS ALREADY
;IN THAT STATE, THIS ROUTINE DOES NOTHING. THAT PREVENTS
;RECURSION LOOPS WHEN KILLING CYCLIC STRUCTURES INVOLVING STY'S.
;EXCEPTION: IF THE JOB TO BE LOGGED OUT IS THE RUNNING JOB,
;WE DO THE REAL WORK BY GOING TO ALOGO1.
ALOGO6: SKIPE UNAME(A)  ;JOB TO BE LOGGED OUT IS GONE.
        SKIPL SUPPRO(A) ;CAN'T LOG OUT UNLESS TOP LEVEL.
         JRST CLKONJ
        CAME A,U
         AOS (P)        ;IF .GUN GETS THIS FAR, IT HAS "SUCCEEDED".
        MOVSI T,BULGOS+BULGO
        TDNE T,APRC(A)  ;IF JOB IS ALREADY LOGGING OUT,
         JRST ALOGO7    ; SEE IF IT IS THE RUNNING JOB
        MOVSI B,%PCUSR
        CAMN A,USER
         AOJA B,ALOGO5
        PUSH P,U
        MOVE U,USER
        MOVEM A,SRN3(U) ;AUCL4 FINDS USR IDX TO HACK HERE.
        PUSHJ P,LOSSET
            AUCL4       ;CLEAR BULGOS IF AUCL3 PCLSR'S
        PUSHJ P,AUCL3   ;SET BULGOS AND WAIT FOR DIELOK TO CLEAR.
        POP P,U
        CONO PI,CLKOFF
        PUSHJ P,LSWDEL
        EXCH B,UPC(A)   ;SET HIM UP TO LOG OUT.
ALOGO4: MOVEM B,SRN3(A)         ; Remember old PC for unlocking locks.
        MOVE B,[.LOGOUT]        ;PUT THE FOLLOWING ROUTINE IN JOB'S AC'S:
        MOVEM B,AC0S(A)         ;       0/      .LOGOUT
        CAMN A,USER             ;       1/      .VALUE
         UMOVEM B,0             ;       2/      JRST 0
        MOVSI B,(.VALUE)
        MOVEM B,AC0S+1(A)
        CAMN A,USER
         UMOVEM B,1
        MOVSI B,(JRST)
        MOVEM B,AC0S+2(A)
        CAMN A,USER
         UMOVEM B,2
        MOVSI B,BULGOS
        IORM B,APRC(A)  ;SAY HE'S DIEING SO NO-ONE WILL HACK HIM.
        MOVEM U,EPDL(A) ;RECORD WHO IS KILLING HIM.
        MOVE B,UNAME(U)
        MOVEM B,SRN4(A)
        MOVE B,JNAME(U)
        MOVEM B,SRN5(A)
        SETZM PICLR(A)  ;PREVENT INTERRUPTS.
        SETZM MSKST(A)
        SETZM PIRQC(A)
        MOVSI B,BUSRC
        ANDCAM B,USTP(A) ;MAKE SURE HE CAN RUN - ELSE HE WOULDN'T LOG OUT.
ALOGO7: CONO PI,CLKON
        CAME A,USER
         POPJ P,
        JRST ALOGO1     ;IF JOB IS RUNNING JOB, MUST HACK AROUND

ALOGO5: EXCH B,UUOH     ;LOGGING OUT SELF - MAKE OUR PC LOOK
        SOJA B,ALOGO4   ; AS IF WE HAD EXECUTED THE .LOGOUT IN AC 0
\f
;COME HERE IF LOGGING OUT ONESELF (A=USER).
ALOGO1: MOVE U,A
        PUSHJ P,AUCL3   ;WAIT TILL NO-ONE IS LOOKING AT ME,
        PUSHJ P,UBLAM   ;CLOSE MY CHANNELS AND KILL MY INFERIORS AND CORE.
        MOVE A,USER
        CONO PI,CLKOFF  ;DON'T SCHEDULE WHILE GOING AWAY
        MOVSI T,BULGO
        IORM T,APRC(A)  ;SYS JOB KILLS ANY TREES WITH BULGO SET.
        MOVSI T,SCLGUN
        IORM T,SUPCOR   ;TELL SYS JOB TO LOOK AROUND FOR TREES TO KILL.
        MOVSI T,BUSRC   ;SUICIDE: MAKE SURE WE DON'T RUN ANY MORE.
        IORM T,USTP(A)
        JRST UDELAY     ;CAUSE A SCHEDULE

;COME WITH JOB INDEX IN A. INDICATE THAT JOB IS ABOUT TO DIE,
;THEN WAIT TILL IT'S SAFE TO KILL IT.
;TURNS CLOCK ON.
AUCL3:  MOVSI T,BULGOS
        IORM T,APRC(A)  ;SAY THIS JOB STARTING TO GO AWAY.
        CONO PI,CLKON   ;NOONE CAN START HACKING US NOW; SAFE.
        CAME A,USER     ;IF NOT LOGGING OUT RUNNING USER,
         PUSHJ P,1USTOP ;STOP THE JOB BEING KILLED.
        SKIPE DIELOK(A) ;WAIT TILL NO-ONE IS LOOKING AT THAT JOB.
         PUSHJ P,UFLS
        HRLOI T,#BUSRC  ;AND NO-ONE ELSE HAS HIM PCLSR'ED.
        TDNE T,USTP(A)
         PUSHJ P,UFLS
        POPJ P,         ;WE SUCCEEDED, BUT CALLER HAS WORK TO DO.
\f
SUBTTL REAL TIME USER FEATURE
;
;.REALT AC,     SKIPS ONLY IF REAL TIME FACILITY REQUESTED AND SEIZED
;AC=    4.9=>TURN OFF OLD CLOCK RATE, FLUSHING REAL TIME FACILITY AND
;                REMAINDER OF CURRENT TICK AND ZEROING TICK COUNT
;       4.8=>TURN ON NEW CLOCK RATE
;       4.7=>TRY TO SEIZE REAL TIME USER FACILITY
;       4.6=>DON'T SETTLE FOR PSEUDO-REAL TIME STATUS
;       4.5 =>ONLY WANT PSEUDO
;       4.4=>PROGRAM TO BE BLOCKED EXCEPT FOR HIGH PRIORITY PHASE OR INT. LEVEL
;       4.3=>READ INTO WD3+4 AS DESCRIBED BELOW (BEFORE ANY OTHER BITS INTERPRETED)
;       3.1-4.2=RESERVED FOR EXPANSION, SHOULD BE ZERO
;       1.1-2.9=RH=POINTER TO 4 WORD BLOCK
;       WD1=FRAME TIME IN 60'THS (MUST BE <2**18.)
;       WD2=PRIORITY TIME IN 60'THS (MUST BE <7 AND <WD1/2)
;       WD3= IF 4.3 ON, SET RH TO FRAME TIME, LH TO TICKS SINCE EXAMINED
;       WD4= IF 4.3 ON, SET RH TO HIGH PRIORITY TIME, LH TO 0 IF CURRENTLY LOW
                ;PRIORITY OR -1 IF CURRENTLY HIGH PRIORITY
;
AREALT: UMOVE A,(J)
        TLNN A,4000
        JRST AREAL1
        CONO PI,CLKOFF
        MOVE T,UTIME(U)
        MOVE Q,URTIME(U)
        CONO PI,CLKON
        UMOVEM T,2(A)
        UMOVEM Q,3(A)
AREAL1: TLNN A,700000
        POPJ P,
        HRRZ T,UREALT
        CAMN T,U
        SETOM UREALT
        SETZM URTIME(U)
        TLNN A,400000
        JRST AREAL2
        PUSHJ P,CLQDEL  ;TURN OFF OLD INTS
        UCLBLK(U)
        SETZM UTIME(U)  ;ZERO TICK COUNT
AREAL2: TLNN A,200000
        JRST AREAL4
        XCTR XR,[SKIPG T,(A)]
        JRST ILUUO
        HRRM T,UTIME(U)
AREAL4: TLNN A,100000
        JRST AREAL6
        XCTR XR,[SKIPLE T,1(A)]
        CAIL T,13.
        JRST ILUUO
        HRRZ B,UTIME(U)
        LSH B,-1
        CAMLE T,B
        JRST ILUUO
        HRROS T
        TLNE A,10000
        TLZ T,1
        MOVEM T,URTIME(U)
        TLNE A,20000
        JRST AREAL6
        CONO PI,CLKOFF
        SKIPGE UREALT
        JRST AREAL7
        TLNE A,40000
        SETZM URTIME(U)
        JRST AREAL5
AREAL7: MOVEM U,UREALT
        AOS (P)
AREAL5: CONO PI,CLKON
AREAL6: SKIPN T,UTIME(U)
        POPJ P,
        SKIPE B,URTIME(U)
        MOVE T,B
        HRRZS T
        PUSHJ P,CLQADD
        UCLBLK(U)
        POPJ P,


;CLOCK LEVEL ROUTINE
UREALB: SUBI U,UCLBLK   ;SET INDEX TO QUEUE BLOCK
        SKIPE B,URTIME(U)
        JRST URLTB2
URLTB1: MOVSI T,(%PIRLT)
        IORM T,PIRQC(U)
        MOVSI T,1
        ADDM T,UTIME(U)
        HRRZ T,UTIME(U)
        SKIPGE B
        HRRZ T,B
URLTBX: SETZM SCHFLG    ;CAUSE SCHEDULE THIS CLOCK BREAK
        MOVEI C,UCLBLK(U)
        JRST CLQREE

URLTB2: TLC B,-1
        MOVEM B,URTIME(U)
        MOVSI T,1
        HRRZ C,UREALT
        JUMPGE B,URLTB4
        CAMN C,U
        HRRZS UREALT
        JRST URLTB1

URLTB4: CAMN C,U
        IORM T,UREALT
        HRRZ T,UTIME(U)
        HRRZS B
        SUB T,B
        JUMPG T,URLTBX
        BUG
\f
SUBTTL MISCELLANEOUS SYSTEM CALLS

$INSRT TIME             ;ROUTINES HAVING TO DO WITH CLOCKS AND THINGS

;
;.CLOSE CH,     ;CLOSE ANY I/O TRANSACTION OPEN ON CHANNEL CH
;
CCLOSE: HRREI C,-IOCHNM(R)      ;CLOSE CALLED INTERNALLY
        SUB C,U
        TRNE C,-NIOCHN
         BUG            ;R WAS NOT AN IOCHNM WORD ADDRESS.
        HRRZM C,UUAC(U) ;SOME CLOSE ROUTINES LOOK AT UUAC
        JRST ACLOSE

NCLOSE: AOS (P)
ACLOSE: HLRZ A,(R)      ;SET UP A WITH L.H. OF I/O CH WORD
        HRRZ B,(R)      ;SET UP B WITH R.H. "
        MOVE C,CLSTB(B) ;GET CLOSE TABLE ENTRY
        TLNE C,%CLSNRM  ;SKIP IF NOT STANDARD CLOSE
         JRST STDCLS    ;JUMP TO STANDARD CLOSE
        PUSH P,R        ;SAVE R
        PUSHJ P,(C)     ;CALL CLOSE ROUTINE
        POP P,R         ;RESTORE R
STDCLX: SETZM (R)       ;CLEAR I/O CHANNEL WORD
        SETZM IOCHST-IOCHNM(R)  ;CLEAR I/O CHNL STATUS WORD
        POPJ P,

STDCLS: CONO PI,CLKOFF  ;INHIBIT CLOCK BREAKS
        SOSGE 1(C)      ;DECREMENT USE COUNTER, SKIP IF STILL IN USE AT LEAST ONCE
         SETOM (C)      ;NO LONGER IN USER, FREE BY SETOM'ING "XXXUSR" VARIABLE
        CONO PI,CLKON   ;ENABLE CLOCK BREAKS
        JRST STDCLX

AVALRET:UMOVE A,(B)     ;CALL 4,
        MOVEM A,VALUE(U)
        MOVEI T,%PIVAL
        JRST ILLOP4

AUTRAN: UMOVE C,(B)
        HRR C,U
        CONO PI,CLKOFF          ;Don't let USRHI change or anything like that
        MOVE A,USRHI
UTRNL:  SUBI A,LUBLK
        JUMPL A,CLKONJ
        SKIPE D,UNAME(A)
         CAME C,SUPPRO(A)
          JRST UTRNL
        MOVE E,JNAME(A)
        CONO PI,CLKON
        UMOVEM D,1(B)
        UMOVEM E,2(B)
        JRST POPJ1

;RETURN WITH LOSER IN A IN LOSER MODE AND CLOCK OFF
;
RPCCK:  PUSHJ P,RPCLSR  ;STOP USER (ALSO PUTS HIM IN USER MODE)
        CONO PI,CLKOFF  ;TURN OFF CLOCK
        JRST UPCLSR     ;"RESTART USER" (HE CAN'T RUN TILL CLOCK BACK ON)
\f
;.LOSE X <=> .CALL [SETZ ? SIXBIT/LOSE/ ? 401000,,X ]

;.CALL LOSE
;       USED TO REPORT LOSSAGE TO SUPERIOR PROCEDURE
;ARG 1 - LOSING INSTRUCTION ADDR,,LOSSAGE CODE (CODES DEFINED BY DDT)
;ARG 2 - NEW PC (DEFAULT = PC-2 SO CAN USE AS A NON-SKIP-RETURN HANDLER)
;CTL 1.1 - DEFAULT ARG 2 TO PC INSTEAD OF PC-2
;CTL 1.2 - SETZM @.40ADDR
;CTL 1.3 - DON'T USE THE NEW PC AS THE LOSING INSTRUCTION ADDR

ALOSE:  HRRZ A,FORTY            ;ARG 1 = EFF ADDR OF UUO
        MOVEI W,1
        TDZA T,T
NLOSE:   MOVE T,CTLBTS(U)
        MOVE D,40ADDR(U)
        TRNE T,2
         XCTR XRW,[MOVES (D)]
        TLZ B,BADPC             ;COMPUTE NEW PC FROM ARG 2 OR UUOH
        SKIPGE IOTLSR(U)
         TLO B,%PCUIO
        TLO B,%PCUSR
        MOVE C,UUOH
        TRNN T,1
         HRRI C,-2(C)
        CAIGE W,2
         MOVE B,C
        TRNN T,4
         HRL A,B
        HRRI B,1(B)             ;PCLSR'ING WILL SOS
        MOVEM A,VALUE(U)        ;PASS TO SUPERIOR
        MOVEM B,UUOH
        TRNE T,2
         XCTR XW,[SETZM (D)]
        MOVSI T,%PJLOS
        JRST UUOERR
\f
AUCLOSE:
IFN PDP6P,[
        MOVE A,(R)      ;OPER 10
        MOVE A,CLSTB(A)
        TLNE A,%CLS6
         JRST PDPUCL
]
        PUSHJ P,AUCL2
         POPJ P,
        PUSHJ P,1USTOP
        MOVEM A,SRN3(U)
        PUSHJ P,LOSSET
           AUCL4
        PUSHJ P,AUCL3   ;STOP JOB, AND WAIT TILL SAFE TO KILL IT
                        ;(TURNS CLOCK ON)
        EXCH U,A
        PUSH P,A
        HLLZ T,SUPPRO(U)
        PUSH P,T
        PUSH P,R
        PUSHJ P,UBLAST
        POP P,R
        PUSHJ P,ZUSLOG  ;ACCOUNT FOR USAGE THEN FLUSH LAST VESTIGES
        CONO PI,CLKON
        POP P,T
        POP P,U
        ANDCAM T,IFPIR(U)
        JRST LSWDEL

AUCL4:  HRRZ A,SRN3(U)
        MOVSI T,BULGOS
        ANDCAM T,APRC(A)
        POPJ P,

AUCL2:  HLRZ A,(R)      ;GUY BEING CLOSED
        HRRZ B,(R)
        LDB TT,[.BP (%CLSFU),CLSTB(B)]
        JUMPN TT,OPNL31 ;FOREIGN JOB => .UCLOSE ISCAN'T MODIFY JOB
        SKIPL CLSTB(B)  .SEE %CLSU
         JRST OPNL34    ;NOT A JOB AT ALL?
        CONO PI,CLKOFF
        MOVE TT,TTYTBL(U)
        JUMPGE TT,AUCL1 ;HAVE TTY NOW
        TLNN TT,%TBDTY  ;NOT GIVING IT AWAY.
         CAIE A,(TT)    ;SKIP IF GAVE IT TO GUY WE'RE KILLING
          JRST AUCL1
        PUSHJ P,SDTTY   ;TAKE IT BACK FROM HIM.
         JFCL
AUCL1:  HLRZ A,(R)
        JRST POPJ1
\f
;DISMIS SYSTEM CALL. 1ST ARG INT PDL PTR (WILL BE DECREMENTED
;IF NOT AN IMMEDIATE ARG)
;2ND ARG OPTIONAL PC TO DISMIS TO (OVERRIDES THAT IN INT PDL)
;3RD ARG OPTIONAL NEW .DF1 VALUE       "       "    "     "
;4TH ARG OPTIONAL NEW .DF2 VALUE ...
;5TH ARG OPTIONAL ERROR CODE AS IN LOSE.  IF PRESENT WILL LOSE RIGHT AFTER DISMISSING.
;IF 4 ARGS GIVEN, 1ST IGNORED EXCEPT FOR POSSIBLY DECREMENTING, OR POPPING OF ACS.
;CTL BITS (SAME FORMAT AS LH OF 1ST WORD OF INTERRUPT DISPATCH TABLE)
;SPECIFY POPPING OF SAME EXTRA INFO THAT INTERRUPTS CAN PUSH.

NDISMIS:CAIL W,5
         MOVEM E,VALUE(U)
        MOVE E,A        ;GET IN E THE INT PDL PTR.
        TLNN E,1000     ;IF 1ST ARG IMMEDIATE, IT IS PTR,
         UMOVE E,(A) ;ELSE IT PTS TO PTR.
        MOVE H,E        ;SAVE UNPOPPED PDL POINTER FOR PDL OV CHECKING.
        TLNE A,1000     ;IF PDL PTR ISN'T IMMEDIATE, POP IT ACC. TO CTL BITS.
         JRST NDISM2
        MOVE T,CTLBTS(U)
        TRNE T,400000
         SUB E,[3,,3]   ;POP OFF DEBUGGING INFO IF IT WAS PUSHED.
        LDB TT,[000500,,T]
        JUMPE TT,NDISM2 ;IF ACS WERE PUSHED, POP THEM TOO.
        HRLS TT
        SUB E,TT        ;DECREMENT THE PDL POINTER ENOUGH
        LDB I,[060500,,T]
        HRLI I,1(E)     ;AND COPY FROM THE PDL TO THE ACS.
        ADDI TT,-1(I)
        XCTR XBRW,[BLT I,(TT)]
NDISM2: CAIGE W,2       ;IF NO 2ND ARG, GET PC FROM INT PDL
         UMOVE B,(E)
        CAIGE W,3       ;IF NO 3RD ARG, GET .DF1 FROM INT PDL
         UMOVE C,-2(E)
        CAIGE W,4       ;IF NO 4TH ARG GET .DF2 FROM INT PDL
         UMOVE D,-1(E)
        TLNE A,1000     ;IF 1ST ARG NOT IMMED, DECREMENT IT
         JRST NDISM3
        SUB E,[5,,5]
        UMOVEM E,(A)
        JUMPGE E,NDISM3 ;AND CHECK FOR PDL OVFLO.
        SKIPL H
         PUSHJ P,NDISMP ;PDL OVFLO, SET INT BIT IF INT ENABLED.
NDISM3: MOVEM C,IDF1(U) ;RESTORE THE PC, .DF1, .DF2
        MOVEM D,IDF2(U)
        MOVSI T,%PJLOS
        CAIL W,5
         IORM T,PIRQC(U)
        JRST NDISM1

NDISMP: MOVEI TT,%PIPDL ;PDL OV INT BIT.
        TDNE TT,MSKST(U)
         IORM TT,PIRQC(U)
        POPJ P,
\f
;OLD-STYLE DISMISS JOINS HERE
ADISMIS:UMOVE B,(B)     ;CALL 1,
NDISM1: TLO B,%PCUSR
        TLZ B,BADPC
        SKIPGE IOTLSR(U)
         TLO B,%PCUIO
IFN KL10P,[
        SETCM A,UUOH            ;IF ONE-PROCEEDING THE .DISMISS
        TLNN A,%PS1PR-%PSINH
         TLO B,%PS1PR-%PSINH    ;TRAP IMMEDIATELY AT THE NEW PC
]
        MOVEM B,UUOH
        SETOM PICLR(U)

;CHECK FOR PENDING INTERRUPTS AND TAKE THEM RIGHT AWAY
APISE1:
IFN PDP6P,[
        CAMN U,PDPISR
         CONO DSDEV,DSDCHN      ;ENABLE INTERRUPT FROM 6
]
        MOVE A,U
        PUSHJ P,APISE6  ;SEE IF ANY DEVICES WANT TO RE-INTERRUPT.
        MOVEI C,%PIARO
        ANDCAB C,PIRQC(U)
        SETCM D,MSKST(U)
        IOR D,IDF1(U)   ;FIND ALL DISABLED OR DEFERRED
        SKIPN PICLR(U)  ;(ALL ARE DEFERRED WHEN PI IS OFF).
         SETO D,
        AND D,[BADBTS]  ;BAD
        TDNE C,D        ;PENDING INTERRUPTS
         JRST ADISM7    ;IF THERE ARE ANY, LET THEM HAPPEN.
        AND C,MSKST(U)
        ANDCM C,IDF1(U)
        JUMPN C,ADISM7  ;1ST WD INT. PENDING.
        MOVE C,IFPIR(U)
        AND C,MSKST2(U)
        ANDCM C,IDF2(U)
        JUMPE C,CPOPJ   ;JUMP IF NO 2ND WORD INT PENDING.
ADISM7: MOVE C,[JRST ONEFLS]
        MOVEM C,UEXIT
        POPJ P,
\f
APISE6: MOVE D,MSKST(A) ;IF INTERRUPT FROM CONSOLE ENDBLED,
        TRNN D,%PITYI
         JRST APISE7
        SKIPL T,TTYTBL(A) ;IF THIS JOB HAS ITS CONSOLE
        SKIPN TINTC(T)  ;AND THE CONSOLE HAS INT. CHARS,
         JRST APISE7
        MOVEI D,%PITYI  ;GENERATE AN INTERRUPT.
        IORM D,PIRQC(A)
APISE7: MOVE D,MSKST2(A) ;LOOK AT HIS ENABLED IO CHANNELS.
        ANDI D,177777
APISE0: JFFO D,APISE9   ;CHECK EACH ONE.
        JRST APISE8     ;ALL CHECKED.

APISE9: MOVNS E         ;CHECK ONE IO CHNL THAT'S ENABLED TO INT.
        ANDCM D,CHNBIT+35.(E) ;MARK THIS CHNL AS HANDLED.
        ADDI E,35.+IOCHNM(A)  ;GET ADDR OF IOCHNM WD FOR CHANNEL.
        HRRZ T,(E)      ;IS IT A TTY INPUT CHANNEL?
        CAIL T,TYIDN
        CAILE T,TYIBN
         JRST APISE2
        LDB T,[$TIIDX,,(E)] ;YES, GET THE TTY NUMBER.
        HRRZ C,TTYSTS(T)
        CAIE T,%TINON   ;IF IT ISN'T A DISOWNED TY CHANNEL,
        CAIE C,(A)      ;AND THE TTY BELONGS TO THIS JOB,
         JRST APISE0
        SKIPN TINTC(T)  ;AND IT HAS AN INT. CHAR WAITING,
         JRST APISE0
        MOVE C,TYIMSK(T)
APISE4: AND C,MSKST2(A) ;GIVE AN INT. ON ONE OF THE CHANNELS IT'S OPEN ON.
        MOVN T,C
        AND C,T
        IORM C,IFPIR(A)
        JRST APISE0

APISE2: CAIN T,STYDUI   ;NOT A TTY CHNL. IS IT A STY CHNL?
         JRST APISE3
        CAIE T,STYDBI
         JRST APISE0
APISE3: LDB T,[$TIIDX,,(E)]     ;YES, GET TTY #.
        SKIPL C,STYSTS-NFSTTY(T) ;STY IN USE BY THIS JOB?
        CAIE C,(A)
         JRST APISE0
        SKIPGE TTYOAC(T)        ;TTY OUTPUT PENDING?
         JRST APISE0
        MOVE C,STYMSK-NFSTTY(T) ;YES, INT. ON ONE CHANNEL.
        JRST APISE4

APISE8:
IFN STKP,[
        SKIPL C,STKUSR
        CAIE C,(A)
         POPJ P,
        HRRZ C,STKMSK
        AND C,MSKST2(A)
        SKIPLE STKBC
        IORM C,IFPIR(A)
]
        POPJ P,
\f
;.SLEEP AC,     ;IF C(AC) + OR ZERO:    ;BECOME DORMANT FOR C(AC) 1/30'THS OF A SEC
                ;IF C(AC) -:    ;BECOME DORMANT TILL MAGNITUDE OF C(AC) > C(TIME)
ASLEEP: XCTR XR,[MOVN T,(J)]    ;PICK UP NEGATIVE OF C(AC)
        JUMPGE T,ASLP1  ;JUMP IF C(AC) WAS NEG
        SUB T,TIME      ;COMPUTE NEG OF TIME SLEEP SHOULD RUN OUT
        UMOVEM T,(J)    ;STORE BACK SO YOU WILL WIN IF PCLSR'ED OUT
ASLP1:  MOVMS A,T               ;MAKE POSITIVE
        SUBI A,60.*30.          ;IF SLEEPING FOR MORE THAN A MINUTE
        MOVSI B,%SWDSO
        CAMLE A,TIME
        IORM B,USWST(U)         ;PUT RIP VAN WINKLE ON ICE
        PCLT
        JRST ASLP2              ;ALWAYS GO TO UFLS AT LEAST ONCE

        CAMLE T,TIME    ;HANG TILL C(T) LESS THAN C(TIME)
ASLP2:  PUSHJ P,UFLS
        XCTR XW,[SETZM (J)]     ;CLEAR OUT ARG (FOR COMPATIBILITY WITH WHEN AC WAS COUNTED OUT)
        JRST CLKONJ     ;MAKE SURE CLKCHN ON IN CASE SLEEP WAS 0 & SKIPPED UFLS ENTIRELY

;RELOAD CALL - IGNORE ARGS
;MUST BE FROM TOP LEVEL NON-DISOWNED JOB
;RELOADS AND STARTS SYS: ATSIGN WHATEVER

NRELOAD:SKIPGE SUPPRO(U)
        SKIPGE APRC(U)
         JRST OPNL40            ;NOT TOP LEVEL
        CONO PI,CLKOFF
        PUSHJ P,LOGUPD          ;LOG OUT
        PUSHJ P,DMNPLI          ;AND IN AGAIN
        PUSHJ P,USRST2          ;RESET USER VARS
        CONO PI,CLKON
        SETZM @UTMPTR(U)        ;TEMPORARY HIGH PRIORITY
        JRST USTCDR             ;LOAD FILE AND START IT

AMASTER:UMOVE J,(J)
        CONO PI,CLKOFF  ;OPER 61
        SKIPL A,UMASTER
         JRST AMAST2
        SKIPGE J
AMAST1:  HRRZM U,UMASTER
        JRST CLKOJ1

AMAST2: CAME U,A
         JRST AMAST3
        SKIPL J
         SETOM UMASTER
        JRST CLKOJ1

AMAST3: JUMPGE J,CLKOJ1
        SKIPGE TTYTBL(U)
         JRST CLKONJ    ;LOSEY
        PUSHJ P,RPCCK
        CAME A,UMASTER
         JRST AMASTER
        JRST AMAST1
\f
;.CALL SSERVE - Set .SERVER variable without timing screw.
; ARG1: <job>, the client whose .SERVER variable is to be munged
; ARG2: <job>, the server to be stored in the variable
; If one arg is given, it is the server and the client defaults to %JSELF
NSSERVER:
        MOVE J,A
        CAIL W,2
         SKIPA A,B
          MOVEI J,%JSELF
        JSP T,NCORUI            ; Decode client and AOS his DIELOK
         JRST NSSRV1            ; OK to write
        JSP T,NCORWR            ; Check further
         JRST OPNL31            ; CAN'T MODIFY JOB
NSSRV1:
IFN PDP6P,[
        CAIN J,-1               ; PDP6?
         JRST OPNL34            ; WRONG TYPE DEVICE
];PDP6P
        EXCH J,A                ; A: client  J: server
        JSP T,NCORUI            ; Decode server and AOS his DIELOK
         JFCL                   ; Don't give a damn about writability
IFN PDP6P,[
        CAIN J,-1               ; PDP6?
         JRST OPNL34            ; WRONG TYPE DEVICE
];PDP6P
        MOVEM J,SERVER(A)       ; Safe to set it now
        PUSHJ P,LSWPOP          ; Server's DIELOK
        JRST LSWPJ1             ; Client's DIELOK

\f
        SUBTTL LOGIN/ATTACH/DETACH/DISOWN CODE

;SYMBOLIC CALL LOGIN:  LOG A TREE IN.  MUST BE GIVEN BY TOP-LEVEL NON-LOGGED-IN JOB
;WITH NO INFERIORS.
;ARG 1 - DESIRED UNAME
;ARG 2 - "TERMINAL NAME", PUT IN TRMNAM USER VARIABLE AND PRINTED AS SIXBIT ON SYSCON.
;ARG 3 - DESIRED XUNAME, FOR DEMON TO KNOW WHO TO ACCOUNT.

NLOGIN: HLRE T,UNAME(U) 
        AOJN T,OPNL31   ;JUMP ON ALREADY LOGGED IN
        SKIPL SUPPRO(U)
         JRST OPNL40    ;CAN'T LOG IN IF NOT TOP LEVEL
        JUMPE A,OPNL11
        HLRE T,A
        AOJE T,OPNL11           ;BAD NAME
        CAIGE W,3
         MOVE C,A       ;IF XUNAME (ARG 3) MISSING, DEFAULT TO UNAME.
        MOVEI D,0
        CONO PI,CLKOFF
ALOG2:  SKIPN UNAME(D)
         JRST ALOG4
        MOVE T,JNAME(D)
        CAMN T,JNAME(U)
         CAME A,UNAME(D)
          JRST ALOG3
        JRST OPNL13     ;CONSOLE CONTROLLED TREE ALREADY LOGGED IN THAT NAME

ALOG3:  HRRZ T,SUPPRO(D)
        CAMN T,U        ;CAN'T LOGIN IF HAVE INFERIOR.  RESTRICTION IMPOSED HERE
         JRST OPNL12    ;SINCE WE NO CODE HERE TO SET INFERIOR'S UNAME.
ALOG4:  ADDI D,LUBLK
        CAMGE D,USRHI
         JRST ALOG2     ;LOOP FOR ALL SETS OF PROCEDURE VARIABLES
        HRRZ T,TTYTBL(U)
        HRLI T,[ASCIZ / LOGIN  /]
        PUSHJ P,SGWAIT          ;ASK THE SYSTEM JOB TO PRINT OUT THE RELEVANT INFO
        SKIPL TTYTBL(U)         ;SKIP IF NOT CONSOLE CONTROLLED
         AOS SUSRS              ;INCREMENT COUNT OF LOGGED IN CONSOLE CONTROLLED TREES
        MOVEM A,UNAME(U)        ;SET UNAME TO WHAT LOGGED IN AS
        MOVEM A,SLGIV
        MOVEM A,USYSNM(U)       ;SET SNAME "
        MOVEM A,HSNAME(U)       ;SET HOME SNAME "
        MOVEM C,XUNAME(U)       ;SET XUNAME " " (USER MAY MUNG LATER)
        MOVEM B,TRMNAM(U)
        MOVEM B,SLGIV+2         ;INCLUDE TRMNAM AS SECOND NAME PRINTED
        PUSHJ P,DMNPLI          ;GIVE INFO TO DEMON
        JRST CLKOJ1             ;TURN CLK ON AND SKIP RETURN

ASETM2: UMOVE A,1(J)    ;.OPER 5
        MOVEM A,MSKST2(U)
ASETMSK:        UMOVE D,(J)     ;OPER 4
        MOVE A,U
        MOVEI I,1
        SOS (P)         ;WILL SKIP RETURN
        JRST USMASK     ;ACT LIKE .SUSET.

ARSYSI: SKIPA A,[ITSVRS]        ;OPER 52
ARDTIME:MOVE A,TIME             ;OPER 17
        JRST APTUAJ

IFE KS10P,[     ; On the KS10 they made DATAI 0, a UUO!
ARDSW:  DATAI A                 ;OPER 20
        JRST APTUAJ
] ;IFE KS10P
IFN KS10P, ARDSW==:ILUUO

ASUPSET:MOVEI C,003777  ;OPER 53
        XCTR XR,[AND C,(J)]
        MOVE D,SUPCOR   ;SAVE OLD CONTENTS
        XORB C,SUPCOR
        UMOVEM C,(J)
        HRROI A,SUPCOR
        JRST ASPST2
\f
;       .CALL DET
;       ERROR RETURN
;       NORMAL RETURN

;DET:   SETZ
;       SIXBIT /DETACH/
;       SETZ [<JOB SPEC>]       ;SEE NCORUI

;DISOWN JOB'S ENTIRE TREE AND FREE CONSOLE.  IF TREE HAS NO
;CONSOLE, JUST MAKES IT DISOWNED.  NO ARG => THIS JOB'S TREE
;ALWAYS SKIPS IF THE JOB SPEC IS REASONABLE.

;CTL BIT 1.1 => DON'T SET SIGN OF APRC (DON'T MAKE TREE "DISOWNED").
;CTL BIT 1.2 => USE SYSTEM TREE'S RESOURCE WORD
;CTL BIT 1.4 => KILL TREE AN HOUR FROM NOW IF IT ISN'T REOWNED
;CTL BIT 1.5 => SUPPRESS THE CONSOLE-FREE MESSAGE ON THE TTY

NDETAC: HLRZ B,A        ;XOR LH OF 1ST ARG INTO CTL BITS
        XORM B,CTLBTS(U)
        PUSHJ P,SWTL    ;MAKE SURE NOBODY ELSE IS REARRANGING TREES.
            TREESW
        MOVEI J,(U)     ;DEFAULT TO OUR TREE
        JUMPE W,NDETA0  ;JUMP IF NO ARGS SUPPLIED
        MOVE J,A        ;JOB SPEC
        JSP T,NCORUI    ;DECODE ARG, GET USER INDEX IN J
         JFCL           ;IGNORE INFO ON WRITEABILITY
        CAIG J,LUBLK    ;DONT DETACH SYSJOB OR CORE JOB
         JRST OPNL31
NDETA0: SKIPL T,SUPPRO(J)       ;FIND TOP LEVEL JOB OF TREE (IN J)
         JRST [ MOVE J,T 
                JRST NDETA0 ]
        HRRZ A,J        ;TOP OF TREE
        SKIPGE APRC(A)
         JRST LSWCJ1    ;TREE IS ALREADY DISOWNED.
        MOVEI Q,NDETA8
        PUSHJ P,IFPLUP  ;STOP ALL BUT THIS JOB
        PUSHJ P,NDETA7  ;DO THE WORK
        JRST LSWCJ1     ;UNSTOP THE TREE

NDETA7: PUSH P,U        ;US
        PUSH P,A        ;TOP LEVEL
        MOVEI U,(A)
        CONO PI,CLKOFF
        PUSHJ P,LOGUPD  ;FOR ACCOUNTING PURPOSES, THIS IS LIKE A LOGOUT
        CONO PI,CLKON
NDETA1: MOVEI U,(A)     ;GET IN U USER INDEX OF OWNER OF TTY
        MOVE A,TTYTBL(U)        ;GET IN A TTY NUMBER
        TLNE A,%TBDTY   ;TREE HAS NO TTY =>
         JRST [ POP P,A ;JUST MAKE IT DISOWNED.
                POP P,U
                JRST NDETA5 ]
        JUMPL A,NDETA1  ;GAVE TTY AWAY
        MOVE T,(P)              ;TOP-LEVEL JOB OF TREE SAVES USER TTY OPTIONS IN
        MOVE B,TTYOPT(A)        ;HIS STTYOP VARIABLE
        AND B,[%TOUSR,,%TPUSR]
        MOVEM B,STTYOP(T)
        LDB B,[.BP (%TCRFS+%TCQRY),TTYCOM(A)]
        IORI B,4                ;MAKE STTYOP NON-ZERO TO SHOW IT WAS STORED
        DPB B,[170300,,STTYOP(T)]       ;OVERLAPS PADLF FIELD
        HRRZS A
        PUSH P,TTYSTS(A)        ;SAVE THIS TTY INFO
        PUSH P,TTYST1(A)        ;WILL PUT INTO TTY OWNER'S USER VARS
        PUSH P,TTYST2(A)        ;AFTER SUCCEED IN FREEING THE TTY
        MOVE B,A
        IMULI B,TPLEN*2
        MOVN B,TPVB+TPLEN(B)
        ADD B,TCMXV(A)
        PUSH P,B
        MOVSI B,%TCDET  ;IF TREE DETACHED DUE TO TOP LVL INT,
        SKIPN USER      ;THE CONSOLE FREE MESSAGE SHOULD SAY SO.
         IORM B,TTYCOM(A)       .SEE SYSCFM
                        ;THIS ALSO HAPPENS IF DIALUP LINE HUNG UP, OS'ERS BEWARE!
;DROPS THROUGH
\f;DROPS IN
IFN N11TYS,[
        CONO PI,CLKOFF
        PUSHJ P,TVBNCL  ;CLEAR VIDEO BUFFER #
        CONO PI,CLKON
];N11TYS
        MOVE B,-5(P)    ;GET BACK IDX OF RUNNING JOB
        MOVE B,CTLBTS(B)
        MOVSI T,%TACFM
        TRNE B,20       ;CTL BIT 1.5 => MARK THE TTY AS NOT NEEDING CNSL FREE MSG.
         IORM T,TTYSTA(A)
        PUSHJ P,TTYLO1  ;NOW MAKE CONSOLE FREE.
        POP P,B         ;CAN'T PCLSR AFTER THIS POINT
        DPB B,[$TBECL,,TTYTBL(U)]
        POP P,TTSTSV+1(U)       ;STORE INTO TTY'S OLD OWNER
        POP P,TTSTSV(U) ;OLD TTY VARS FROM BEFORE FREEING IT
        POP P,B
        MOVEM B,TTSTSV+2(U)
        SKIPA A,(P)     ;TOP LEVEL JOB
NDETAA:  HRRZ A,T
        SKIPGE T,TTYTBL(A)      ;SKIP IF HE HAS IT
         JRST NDETAA    ;NOW DO GUY HE GAVE IT TO
        CAIE A,(U)
         BUG            ;BUT.  BUT.  BUT.
        MOVSI B,%TBNOT+%TBDTY   ;TAKEN FROM --ME-- AND DOESN'T HAVE IT
        IORM B,TTYTBL(A)
        HLLZS TTYTBL(A)
        POP P,A         ;TOP LEVEL
        POP P,U         ;US
        HLRO B,UNAME(A)
        AOSE B          ;IF DETACHED TREE WAS LOGGED IN
         SOS SUSRS      ;ONE LESS CONSOLE CONTROLLED TREE
NDETA5: MOVSI B,BUMRTL  ;IF REQUESTED, MARK TREE AS DUE TO DIE
        MOVE D,CTLBTS(U) ;IN AN HOUR.
        ANDCAM B,APRC(A)
        TRNE D,10
         IORM B,APRC(A)
        CONO PI,CLKOFF  ;PERFORM ACCOUNTING FOR THIS USER AS IF HE WERE LOGGING OUT.
        EXCH U,A
        PUSHJ P,LOGUPD
        EXCH U,A
        MOVE D,JNAME(A) ;IF TOP LEVEL JOB ...
        CAME D,[SIXBIT /HACTRN/]        ;IS A HACTRN,
         JRST NDETA3
NDETA2: AOS D           ;AOS ITS NAME LEVEL UNTIL ...
        PUSHJ P,UJNAMU  ;IT IS UNIQUE
         JRST NDETA2    ;(UJNAMU TURNS OFF CLOCK)
        MOVEM D,JNAME(A)
NDETA3: EXCH U,A
        PUSHJ P,DMNPLI  ;LOG BACK IN, NAME MAY HAVE CHANGED FROM HACTRN TO HACTRO
        EXCH U,A
        CONO PI,CLKON
        MOVEI Q,NDETA9  ;NOW SAY ALL JOBS IN TREE
        JRST IFPLUP     ;ARE DISOWNED

NDETA8: CAIE A,(U)      ;IF JOB ISN'T SELF, STOP IT
         JRST IFSTOP
        POPJ P,
\f
;"ATTACH" SYSTEM CALL:
;1ST ARG - JOB SPEC -> OUR INFERIOR, OR TOP OF A DISOWNED TREE.
;2ND ARG - TTY SPEC (OF A TTY WHICH MUST BE FREE)
 ;2ND ARG ABSENT => USE OUR CONSOLE, AND GUN OUR TREE
;CONTROL BIT 400000 => CHANGE JOB'S NAME TO HACTRN (IF 2 ARGS)
;                 4 => START JOB AFTER ATTACHING (JUST LIKE DETACH)

;CONNECTS THE SPECIFIED JOB TO THE SPECIFIED TTY, AS A CONSOLE CONTROLLED TREE.
;IF THE TTY IS OUR CONSOLE, WE ARE LOGGED OUT.
;IF THE JOB IS OUR INFERIOR, IT IS FIRST DISOWNED.

NATTAC: PUSHJ P,SWTL
            TREESW
        SOJE W,NATTAN
        EXCH A,B        ;2ND ARG => IT IS TTY SPEC, SO DECODE IT.
        JSP J,ATTYCI
        MOVE A,B
        MOVE B,I        ;AND PUT IT IN B.
        JRST NATTA6

NATTAN: SKIPL B,SUPPRO(U) ;NO 2ND ARG => WE MUST BE TOP LEVEL, SINCE WE'LL HAVE
         JRST OPNL40      ;TO LOG OUT. B GETS NEGATIVE.
NATTA6: MOVE J,A
        JSP T,NCRUI2    ;DECODE 1ST ARG, GET USR IDX IN J.
         JFCL
        SKIPGE A,SUPPRO(J)
         JRST NATTA5    ;JOB SPEC'D MUST BE EITHER
        CAIE U,(A)      ;OUR INFERIOR, OR
         JRST OPNL31
        JRST NATTA7

NATTA5: SKIPL APRC(J)   ;THE TOP OF A DISOWNED TREE.
         JRST OPNL31
;NOW IF TTY IS OUR CONSOLE, B IS NEGATIVE; OTHERWISE, B HAS TTY #.
NATTA7: PUSH P,CTLBTS(U)
        SETZM CTLBTS(U) ;DON'T GET FAKED OUT AT NATTA1, NATTA2, DSWNTY.
        PUSH P,J
        MOVE A,J
        MOVEI Q,NDETA8  ;STOP SPEC'D JOB AND ITS INFERIORS.
        PUSHJ P,IFPLUP
        JUMPL B,NATTAG
NATTAM: CONO PI,TTYOFF
        SKIPL T,TTYSTA(B)       ;SEE IF TTY IS FREE
         JRST NATTAL
        MOVSI T,(SETZ)  ;IT IS, GRAB IT
        ANDCAM T,TTYSTA(B)      .SEE %TACFM
        ANDCAM T,TTYSTS(B)      .SEE %TSFRE
        CONO PI,TTYON
        JRST NATTA8     ;SINCE NO PCLSR POSSIBLE, DON'T BOTHER WITH A LOSSET OF THESE

NATTAL: HRRE Q,TTYSTS(B)
        CONO PI,TTYON
        SKIPG Q         ;IF TTY IS IN USE
        TLNE T,%TACTZ   ;OR BEING ^Z'ED, DEVICE NOT AVAIL
         JRST [ SUB P,[2,,2] ? JRST OPNL10 ]
        MOVSI T,%TACFM+%TACTZ   ;OTHERWISE JUST WAIT FOR CONSOLE FREE
        TDNN T,TTYSTA(B)        ;MESSAGE TO FINISH COMING OUT
         PUSHJ P,UFLS
        JRST NATTAM
\f
NATTAG: MOVE A,U        ;IF HACKING OUR CONSOLE, MUST STOP OUR WHOLE TREE
        MOVEI Q,NDETA8  ;(EXCEPT US, OF COURSE - NDETA8 CHECKS THAT).
        PUSHJ P,IFPLUP
        MOVEI B,(U)
NATTA4: MOVE B,TTYTBL(B) ;FIND THE TTY'S NUMBER.
        TLNE B,%TBDTY
         JRST NATTAL    ;THIS TREE HAS NO TTY?
        JUMPL B,NATTA4  .SEE %TBNOT
        PUSHJ P,SDTTY   ;GET TTY BACK TO TOP OF TREE FOR AGBLT3 LATER.
         BUG
        HRRO B,TTYTBL(U)
;I BELIEVE THAT NOTHING CAN PCLSR BEYOND THIS POINT.
;RH OF B HAS TTY #; SIGN IS SET IF TTY IS OUR CONSOLE.
NATTA8: AOS TTNTO(B)    ;KEEP DSWNTZ FROM HALTING (WILL UNDO THIS LATER)
        PUSH P,B        ;PUSH <CONSOLE-FLAG>,,<TTY #>
        HRRZ A,-1(P)    ;LEGALITY OF CALL FULLY CHECKED; CAN START ALTERING.
        SKIPGE APRC(A)  ;IF SPEC'D JOB IS OUR INFERIOR, DISOWN IT.
         JRST NATTA9
        MOVE B,TTYTBL(A)
        TLNE B,%TBDTY   ;IF THE INFERIOR HAS THE TTY, TAKE IT AWAY.
         JRST NATTAF
        PUSHJ P,SDTTY
         BUG
NATTAF: HRRZ A,-1(P)
        MOVEI Q,DSWNTY  ;JUST LIKE .DISOWN, BUT KNOW JOBS ARE ALREADY STOPPED.
        PUSHJ P,IFPLUP
        PUSHJ P,NATTA1
NATTA9: MOVEI Q,NATTA2
        MOVE A,U
        SKIPGE (P)      ;IF HACKING OUR CONSOLE, DISOWN OUR TREE SO IT IS FREE.
         PUSHJ P,IFPLUP
                        ;OUR TTY NOW IN INCONSISTENT STATE SINCE WE ARE DISOWNED
                        ;BUT TTY STILL BELONGS TO US. AGBLT3 FIXES THAT.
        MOVE B,(P)
        SOSGE TTNTO(B)
         BUG
        MOVE TT,-1(P)   ;NOW "RE-OWN" THE SPEC'D JOB
        MOVE A,UNAME(TT);NOT CHANGING ITS UNAME
        HRRZ J,B        ;TO THE DESIRED TTY, WITH APPRO. RESOURCE WORD.
        MOVEI D,USRRCE(B)
        TLO D,400000    ;TELLS UFN2A THE TREE SHOULD BECOME UN-DISOWNED.
        SETZ B,         ;NO INTERRUPT BIT NEEDED.
        SETOM DLSRCH    ;INHIBIT SCHEDULING (UFN2A UNDOES THIS)
        PUSH P,U
        PUSHJ P,UFN2A
        POP P,U
        HRRZ A,-1(P)
        SKIPA C,A
NATTAH:  MOVE C,D       ;FIND THE JOB IN THE TREE BEING ATTACHED
        MOVE D,TTYTBL(C)
        TLNN D,%TBDTY   ;THAT IS SUPPOSED TO GET CONTROL OF THE TTY.
         JRST NATTAH
        SETOM SUPPRO(A) ;BUT DON'T LEAVE IT THINKING IT IS OUR INFERIOR.
        SKIPGE I,(P)
         JRST NATTAD
        HLRE B,UNAME(A) ;ATTACHING JOB TO FREE TTY:
        AOSE B  
         AOS SUSRS      ;THIS MAY MEAN 1 MORE LOGGED IN CONSOLE-CTL'ED TREE.
        CONO PI,TTYOFF
        PUSHJ P,TTYINI  ;INIT TTYOPT, ECHO AREA, TTYCOM, TTYSTA.
        MOVSI B,%TSFRE  ;NOW MAKE TTY'S TTYSTS HAPPY
        ANDCAM B,TTYSTS(I)
        MOVSI B,%TSCNS
        IORM B,TTYSTS(I)
        HRRM A,TTYSTS(I)
        CONO PI,TTYON#1 ;TTYCHN ON, BUT NOT CLKCHN.
        PUSH P,U
        PUSH P,I        ;IF THE JOB BEING ATTACHED IS LOGGED IN,
        MOVE U,-3(P)    ;PERFORM ACCOUNTING FOR IT.
        HLRO T,UNAME(U)
        AOSE T
         PUSHJ P,LOGUPD
        POP P,I
        POP P,U
;DROPS THROUGH
\f;DROPS IN
        MOVE D,['HACTRN]
        PUSHJ P,UJNAMU
         JRST NATTAI
        MOVE B,-2(P)    ;SAVED CTLBTS(U) AT ENTRY
        TRNE B,400000
         MOVEM D,JNAME(A)
NATTAI: MOVE B,-2(P)    ;CTLBTS
        MOVSI D,%USTSP  ;BUSRC
        TRNE B,4
         ANDCAM D,USTP(A)       ;START JOB BEING ATTACHED, IF REQUESTED TO
        PUSH P,U
        HRRZ U,C        ;GET USR IDX GIVING TTY TO IN U,
IFN N11TYS,[
        HRRZ T,I        ;TTY # IN T FOR USTTV0
        PUSHJ P,USTTV0  ;GIVE THE JOB A BLINKER IF IT DESERVES ONE.
         JFCL
]
        POP P,A         ;USR IDX TAKING TTY FROM (BUT NOT REALLY TAKING). I AND U STILL SET.
        PUSHJ P,AGBLT4  ;MOVE HIS PER-JOB VARIABLES INTO THE TTY'S VARIABLES, ETC.
        JRST NATTAE     ;CLOCK IS NOW BACK ON.

NATTAD: CONO PI,CLKOFF
        MOVE J,JNAME(U) ;ATTACHING OUR TTY TO JOB:
        MOVEM J,JNAME(A) ;GIVE JOB OUR JNAME ALONG WITH OUR TTY.
        MOVE A,U
        HRRZ U,C
        PUSHJ P,AGBLT6  ;TRANSFER TTY TO HIM, SAVING OUR TTY STATE AND LOADING HIS.
NATTAE: MOVE U,A
        POP P,B
        EXCH U,(P)      ;U := USER INDEX OF TOP OF TREE BEING ATTACHED
        MOVSI T,BUMRTL  ;SINCE TREE HAS BEEN ATTACHED, IT SHOULDN'T
        ANDCAM T,APRC(U) ;DIE AN HOUR AFTER IT WAS DETACHED.
        SKIPN STTYOP(U) ;RESTORE SAVED TTY OPTIONS, IF ANY
         JRST NATTAP
        LDB T,[170200,,STTYOP(U)]
        DPB T,[.BP (%TCRFS+%TCQRY),TTYCOM(I)]
        MOVE T,[%TOUSR,,%TPUSR]
        ANDCAM T,TTYOPT(I)
        AND T,STTYOP(U)
        IORM T,TTYOPT(I)
NATTAP: HLRE T,UNAME(U)
        CONO PI,CLKOFF
        AOSE T
         PUSHJ P,DMNPLI ;LOG HIM IN
        CONO PI,CLKON
        POP P,U
        SUB P,[1,,1]    ;FLUSH SAVED CTLBTS
        PUSHJ P,LSWCLR  ;UNSTOP THE JOBS AND FREE TREESW
        JUMPGE B,POPJ1  ;RETURN IF WE DIDN'T GIVE AWAY OUR CONSOLE.
        SETOM TTYTBL(U) ;DON'T WANT ALOGOU TO TYPE LOGOUT MESSAGE.
        JRST ALOGOUT    ;LOG THIS JOB OUT.
\f
;.CALL DISOWN
; RH OF ARG IS JOB SPEC, OF OUR INFERIOR.
; LH OF ARG XOR CONTROL BITS:
;  1.1 => RETAIN PRIORITY (DON'T SET APRC)
;  1.2 => USE SYSTEM RESOURCE
;  1.3 => CLEAR .USTP AFTER DISOWNING (THUS AVOIDING TIMING ERROR)
;  1.4 => SET BUMRTL SO THAT JOB WILL BE GUNNED IF IT IS STOPPED FOR A WHOLE HOUR
;          AND NOT REOWNED OR ATTACHED.

NDISOWN:HLRZ J,A
        XORM J,CTLBTS(U) ;XOR LH OF 1ST ARG INTO CTL BITS.
        HRRZ J,A
        JSP T,NCRUI2    ;DECODE JOB SPEC; DON'T SET DIELOK.
         JFCL
        CAIN J,-1
         JRST OPNL31    ;PDP6 NO GOOD.
        MOVEI R,IOCHNM(U)
        ADD R,A         ; R GETS ADDR OF IOCHNM WORD IF ARG WAS CHANNEL #,
        TRNE A,400000   ;GET S0 IF ARG WAS OTHER SORT OF JOB SPEC.
         SETZ R,
        HRRZ A,J
        HRRZ J,SUPPRO(A)
        CAME J,U
         JRST OPNL31    ;NO GOOD IF NOT OUR INFERIOR.
        JRST NDISO1     ;JOIN OLD-STYLE DISOWN

;.DISOWN CH,    ;MAKES DIRECTLY INFERIOR PROCEDURE OPEN ON CHANNEL CH
                ;THE TOP LEVEL JOB OF A DISOWNED JOB

ADISOWN:HRRZ B,(R)      ;PICK UP CH TYPE INDEX
        SKIPL CLSTB(B) .SEE %CLSU       ;SKIP IF AN INF. USER CHANNEL
         JRST IOCER7    ;OTHER TYPE, GIVE IOC ERROR
        HLRZ A,(R)      ;PICK UP INF.'S INDEX
        SETZM CTLBTS(U)
NDISO1: PUSHJ P,SWTL
            TREESW
        SETZM STTYOP(A)
        MOVE B,TTYTBL(A)
        TLNE B,%TBDTY   ;SKIP IF TTY TAKEN AWAY
         JRST ADISO1
        PUSH P,R
        PUSH P,A        ;JOB TO BE DISOWNED HAS THE TTY: TAKE IT AWAY.
        PUSHJ P,SDTTY
         BUG
        POP P,A
        POP P,R
ADISO1: MOVEI Q,DSWNTY
        PUSHJ P,IFPHAK  ;HACK INFERIORS
        CAME U,USER
         BUG
        PUSHJ P,NATTA1  ;FLUSH OUR POINTERS TO INFERIOR, AND SET FLAGS
        CAME U,USER
         BUG
        JRST LSWCJ1     ;UNSTOP HIS TREE AND FREE TREESW

;FLUSH INFERIOR-JOB CHANNELS FROM JOB IN U TO JOB IN A
;CANNOT PCLSR BECAUSE JOB IS CURRENT OR STOPPED ALREADY
NATTA1: MOVEI R,0       ;NO PROTECTED CHANNEL
        MOVEI D,%CLSU
        EXCH U,A
        PUSHJ P,ZUSES1  ;FLUSH POINTERS TO INFERIOR
        EXCH U,A
        SETOM SUPPRO(A) ;MARK AS TOP LEVEL
        MOVE W,CTLBTS(U)
        MOVSI TT,BUSRC  ;CLEAR .USTP IF REQUESTED
        TRNE W,4
         ANDCAM TT,USTP(A)
        MOVSI TT,BUMRTL
        TRNE W,10
         IORM TT,APRC(A)
        POPJ P,

DSWNTY: SKIPL TTYTBL(A)
         BUG            ;CHECKED AT HIGHER LEVEL, DATA INCONSISTENT
NATTA2: TDZA T,T        ;DO SOS TTNTO OF CONSOLE TTY.
NDETA9:  SETO T,        ;DON'T.
        PUSHJ P,CHSCAA  ;LOOK AT ALL CNHLS
            PUSHJ P,DSWNTZ      ;BLESSING CONSOLE TTY CHNLS
        MOVEI TT,SYSRCE ;SET RESOURCE POINTER TO SYSTEM OR DISOWNED
        MOVE W,CTLBTS(U);DEPENDING ON CTLBTS
        TRNN W,2
         MOVEI TT,USRRCE+NCT
        MOVEM TT,UTMPTR(A)
        MOVSI T,400000
        TRNN W,1
         IORM T,APRC(A) ;MARK AS DISOWNED
        POPJ P,

;BLESS CONSOLE TTY CHANNELS. IF T NONZERO, DON'T SOS TTNTO.
DSWNTZ: HLRZ B,(R)      ;GET LH OF IOCHNM WORD
        HRRZ J,(R)      ;GET DEV TYPE INDEX
        CAIL J,TYIDN    ;SKIP IF LESS THAN LEAST TTY INDEX
         CAILE J,TYOBN  ;SKIP UNLESS .LTEQ. HIGHEST
          POPJ P,       ;NOT A TTY CHANNEL
        TRZ B,#%TICNS#(.BM $TIIDX)
        TRZE B,%TICNS   ;SKIP IF NOT A CONSOLE TTY
         CAIN B,%TINON  ;DO NOTHING TO "DISOWNED" TTY CHNLS
          POPJ P,
        MOVEI J,%TINON  ;CHANGE OTHER TTY CHNLS TO DISOWNED
        DPB J,[$TIIDX,,(R)]     ;CHNLS.
        JUMPN T,CPOPJ   ;IN NDETAC, TTNTO ALREADY SETZM'D.
        SOSLE TTNTO(B)  ;DECREMENT OPEN COUNT
         POPJ P,
        BUG             ;SHOULD BE OPEN AT HIGHER LEVELS

;ROUTINE TO SCAN ALL I/O CHANNEL AND I/O PDL SLOTS OF A PROCEDURE
;R 4.9=1 => REGULAR CHANNEL  4.9=0 => IOPUSHED CHANNEL
CHSCAA: MOVEI R,IOCHNM(A)
CHSCAN: HRLI R,-20
CHSCA2: XCT @(P)
        AOBJN R,CHSCA2
        HRLI R,-<LUIOP/2>+400000
CHSCA4: XCT @(P)
        ADD R,[1,,2]
        JUMPG R,CHSCA4
        JRST POPJ1
\f;
;IFPHAK AND IFPLUP TAKE A USER INDEX IN A AND THE ADDRESS OF A ROUTINE
;       IN Q.  THEY CALL THE ROUTINE FOR THE PROCEDURE AND ALL OF ITS
;       INFERIORS BUT IFPHAK ALSO STOPS THE SPECIFIED PROCEDURE AND
;       ALL ITS INFERIORS STRINGING THEIR USTP'S INTO THE CURRENT USER'S
;       LSWPR.
;
IFPHAK: PUSH P,U
        PUSH P,Q
        MOVE U,USER     ;MADE SURE YOU USE THE RIGHT LSWPR
        MOVEI Q,IFSTOP  ;SET UP TO STOP
        PUSHJ P,IFPLUP
        POP P,Q
        POP P,U
IFPLUP: PUSH P,E        ;SAVE E
        PUSH P,H        ; " H
        SKIPA H,A
IFPLU5: MOVE A,E        ;RECURSE
        PUSH P,H
        PUSH P,Q
        PUSHJ P,(Q)     ;CALL ROUTINE
        POP P,Q
        POP P,H
        MOVEI E,LUBLK*2 ;INITIALIZE TO INDEX OF JOB AFTER CORE JOB
IFPLU2: SKIPN UNAME(E)
        JRST IFPLU3
        HRRZ T,SUPPRO(E)
        CAIN T,(A)
        JRST IFPLU5
IFPLU3: ADDI E,LUBLK    ;STEP TO NEXT VAR BLOCK
        CAMGE E,USRHI   ;SKIP IF ALL EXAMINED
        JRST IFPLU2     ;NOT ALL, CONTINUE
        CAME H,A        ;ALL, SKIP IF BACK TO TOP LEVEL
        JRST IFPLU4     ;NOT AT TOP LEVEL, POP UP
        POP P,H         ;RESTORE H
        POP P,E         ; " E
        POPJ P,         ;RETURN FROM CALL TO IFPLUP

IFPLU4: MOVE E,A        ;POP
        HRRZ A,SUPPRO(A)        ;UP
        JRST IFPLU3     ;AND CONTINE

IFSTOP: PUSHJ P,RPCLSR  ;STOP ROUTINE WHOSE INDEX IS IN A
        HRRZ T,USTP(A)
        SOJE T,IFSTP1
        SKIPE LSWB0+1(A)
        JRST UPCLSR     ;HAVE ALREADY HACKED THIS GUY
IFSTP1: MOVEI T,USTP(A) ;GET LOC OF USTP (WAS AOSED BY RPCLSR)
        MOVEI H,LSWB0(A)        ;GET LOC OF A LOCKED SWITCH BLOCK OF PROC STOPPED
        MOVEM T,(H)     ;SET WD1
        PUSH P,U
        HRRZ T,U
        IDIVI T,LUBLK
        POP P,U
        HRL T,LSWPR(U)
        IORI T,603000   ;SOS WHEN UNLOCKED
        MOVSM T,1(H)
        MOVEM H,LSWPR(U)        ;ADD TO LOCKED SWITCH LIST OF USER
        POPJ P,
\f
UBLAM:  SKIPL APRC(U)   ;SKIP IF DISOWNED
         PUSHJ P,SDTTY  ;GET TTY UP TO THIS LEVEL
          JFCL
UBLAST: PUSHJ P,IODCL   ;CLOSE IO DEVICES ETC
UBLST2: SETZ B,
        PUSH P,U        ;DO NOT USE THIS ROUTINE FOR CORING UP.
        HRRZ Q,U
IFE SWPWSP,[
        CAME Q,BUSR
         JRST UBLST4
        SETOM BUSR      ;SWAP-BLOCKED NO MORE
        SOS NUSWB
        MOVSI TT,(SETZ)
        ANDCAM TT,USWSCD(U)
];SWPWSP
UBLST4: MOVE U,USER
        PUSHJ P,ACRF1   ;CORE DOWN TO NUM OF BLOCKS IN B
         BUG
        MOVE U,USER     ;;CHECK FOR ALLEGED BUG SOMEPLACE IN ACRF1
        SKIPL CORRQ(U)  ;
         BUG            ;;NOT SUPPOSED TO RETURN UNTIL CORE REQUEST SATISFIED
        POP P,U
        SKIPE NMPGS(U)  ;
         BUG            ;;THUS GUY'S CORE SHOULD BE GONE BY NOW
        POPJ P,


AEOFC:  UMOVE B,(J)
        LDB B,[400,,B]  ;OPER 50
        ADDI B,IOCHNM(U)
        MOVE A,(B)
        MOVE A,CLSTB(A)
        HLR A,(B)
IFN NUNITS,     TLNE A,%CLSDI
.ALSO           SKIPA A,UTEOF(A)
        MOVEI A,EOFCH
        JRST APTUAJ

;OPER TO REQUEST OR FLUSH RUNNING IN IOT USER MODE
AIOTLS: MOVSI A,400000
        MOVSI B,%PCUIO
        XCTR XR,[SKIPGE (J)]
         JRST AIOTL1    ;JUMP IF WANT TO ENTER IOTLSR MODE
        ANDCAM A,IOTLSR(U)
        ANDCAM B,UUOH
        POPJ P,

AIOTL1: SKIPGE IOTLSR(U)
         JRST AIOTL2    ;ALREADY IN IOTLSR, JUST TURN THE BIT ON AGAIN FOR HIM
        BUG INFO,SIXBIT,UNAME(U),SIXBIT,JNAME(U),[IOTLSR]
        MOVEI T,SCRMSG  ;WAIT FOR IT TO BE PRINTED (HA HA WHAT ABOUT BUFFERING?)
        TDNE T,SUPCOR
         PUSHJ P,UFLS
        IORM A,IOTLSR(U)
AIOTL2: IORM B,UUOH
        JRST CLKONJ
\f
SUBTTL FILENAME TRANSLATION

;ROUTINE TO TRANSLATE A FILENAME.
;WANTS DEV, FN1, FN2, SNAME IN A, B, C, D RESP. LEFT-JUST.
;WANTS MODE IN RH OF E.
;RETURNS TRANSLATED NAMES IN SAME PLACE.
TRAN:   SKIPN D ;MAYBE DEFAULT THE SNAME.
TRAN6:  MOVE D,USYSNM(U)
        MOVEM B,EPDLT1(U)
        MOVEM C,EPDLT2(U)
        MOVEM D,EPDLT3(U)
        MOVEM A,EPDLT4(U)
        SKIPN TRNCNT    ;IF NO TRANSL. ENTRIES IN USE,
        JRST POPJ1      ;SHORT CUT.
        PUSHJ P,TRANRF  ;GET READ ACCESS TO TRANSL LISTS.
        LDB I,[100,,E]  ;GET INPUT/OUTPUT BIT.
        MOVEI H,10      ;MAX. NUM. TRANSLS ALLOWED.
TRAN0:  HRROI Q,(U)     ;1ST TRY THIS JOB'S TRNLST.
        MOVE J,TRNLST(U)
        JRST TRAN5
TRAN1:  SKIPGE Q,SUPPRO(Q)      ;MOVE UP TREE TO TRNLS1.
        SETZ Q,         ;AFTER TOP OF TREE, USE SYS.
TRAN2:  MOVE J,TRNLS1(Q)        ;USE THIS GUY'S TRNLS1.
        MOVEI Q,(Q)     ;INDICATE THAT FACT IN SIGN.
        JRST TRAN5
TRAN3:  CAME B,TRANI1(J)        ;ENTRY'S FN1 MATCHES
        SKIPN TRANI1(J) ;OR IS NULL?
        SKIPA TT,TRANI2(J)      ;YES, GET FN2.
        JRST TRAN4      ;NO, TRY NEXT ENTRY.
        CAME TT,C       ;FN2 MTCHES OR NULL.
        JUMPN TT,TRAN4
        CAME D,TRANIS(J)        ;SNAME ?
        SKIPN TRANIS(J)
        SKIPA TT,TRANID(J)      ;YES, GET DEV.
        JRST TRAN4
        CAME A,TT
        JUMPN TT,TRAN4  ;TEST DEV.
        HLRZ TT,TRANLK(J)       ;GET ENTRY'S MODE BITS.
        TRNN TT,1(I)    ;TRANSLATE OUR MODE?
        JRST TRAN4      ;NO.
        MOVEM B,EPDLT1(U)
        MOVEM C,EPDLT2(U)
        MOVEM D,EPDLT3(U)
        MOVEM A,EPDLT4(U)
IRPS X,,OD O1 O2 OS
        SKIPE TRAN!X(J)
        MOVE A+.IRPCN,TRAN!X(J)
TERMIN                  ;REPLACE NAMES FROM ENTRY.
        TRNE TT,400000  ;ATOMIC?
        JRST TRANX3     ;YES, EXIT.
        SOJG H,TRAN0    ;ELSE RETRANSL.
        JRST TRANX2     ;IF TOO MANY TRANSL., DON'T SKIP.

TRAN4:  HRRE J,TRANLK(J)        ;CDR DOWN LIST.
TRAN5:  JUMPGE J,TRAN3  ;TRY NEXT UNLESS AT END.
        JUMPL Q,TRAN2   ;IF DID TRNLST, DO SAME JOB'S TRNLS1.
        JUMPN Q,TRAN1   ;ELSE DO SUPPRO'S TRNLS1.
TRANX3: AOS (P)         ;EXIT IF DID SYS.
TRANX2: SOS TRNREF      ;NO LONGER USING TRANSL. LISTS.
        POPJ P,

TRANRF: AOS TRNREF      ;SAY USING TRANSL. LISTS.
        SKIPGE TRANSW
        POPJ P,         ;OK IF NOT BEING CHANGED.
        SOS TRNREF      ;NOT REFERENCING AFTER ALL.
        SKIPL TRANSW    ;WAIT TILL FREE.
        PUSHJ P,UFLS
        JRST TRANRF     ;TRY AGAIN.
\f;TRANS SYSTEM CALL.
NTRNS:  JSP T,DEFARG    ;DEFAULT 5 ARGS TO 0.
        5
        XOR E,CTLBTS(U) ;XOR CTL BITS WITH ARG S
        PUSHJ P,TRAN    ;TRANSLATE NAME.
         JRST OPNL3             ;FAIL IF TOO MANY TRANSL.
        JRST POPJ1      ;ELSE GIVE BACK TRANSL'D NAMES.


DEFARG: CAML W,(T)      ;IF NOT ALL SPEC'D,
        JRST 1(T)
        SETZM A(W)      ;DEFAULT ONE AND RETRY.
        AOJA W,DEFARG

;LOCK TRANSW, AND SET UP 1ST ARG FOR NTRNAD, NTRNDL, NTRNCL.
;RH OF A HAS JOB SPEC; CONTROL BIT ARGS XOR'D INTO LH.
;THE 4.8 BIT, IF SET, INDICATES TRNLS1 RATHER THAN TRNLST.
;OTHER LH BITS IGNORED,, NOT CHANGED BY NTRNUI.
;ON RETURN, A'S LH IS UNCHANGED, RH IS SUCH THAT
;   TRANLK(A) IS THE ADDR OF THE SPECIFIED TRNLS VAR.
NTRNUI: PUSHJ P,SWTL
         TRANSW
        TSC A,CTLBTS(U)
        MOVEI J,(A)
        JSP T,NCRUI2    ;DECODE THE JOB-SPEC.
         JRST NTRNU1    ;JOB GUARANTEED WRITEABLE.
        JUMPE J,NTRNU1  ;ALLOW JOBS TO MUNG THE SYSTEM TRANSLATION LIST.
        JSP T,NCORWR    ;ELSE CHECK.
         JRST OPNL31    ;NOT WRITEABLE.
NTRNU1: CAIN J,-1
         JRST OPNL34    ;PDP6??
        HRRI A,TRNLST-TRANLK(J)
        TLNE A,200000   ;4.8 BIT SAYS WHICH TRNLS TO USE.
        ADDI A,TRNLS1-TRNLST
        JRST (Q)

;GET UP TO 4 ARGS INTO D ... D+3, FROM AOBJN PTR IN B.
NTRNGA: MOVSI H,-4      ;UP TO 4 ARGS.
        JUMPGE B,NTRNG3
NTRNG0: UMOVE J,(B)
        JUMPGE W,NTRNG2 ;W IS -1 FOR .TRANA, .TRAND;
        TRNN H,-1       ;IN THAT CASE LEFT-JUST. DEV. (1ST ARG)
        HRLZI J,(J)
NTRNG2: CAMN J,[SIXBIT/*/]
        MOVEI J,0       ;REPLACE * BY BLANK.
        MOVEM J,D(H)    ;STORE AWAY.
        AOBJP H,CPOPJ   ;DONE AFTER 4TH ARG.
        AOBJN B,NTRNG0  ;ELSE GET NEXT.
NTRNG3: SETZM D(H)      ;ZERO REMAINING ARGS.
        AOBJN H,NTRNG3
        POPJ P,
\f;TRANEX CALL  --  READ IN A JOB'S TRANSL LIST.
;1ST ARG RH - JOB SPEC. BIT 4.8 - IF SET, TRNLS1 NOT TRNLST.
;2ND ARG AOBJN -> PLACE TO STORE LIST INTO.
;UPDATED AOBJN PTR IS OUTPUT ARG.
;SKIPS IF ENTIRE LIST FIT IN BUFFER.
;EACH ENTRY TAKES 9 WDS OF SPACE: MODE,, IN 1ST,
;INPUT DEV, FN1, FN2, SNAME; THEN OUTPUT DEV, FN1, FN2, SNAME.
NTRNEX: PUSHJ P,TRANRF  ;GET READ ACCESS TO TRANSL LISTS.
        PUSHJ P,SOSSET  ;RELINQUISH IF BLOCKED.
        TRNREF
        TSC A,CTLBTS(U)
        MOVEI J,(A)
        JSP T,NCRUI2    ;DECODE THE JOB SPEC.
         JFCL           ;NOT TRYING TO WRITE.
        HRRI A,TRNLST-TRANLK(J)
        TLNE A,200000   ;MAKE TRANLK(A) BE TRNLS VAR.
        ADDI A,TRNLS1-TRNLST
        SUB B,[1,,1]    ;SINCE WE AOBJ BEFORE ACTING.
NTRNE1: HRRE T,TRANLK(A)        ;AT END -> RETURN SKIPPING.
        JUMPL T,NTRNE8
        HLLZ D,TRANLK(T)        ;RETURN LH ONLY OF 1ST WD.
        TLOA T,-9
NTRNE2: MOVE D,TRANLK(T)        ;ALL OF OTHER 8 WDS.
        AOBJP B,[       PUSHJ P,OPNL37
                        JRST NTRNE9]
        ;FAIL IF NO ROOM.
        UMOVEM D,(B)
        ADDI T,SIOMT-1
        AOBJN T,NTRNE2  ;STORE ALL 9.
        MOVEI A,-9*SIOMT(T)     ;GO TO NEXT.
        JRST NTRNE1

NTRNE8: AOS (P)
        AOBJP B,.+1     ;COMPENSATE FOR SUB .
        PUSHJ P,LSWPOP  ;RELEASE READ ACCESS.
NTRNE9: MOVE A,B
        JRST SYSCPT     ;RETURN AOBJN PTR.
\f;TRANDL CALL -- DELETE ENTRY FROM TRANSL LIST.
;1ST ARG RH JOB SPEC. OF JOB WHICH IS OK TO MODIFY.
;1ST ARG LH MODE BITS AS FOR .TRANAD, ALSO 4.8 BIT SAYS TRNLS1
;       (SPEC'D JOB AND INFS, RATHER THAN JUST SPEC'D JOB)
;2ND ARG AOBJN -> INPUT DEV, FN1, FN2, SNAME. (ONLY DEV NEC.).
;SKIPS IF SOMETHING WAS DELETED.
NTRNDL: JSP Q,NTRNUI    ;PROCESS 1ST ARG., LOCK TRANSW.
NTRND:  PUSHJ P,NTRNDA  ;ACTUALLY DELETE.
        JRST OPNL4      ;NOTHING TO DELETE => FILE NOT FOUND
        JRST LSWPJ1     ;SKIP IF NTRNDA DID.

NTRNDA: TLZ A,-1#400003
        PUSHJ P,NTRNGA  ;ELSE GET INPUT NAMES.
        SKIPGE TRANLK(A)
        POPJ P,
        HRRZS (P)       ;CLEAR SKIP FLAG.
        SKIPA T,A
NTRND2: MOVEI T,(H)     ;CDR DOWN BOTH PTRS.
NTRND0: HRRE H,TRANLK(T)        ;LOOK AT NEXT ENTRY.
        JUMPL H,NTRNDX  ;EXIT IF END.
        CAMN D,TRANID(H)        ;ALL 4 INPUT NAMES MUST MATCH.
        CAME E,TRANI1(H)
        JRST NTRND2     ;ELSE NOT TO BE DELETED.
        CAMN TT,TRANI2(H)
        CAME I,TRANIS(H)
        JRST NTRND2
        HLLZ R,A        ;GET MODE FROM ARG.
        TLZ R,400000    ;DONT CLOBBER ATOM BIT
        ANDCA R,TRANLK(H)       ;TURN OFF IN MODE FROM ENTRY.
        CAME R,TRANLK(H)        ;IF DELETED ONE, CALL WILL SKIP.
        HRROS (P)
        MOVEM R,TRANLK(H)
        TLNE R,3                ;IF NEITHER DIRECTION LEFT, SPLICE OUT.
        JRST NTRND2
        SKIPE TRNREF    ;WAIT TILL NOONE READING TRANSL LISTS.
        PUSHJ P,UFLS
        SOS TRNCNT      ;ONE LESS ENTRY IN USE.
        HRRZ R,TRANFL   ;MAKE LINK -> CURRENT FREE LIST.
        EXCH R,TRANLK(H)
        HRRM R,TRANLK(T)        ;REST OF TRNLS INTO PREDECESSOR'S LINK.
        HRRZM H,TRANFL  ;ADD THIS ONE TO FREE LIST.
        JRST NTRND0

NTRNDX: HRRES TRANLK(A) ;IN CASE DELETED 1ST ENTRY.
        SKIPGE (P)
        AOS (P)         ;SKIP IF SET FLAG.
        POPJ P,
\f;TRANAD CALL. -- ADD AN ENTRY TO A TRANSL LIST.
;1ST 2 ARGS AS FOR TRANDL.
;3RD ARG LIKE 2ND BUT GIVES OUTPUT NAMES.
;SKIPS UNLESS ALL ENTRIES WERE IN USE.
NTRNAD: JSP Q,NTRNUI
NTRNA:  TLNN A,3        ;IF RELLY NOTHING WOULD BE TRANSL'D,
         JRST LSWPJ1    ;DON'T BOTHER ADDING..
        PUSHJ P,NTRNDA  ;DELETE ANY EXISTING TRANSL. FOR THESE INPUT NAMES.
        JFCL            ;IF WERE NONE.
        SKIPGE T,TRANFL
        JRST OPNL5      ;NO FREE ENTRIES - DIRECTORY FULL.
        AOS TRNCNT      ;1 MORE ENTRY IN USE.
IRPS X,,ID I1 I2 IS
        MOVEM D+.IRPCN,TRAN!X(T)
TERMIN                  ;PUT INPUT NAMES INTO ENTRY.
        MOVE B,C
        PUSHJ P,NTRNGA  ;GET OUTPUT NAMES.
IRPS X,,OD O1 O2 OS
        MOVEM D+.IRPCN,TRAN!X(T)
TERMIN                  ;STORE OUTPUT NAMES.
        MOVE H,TRANLK(A)        ;PUT CURRENT TRNLS INTO LINK.
        EXCH H,TRANLK(T)
        HRREM H,TRANFL  ;STORE BACK REST OF FREE LIST.
        MOVEM T,TRANLK(A)       ;TRNLS NOW STARTS WITH THSI ONE.
        HLLM A,TRANLK(T)        ;STORE MODE BITS.
        JRST LSWPJ1
\f;TRANCL CALL -- RESET A ONE OR BOTH TRANSL LISTS FOR A JOB.
;1ST ARG RH HAS JOB SPEC OF MODIFYABLE JOB.
; BIT 4.8 CLEAR TRNLS1 VAR. (TRANSL FOR THIS JOB & INFS).
; BIT 4.7 CLEAR TRNLST VAR. (TRANSL FOR THIS JOB ONLY).
; ALWAYS SKIPS IF VALID.
NTRNCL: JSP Q,NTRNUI    ;RH(A) -> TRNLST OR TRNLS1 VAR.
        TLNE A,200000
        SUBI A,TRNLS1-TRNLST    ;MAKE -> TRNLST VAR.
        SUBI A,TRNLST-TRANLK
        JRST NTRNC4

NTRNCA: SUBI A,TRNLST-TRANLK    ;MAKE HOLD USR IDX.
NTRNC:  PUSHJ P,SWTL    ;GET WRITE ACCESS.
        TRANSW
NTRNC4: AOS (P)
        SKIPE TRNREF    ;WAIT FOR READ REFS TO FINISH.
        PUSHJ P,UFLS
        TLNN A,100000   ;IF 4.7, HANDLE TRNLST.
        JRST NTRNC0
        HRRE T,TRNLST(A)
        SETOM TRNLST(A) ;SET LIST TO NIL.
        JUMPGE T,NTRNC1 ;IF WASN'T NIL, FREE ENTRIES ON IT.
NTRNC0: TLZN A,200000   ;MAYBE HANDLE TRNLS1.
        JRST LSWPOP
        HRRE T,TRNLS1(A)
        SETOM TRNLS1(A)
        JUMPL T,LSWPOP  ;NOTHING TO DO IF ALREADY NIL.
NTRNC1: MOVEI C,(T)     ;SAVE START OF LIST.
NTRNC2: SOS TRNCNT      ;UPDATE NUM ENTRIES IN USE.
        HRRES H,TRANLK(T)
        JUMPL H,NTRNC3  ;AT END, SPLICE INTO FREELIST.
        MOVEI T,(H)     ;ELSE CDR DOWN.
        JRST NTRNC2
NTRNC3: EXCH C,TRANFL
        HRRZM C,TRANLK(T)
        JRST NTRNC0     ;MAYBE CONSIDER THE OTHER LIST.
\f;.TRANA, .TRAND CALLS.
ATRANA: UMOVE E,(B)
        JSP T,ATRNDT    ;SET UP ARGS FOR NTRNA .
        PUSHJ P,SWTL    ;GET WRITE ACCESS.
        TRANSW
        JRST NTRNA

ATRNDL:
ATRAND: XCTR XR,[SKIPN E,(B)]
        JRST ATRND0     ;ZERO UNAME -> TRANCL .
        JSP T,ATRNDT    ;SET UP ARGS.
        PUSHJ P,SWTL    ;GET WRITE ACCESS.
        TRANSW
        JRST NTRND

ATRND0: JSP T,ATRNDT
        TLO A,300000    ;SAY CLEAR BOTH LISTS.
        CAMN D,[SIXBIT/*/]
        SUBI A,TRNLS1-TRNLST    ;NAKE SURE -> TRNLST VAR.
        JRST NTRNCA

ATRNDT: MOVE C,JNAME(U)
        MOVEM C,ATRNJN  ;WHO THE HELL'S USING THESE?
        CAME E,UNAME(U) ;UNAME MUST BE 0 OR THSI JOB'S.
        JUMPN E,CPOPJ   ;ELSE MAKE UUO FAIL.
        MOVNI W,1       ;SIGNAL TO NTRNGA.
        MOVEI C,5(B)    ;SET UP 2 AOBJN PTRS
        MOVEI B,2(B)
        HRLI C,-3       ;-> INPUT NAMES (B), OUTPUT NAMES (C).
        HRLI B,-3
        XCTR XR,[HLL A,(B)]     ;GET MODE BITS.
        UMOVE D,-1(B)
        JUMPE D,CPOPJ   ;JNAME MUSTN'T BE 0.
        CAME D,[SIXBIT/*/]      ;IF *, USE THIS JOB'S TRNLS1.
        JRST ATRND2
        HRRI A,TRNLS1-TRANLK(U)
        JRST (T)

ATRND2: MOVEI H,0       ;ELSE FIND JOB WITH THAT JNAME.
        MOVE E,UNAME(U) ;THIS JOB'S UNAME.
ATRND1: CAMN E,UNAME(H)
        CAME D,JNAME(H)
        JRST ATRND3     ;NOT THE ONE WE'RE LOOKING FOR.
        HRRE E,SUPPRO(H)
        CAIE U,(E)      ;IS THIS OUR INF.
        CAIN U,(H)      ;IS IT THE CURRENT JOB?
        CAIA
        POPJ P,         ;NO, CAN'T SET ITS TRANSL LIST.
        HRRI A,TRNLST-TRANLK(H)
        JRST (T)        ;OK, SET ITS TRNLST VAR.
ATRND3: ADDI H,LUBLK
        CAMGE H,USRHI   ;LOOK AT ALL JOBS.
        JRST ATRND1
        POPJ P,         ;CAN'D TRANAD NON EX JOB.
\f
SUBTTL JOB, BOJ DEVICE ROUTINES

EBLK
JBMN==10        ;MAXIMUM NUMBER OF JOBS ON JOB DEVICE

JBCUI:  REPEAT JBMN,-1  ;-1 => CHNL FREE, ELSE (IF JBCG POSITIVE) CREATOR'S USR IDX.
JBCG:   BLOCK JBMN      ;-1 IF CREATOR GONE AWAY
JBWST:  REPEAT JBMN,SNJOB       ;CREATED JOB'S WAIT STATUS (CREATED JOB=HANDLER JOB)
%JB==1,,525252
%JBWIN==400000  ;4.9 => CREATED JOB HAS DONE A SUCCESSFUL JOBRET
%JBREU==200000  ;4.8 => JOB CLOSED AND MADE ITSELF AVAILABLE FOR REUSE
%JBVAL==020000  ;4.5 => VALID BIT (CREATOR CAME IN, NO JOBRET YET)
%JBSTR==010000  ;4.4 => STORED BIT (CREATOR CAME IN, NO JOBGET YET)
%JBUNH==004000  ;4.3 => BOJ BLK UNHANG BIT
%JBSIO==001000  ;4.1 => IF DOING AN IOT, THIS BITS SAYS ITS REALLY A SIOT
%JBLOS==000400  ;3.9 => CREATED JOB WAS CLOSED AND KNOWS IT, SO DON'T REUSE
        ;1.1-2.9 => LAST STATUS SET BY BOJ

JBDEV:  BLOCK JBMN      ;DEVICE NAME, USER-SETTABLE (MOSTLY FOR PEEK AND WHO LINES)
JBFN1:  BLOCK JBMN      ;FN1
JBFN2:  BLOCK JBMN      ;FN2
JBSYS:  BLOCK JBMN      ;SYSNAME
JBOPNM: BLOCK JBMN      ;OPEN MODE
JBFNP:  BLOCK JBMN      ;BP TO ASCIZ FILENAME STRING IN USER ADDRESS SPACE (OR 0 IF NONE).
JBCJUI: BLOCK JBMN      ;RH = CREATED JOB'S USER INDEX.
                        ;LH = -1 IFF CREATED JOB GOING AWAY.  JOB MUST EXIST
                        ;SINCE WHEN IT DIES IT FLUSHES THE JOB CHANNEL
                        ;AND ITS CREATOR'S CHANNELS.
JBSTS:  BLOCK JBMN      ;STATUS OF JOB-BOJ INTERACTIONS
;4.9=1 => IMAGE =0 => ASCII
;4.8=1 => BLOCK =0 => UNIT
;4.7=1 => WRITE =0 => READ
;4.6-4.3 => NUMBER OF TIMES TO SKIP
;4.2-3.6 => OPEN LOSS
;3.5-3.2 => # OF ARGS ON LAST .CALL
;1.4 => SYSTEM CALL OTHER THAN THOSE BELOW.
;1.3-1.1 => SYSTEM CALL
        ;0      OPEN
        ;1      IOT OR SIOT
        ;2      MLINK
        ;3      RESET
        ;4      RCHST
        ;5      ACCESS
        ;6      FDELE (DELETE OR RENAME)
        ;7      FDELE (RENAME WHILE OPEN)

JBST2:  BLOCK JBMN      ;SECOND WORD OF JOBGET INFO
                        ;FOR UNIT IOT, 1
                        ;FOR SIOT, THE BYTE COUNT
                        ;FOR BLOCK IOT, THE BLOCK POINTER
                        ;NEW FN1 FOR RENAME, MLINK.
JBOFN1: BLOCK JBMN      ;FN1 BEFORE LAST TRANS
JBOFN2: BLOCK JBMN      ;FN2 "" ""
JBOSYN: BLOCK JBMN      ;SYSNAM ""
JBODEV: BLOCK JBMN      ;DEV  " "
JBNFN2: BLOCK JBMN      ;NEW FN2 FOR FDELE.
JBAC7:  BLOCK JBMN      ;7TH ARG TO .CALL, NEW SNAME FOR MLINK.
JBAC10: BLOCK JBMN      ;TABLE FOR .CALL ARG 10, FIRST BP ARG TO SOPEN/RENAME/MLINK/DELETE.
JBAC11: BLOCK JBMN      ;TABLE FOR .CALL ARG 11, SECOND BP ARG TO RENAME, MLINK OR RENMWO.

JBACTB: JBST2(H)        ;TABLE OF POINTERS TO .CALL ARG TABLES
        JBOFN1(H)
        JBOFN2(H)
        JBOSYN(H)
        JBODEV(H)
        JBNFN2(H)
        JBAC7(H)
        JBAC10(H)
        JBAC11(H)

JBIOCJ: BLOCK JBMN      ;IO CHNL ERROR WORD.  4.9 => IOCER ON NEXT JOB IOT
                        ;RH = IOCER TYPE

JBSW:   -1              ;LOCK ON ASSIGNMENT OF INDEX IN ABOVE TABLES
        0
BBLK
\f
;OPEN ON BOJ: DEVICE

;3.5 = 1 => UNHANG ON BLK IOT AFTER EACH XFER OF MAXIMAL SIZE
BOJO:   JUMPN W,OPNL12  ;NO SUCH MODE
        SKIPGE E,JBI(U) ;JOB CHANNEL INDEX
         JRST [ MOVE E,OPTION(U) ;IF THIS JOB ISN'T A JOB DEVICE,
                TLNN E,%OPOJB   ;IF IT'S EXPECTING TO BE AN OJB DEVICE, OK.
                 JRST OPNL10    ;OTHERWISE IT CAN'T WIN.
                SKIPGE JBI(U)   ;IF IT CAN WIN, WAIT TILL IT HAS.
                 PUSHJ P,UFLS
                JRST BOJO]      ;THEN TRY AGAIN.
        CAIL E,JBMN
         BUG            ;JOB CHANNEL INDEX TOO BIG
        CAME U,JBCJUI(E)
         BUG
        HRLZ A,E
        HLRZS C
        MOVSI TT,%JBUNH
        TRNE C,20
         IORM TT,JBWST(E)
        JSP Q,OPSLC7
            BDUAI,,BDUAO
            BDBI,,BDBO
            BDUII,,BDUIO
            BDBI,,BDBO
\f
;OPEN ON JOB: DEVICE
;MODE BITS:
;3.1-3.3 => IMAGE/ASCII, BLOCK/UNIT, OUTPUT/INPUT
;A,B HAVE FILENAMES, RH(C) HAS DEVICE (JOB OR OJB)
;RH(D) AND LH(C) BOTH HAVE OPEN-MODE.

JOBO:   PUSHJ P,FLDRCK
         JRST JOBO3
          JRST OPNL11   ;ILLEGAL FILE NAME
JOBO3:  CAMN A,[SIXBIT /M.F.D./]
         CAME B,[SIXBIT /(FILE)/]
          JRST JOBO2
        JRST OPNL11     ;ILLEGAL FILE NAME
JOBO2:  MOVEI J,0       ;SET J TO JOBGET "COMMAND" NUMBER
        CAIN W,2
         MOVEI J,2      ;MLINK, MOSTLY JUST LIKE FDELE, BUT SEE JOBOF3
        CAIN W,4
         MOVEI J,6      ;FDELE
        MOVNI E,1
        MOVSI Q,-JBMN
        PUSHJ P,SWTL    ;LOCK JOB CHNL ASSIGN SWITCH
            JBSW
JOBO5:  SKIPGE TT,JBCUI(Q)      ;SKIP IF NOT FREE
         JRST JOBO4
        MOVE T,UUOH
        TLNN T,%PCFPD
         JRST JOBORU    ;JUMP IF THIS IS FIRST ATTEMPT TO OPEN
        HRRZ H,C
        CAIN H,'OJB
         JRST JOBO6
        SKIPGE JBCG(Q)  ;LOOK FOR CHANNEL ON WHICH THIS USER
         CAIE TT,(U)    ;PREVIOUSLY ATTEMPTED TO OPEN, BUT PCLSRED
          JRST JOBO6
        MOVE T,EPDLT1(U)
        MOVE TT,EPDLT2(U)
        CAMN T,JBFN1(Q)
         CAME TT,JBFN2(Q)
          JRST JOBO6            ;NOT OPENING SAME FILE
        MOVE TT,EPDLT4(U)
        MOVE T,EPDLT3(U)
        CAMN TT,JBDEV(Q)
         CAME T,JBSYS(Q)
          JRST JOBO6            ;NOT FOR SAME FILE
        CONO PI,CLKOFF
        HLRZ H,C
        HRRZ T,JBSTS(Q)
        CAIN T,(J)
         CAME H,JBOPNM(Q)
          JRST JOBO6            ;NOT FOR SAME OPEN TYPE AND MODE
        MOVE TT,JBWST(Q)
        TLNE TT,%JBLOS+%JBWIN+%JBREU
         JRST JOBO6             ;HANDLER JOB NOT IN CORRECT STATE
        HRRZ E,Q        ;REUSE SAME HANDLER JOB AS IN PREVIOUS ATTEMPT TO OPEN
        SETZM JBCG(E)   ;I'M BACK
        PUSHJ P,LSWPOP  ;FREE JBSW
        TLO TT,%JBVAL
        MOVEM TT,JBWST(E) ;RE-GIVE OPEN COMMAND STILL SITTING IN JBSTS ETC.
        HRLI E,400000   ;OPEN-TYPE WAIT
        PUSHJ P,JBWT2   ;WAIT FOR HANDLER JOB TO PROCESS IT
        JRST JOBO8      ;FINISH OFF THEN OPEN

;FIRST ATTEMPT TO OPEN, CHECK FOR REUSEABLE HANDLER JOBS BEFORE CREATING NEW
JOBORU: CONO PI,CLKOFF
        MOVE TT,JBWST(Q)
        SKIPGE JBCG(Q)
         TLZN TT,%JBREU
          JRST JOBO6    ;IN USE ALREADY OR NOT WILLING TO BE REUSED
        MOVE T,EPDLT4(U)
        CAMN T,JBODEV(Q)
         JRST JOBOR1    ;IF SAME SIMULATED DEVICE, OK TO SIEZE
        CAMN A,JBOFN1(Q)
         CAME B,JBOFN2(Q)
          JRST JOBO6    ;DIFFERENT HANDLER NAME
        MOVE T,USYSN1(U)
        CAME T,JBOSYN(Q)
         JRST JOBO6     ;DIFFERENT HANDLER NAME
JOBOR1: MOVEM TT,JBWST(Q) ;THIS ONE OK, SIEZE IT
        HRRZ E,Q
        MOVEM U,JBCUI(E)
        HLRZM C,JBOPNM(E)
        SETZM JBCG(E)
        SETZM JBIOCJ(E)
        PUSHJ P,LSWPOP  ;FREE JBSW
        JRST JOBO7
\f
JOBO4:  HRRZ E,Q        ;REMEMBER FREE JOB CHNL IN CASE NEEDED
JOBO6:  CONO PI,CLKON
        AOBJN Q,JOBO5   ;SCAN REST OF JOB CHANNELS
        JUMPL E,OPNL6   ;DEVICE FULL
        MOVEM U,JBCUI(E);STORE CREATOR'S USER INDEX
        PUSHJ P,LSWPOP  ;FREE JOBSW
        PUSHJ P,STMSET  ;SETOM JBCUI(E) ON LOSSAGE
            JBCUI(E)
        SETZM JBDEV(E)
        SETZM JBFNP(E)
        HLRZM C,JBOPNM(E)
        SETZM JBCG(E)
        SETZM JBIOCJ(E)
        MOVEI T,SNJOB   ;INITIALIZE STATUS
        MOVEM T,JBWST(E)
        PUSH P,R
        PUSH P,U
        PUSH P,J
        PUSH P,D
        PUSH P,E
        PUSH P,A
        PUSH P,B
        ANDI C,-1       ;FOR OJB DEVICE, LOOK FOR EXISTING JOB.
        CAIN C,'OJB
         JRST JOBO6B
        MOVE A,UNAME(U) ;FOR JOB DEVICE, CREATE NEW JOB.
        IDIVI E,10.
        MOVEI B,'0(E)
        LSH B,6
        ADDI B,'0(TT)
        ADD B,[SIXBIT /JOB./]   ;CREATE JNAME = 'JOB.MN'
        MOVE C,[7,,(SIXBIT /USR/)]
        MOVE D,[SETZ 3]
        PUSHJ P,USROJ   ;GENERATE USER(CAN ONLY PCLSR BEFORE CREATING INFERIOR)
         JRST POP7J     ;USER OPEN FAILED, MUST HAVE GONE TO OPNL ALREADY
        CONO PI,CLKOFF
        POP P,B
        POP P,A
        POP P,E
        SETOM SUPPRO(TT)
        MOVE T,[JBSTCD,,AC0S]
        ADDI T,(TT)
        BLT T,AC17S(TT)
        HRLZI T,%PCUSR
        MOVEM T,UPC(TT)
        MOVEM A,AC0S+10(TT)
        MOVEM B,AC0S+11(TT)
        MOVE T,USYSN1(U)
        MOVEM T,USYSNM(TT)      ;SET CREATED JOB'S SYS NAME TO OURS
        SETZM USTP(TT)          ;START JOB AS SOON AS CLK BACK ON
        JRST JOBO6C
\f
;OJB: DEVICE, LOOK FOR JOB WHOSE NAMES ARE THE FILENAMES SPECIFIED IN THE OJB OPEN.
JOBO6B: MOVE C,[7+UBPFJ,,'USR]  ;DON'T EVER CREATE JOB FOR OJB.
        MOVE D,[SETZ 3+UBPFJ_<-1>]
        PUSHJ P,USROOJ
         JRST POP7J
        SUB P,[2,,2]
        POP P,E
;TT HAS USER IDX OF JOB TO BE USED; CAN'T PCLSR AFTER THIS POINT.
JOBO6C: PUSHJ P,LSWDEL  ;SETOM JBCUI(E)
        POP P,D
        POP P,J
        POP P,U
        POP P,R
        HRRZM TT,JBCJUI(E)
        MOVEM E,JBI(TT)
JOBO7:  CONO PI,CLKOFF
        MOVE TT,EPDLT1(U)
        MOVEM TT,JBOFN1(E)
        MOVEM TT,JBFN1(E)
        MOVE TT,EPDLT2(U)
        MOVEM TT,JBOFN2(E)
        MOVEM TT,JBFN2(E)
        MOVE TT,EPDLT3(U)
        MOVEM TT,JBOSYN(E)
        MOVEM TT,JBSYS(E)
        MOVE TT,EPDLT4(U)
        MOVEM TT,JBODEV(E)
        MOVEM TT,JBDEV(E)
        MOVE TT,EPDL(U)
        MOVEM TT,JBAC10(E)
        MOVE TT,EPDL3(U)
        MOVEM TT,JBAC11(E)
        JUMPN J,[PUSHJ P,JFDEL5 ;DELETE/RENAME/MLINK
                 JRST JOBO9]
        LDB TT,[000300,,JBOPNM(E)]
        ROT TT,-3
        MOVEM TT,JBSTS(E)
        HRRZ C,JBOPNM(E)        ;GET ALL OF OPEN MODE
        MOVEM C,JBNFN2(E)       ;GIVE IT
JOBO9:  PUSHJ P,JBWT1           ;STORE STUFF AND HANG
JOBO8:  LDB TT,[350400,,JBSTS(E)]
        JUMPE TT,JOBOPL         ;OPEN LOST
        LDB C,[000400,,JBSTS(E)]
        JUMPN C,[ SETOM JBCG(E) ;DELETE/RENAME/MLINK
                  JRST POPJ1 ]
        MOVE C,JBOPNM(E)
        SETZM IOCHST-IOCHNM(R)
        HRLZ A,E
        JSP Q,OPSLC7
            JDUAI,,JDUAO
            JDBI,,JDBO
            JDUII,,JDUIO
            JDBI,,JDBO

JOBOPL: LDB C,[270600,,JBSTS(E)]
        SETOM JBCG(E)
        SKIPE C
         CAILE C,NOPNLS
          MOVEI C,22
        JRST OPNL1-1(C)

;RENAME WHILE OPEN ON JOB CHNL
JFDEL4: HLRZ E,(TT)     ;JOB CHNL INDEX
        MOVEI J,7
        PUSHJ P,JFDEL5  ;DO "FDELE"
        MOVE TT,EPDL3(U) ;PASS ALONG THE BP ARG IF THERE WAS ONE.
        MOVEM TT,JBAC11(E)
        SETZM JBAC10(E)
        JRST AIOCA1     ;GET RESULTS

;FDELE/RENMWO/MLINK ON JOB CHANNEL
JFDEL5: MOVEM J,JBSTS(E)
        MOVE TT,SRN3(U)   ;REMEMBER NAMES TO RENAME AS
        MOVEM TT,JBST2(E) ;FOR JOBGET TO RETURN.
        MOVE TT,SRN4(U)
        MOVEM TT,JBNFN2(E)
        MOVE TT,SRN5(U)   ;IN CASE THIS IS MLINK, MAKE SURE THE "TO" SNAME
        MOVEM TT,JBAC7(E) ;IS GIVEN TO JOBGET.
        CONO PI,CLKOFF
        POPJ P,
\f
;GIVE AN INTERRUPT TO THE JOB DEVICE HANDLER.
;JOB CHNL INDEX IN E,  CLOBBERS TT,J,Q,H
;CALL WITH CLKOFF

JBINT:  HRRZ TT,JBCJUI(E)
        MOVEI J,IOCHNM(TT)
        HRLI J,-20
        MOVSI H,%CLSBJ
JBINT1: MOVE Q,(J)
        TDNN H,CLSTB(Q) ;SKIP IF BOJ
JBINT2:  AOBJN J,JBINT1
        JUMPGE J,CPOPJ
        SUBI J,IOCHNM(TT)
        MOVE Q,CHNBIT(J)
        IORM Q,IFPIR(TT)
        ADDI J,IOCHNM(TT)
        JRST JBINT2

;THIS IS THE CODE PUT IN THE ACS TO LOAD IN THE JOB DEVICE HANDLER

JBSTCD: .OPEN 1,7       ;0
         .LOGOUT
        .CALL 12
         .LOGOUT
        .IOT 1,2
        .CLOSE 1,
        JRST (2)
        4,,(SIXBIT /DSK/)       ;7
        0       ;10 FN1
        0       ;11 FN2
        SETZ    ;12
        SIXBIT /LOAD/
        16
        SETZ 17
        -1      ;16 (LOAD INTO SELF)
        1       ;17

;HAND THE JOB DEVICE HANDLER A SYSTEM CALL AND WAIT FOR IT TO BE HANDLED.
;CALL WITH CLOCK OFF, JOB CHNL IN E
JBWT1:  TLOA E,400000   ;OPEN/FDELE/MLINK, CLOSE CHANNEL IF PCLSR
JBWT:    TLZ E,400000   ;NORMAL ENTRY POINT, DON'T CLOSE IF PCLSR
        TLZA E,200000
JBWTI:   HRLI E,200000  ;ENTER HERE TO INHIBIT SETTING %PCFPD IF PCLSR
        MOVSI TT,%JBVAL+%JBSTR
        IORM TT,JBWST(E)        ;TURN ON VALID AND STORED
JBWT2:  PUSHJ P,JBINT   ;GIVE INT
        PUSHJ P,LOSSET
            JBPCL       ;CLEAR VALID AND STORED IF PCLSR
        MOVE T,E        ;CAUSES EPDL2 TO HAVE JOB INDEX
        PCLT
JBFLS:  SKIP JBFLS
        PUSHJ P,UFLS    ;AWAIT RESULTS FROM HANDLER JOB
        MOVSI TT,%PCFPD
        ANDCAM TT,UUOH  ;NOW WE KNOW WE'LL RETURN TO USER WITHOUT PCLSRING FIRST
        JRST LSWDEL

JBPCL:  MOVE A,AC0S+E(U)        ;HERE IF PCLSR OUT
        SKIPL JBCJUI(A)         ;UNLESS HANDLER GOING AWAY
         TLNE A,200000          ;OR THIS SYSTEM CALL DOESN'T WANT IT,
          JRST JBPCL1
        MOVSI T,%PCFPD          ;SET FIRST PART DONE FLAG
        IORM T,UPC(U)           ;NOTE PCLSR HAS ALREADY MOVED UUOH INTO UPC
JBPCL1: MOVSI T,%JBVAL+%JBSTR   ;NOT VALID, NOT STORED
        ANDCAM T,JBWST(A)
        JUMPGE A,CPOPJ
        SETOM JBCG(A)   ;SAY THE CREATOR HAS CLOSED IT
IRPS X,,E TT J Q H
        PUSH P,X
TERMIN
        MOVE E,A        ;AND GIVE THE HANDLER AN INTERRUPT
        PUSHJ P,JBINT
IRPS X,,H Q J TT E
        POP P,X
TERMIN
        POPJ P,
\f
;JOB DEVICE BLOCK MODE IOT EITHER DIRECTION
JBBI:   XCTR XRW,[MOVES D,(C)]  ;REFERENCE POINTER
        LDB B,[410300,,D]
        CAIGE B,3
         POPJ P,
        MOVEM D,JBST2(A)
        MOVE B,C
        HRRZ T,D        ;-> FIRST WORD TO TRANSFER
        HLROS D         ;MINUS WORD COUNT
        IORI D,700000   ;FLUSH CHAR COUNT
        SUBM T,D        ;D -> LAST WORD + 1 TO TRANSFER
        JRST JBIPG      ;SWAP IN BUFFER THEN DO IOT

;JOB DEVICE UNIT MODE IOT EITHER DIRECTION
        JRST JBSI       ;SIOT
JBUI:   MOVSI T,%JBSIOT
        ANDCAM T,JBWST(A)
        MOVEI T,1
        MOVEM T,JBST2(A)
        UMOVE W,(C)     ;FOR UNIT OUTPUT
JBIOT1: HRRZ TT,JBOPNM(A)
        ROT TT,-3       ;MODE
        HRRI TT,1       ;IOT CMD
        HRRZ E,A        ;JOB CHNL INDEX
        MOVEM TT,JBSTS(E)
        MOVEM C,SRN3(U) ;MAY BE ADDRESS OF BLOCK IOT POINTER
        CONO PI,CLKOFF
        SKIPL TT,JBIOCJ(E)
         JRST JBWTI     ;GO SIGNAL HANDLER JOB
        SETZM JBIOCJ(E) ;TAKE IOC ERROR INSTEAD
        JRST IOCERF-MIOTER(TT)

;JOB DEVICE SIOT EITHER DIRECTION
JBSI:   AOS (P)                 ;SIOT SHOULD SKIP RETURN
        MOVSI T,%JBSIOT
        IORM T,JBWST(A)
        XCTR XRW,[MOVES T,(B)]  ;BYTE PNTR ARG
        LDB E,[300600,,T]       ;BYTE SIZE
        MOVEI D,36.
        IDIVM D,E       ;E := # BYTES PER WORD
        XCTR XRW,[MOVES D,(C)]  ;BYTE COUNT ARG
        MOVEM D,JBST2(A)
        IDIV D,E        ;D := WORD COUNT, E := EXCESS BYTES
        IBP T           ;-> FIRST WORD TO TRANSFER
        ADD D,T
        SOJLE E,JBIPG
JBSI1:  IBP D
        SOJG E,JBSI1
JBIPG:  HRRZS D         ;-> LAST WORD TO TRANSFER + 1
        ANDI T,-2000    ;-> FIRST PAGE INVOLVED IN TRANSFER
        LDB E,[.BP .UII#.UIO,JBOPNM(A)] ;0 INPUT 1 OUTPUT
JBIPG1: SKIPE E         ;SWAP IN THE NECESSARY PAGES
         XCTR XR,[SKIPA 20(T)]
          XCTR XRW,[MOVES 20(T)]
        ADDI T,2000
        CAMGE T,D
         JRST JBIPG1
        JRST JBIOT1
\f
;FLSINS ROUTINE TO WAIT FOR CREATOR TO BE HUNG AT JBFLS
;4.9 OF SRN3 = 1 => WAIT FOR WRITE   0 => READ
;1.1-1.4 => CODE OF UUO TO WAIT FOR

BJWAIT: SKIPE B,FLSINS(T)
         CAME B,JBFLS
          POPJ P,       ;NOT HUNG AT JBFLS
        HRRZ B,EPDL2(T) ;JOB INDEX THAT CREATOR IS HACKING
        HLRZ E,T        ;JOB INDEX OF BOJ USER
        CAME B,E
         POPJ P,        ;CREATOR HACKING JOB DEVICE ON SOME OTHER CHANNEL
        MOVE TT,JBSTS(B)
        LSH TT,2        ;4.9 => READ/WRITE BIT NOW
        EQV TT,SRN3(U)  ;4.9 OF SRN3 => WHAT TO LOOK FOR
        JUMPGE TT,CPOPJ ;DOESN'T MATCH
        MOVE TT,JBSTS(B) ;INSN CREATOR IS DOING
        XOR TT,SRN3(U)  ;INSN LOOKING FOR
        TRNN TT,17
         AOS (P)        ;THEY MATCH, AWAKEN BOJ JOB
        POPJ P,
\f
;BOJ DEVICE UNIT MODE OUTPUT
BJUO:   SKIPGE C
         SKIPA H,(C)
          UMOVE H,(C)
        MOVEI B,1       ;WAIT FOR INPUT IOT
        MOVEM B,SRN3(U)
        HRLZ T,A        ;JOB INDEX
        HRR T,JBCUI(A)  ;CREATOR'S USER INDEX
        PUSHJ P,CWAIT   ;WAIT FOR CREATOR TO BE IN IOT, RETURN WITH CLK OFF
            PUSHJ P,BJWAIT
        PUSHJ P,BJUO1
        JRST CLKONJ

BJUO1:  MOVE TT,JBSTS(A)
        TLNE TT,200000
         JRST BJUOB     ;BLOCK MODE CREATOR IOT
        LDB D,[.BP (%JBSIOT),JBWST(A)]
        JUMPN D,BJUOS   ;CREATOR SIOT
        MOVEM H,AC0S+W(T)
BJIUNH: MOVSI D,%JBWIN
        IORM D,JBWST(A) ;SET SUCCESSFUL JOBRET BIT
        MOVSI D,%JBVAL+%JBSTR
        ANDCAM D,JBWST(A)
        MOVEI D,0
        DPB D,[350400,,JBSTS(A)]        ;DON'T SKIP
        EXCH D,FLSINS(T)        ;RESTART CREATOR
        CONSO PI,1
         CAME D,JBFLS
          BUG           ;HE WASNT WHERE HE BELONGED
        POPJ P,         ;NEED NOT CLKON, CALLER WILL TURN IT ON

;BOJ UNIT OUTPUT TO JOB SIOT
BJUOS:  PUSHJ P,BJBINI
        XCTRI XBYTE,[IDPB H,(B)]
         SKIPA C,AC0S+C(T)
          BUG
        XCTR XRW,[SOSG (C)]
         JRST BJIUNP
        JRST PLDZ

BJBINI: HRLI T,%UMALL
        MOVE J,T
        PUSHJ P,PLD1
        MOVE B,AC0S+B(T)
        XCTRI XRW,[MOVE D,(B)]
         POPJ P,
        BUG

;BOJ UNIT OUTPUT TO JOB BLOCK IOT
BJUOB:  PUSHJ P,BJBINI
        SKIPL JBSTS(A)
         JRST BJUOBA    ;ASCII
        XCTRI XW,[MOVEM H,(D)]
         CAIA
          BUG
        ADD D,[1,,1]
        XCTRI XW,[MOVEM D,(B)]
         CAIA
          BUG
        JUMPGE D,BJIUNP
        JRST PLDZ

;BOJ UNIT OUTPUT TO JOB BLOCK IOT, ASCII MODE
BJUOBA: LDB E,[410300,,D]       ;CHAR COUNT
        CAIGE E,3
         JRST BJIUNP
        XCTRI XR,[MOVE W,(D)]
         SKIPA E,BTOCHT-3(E)
          BUG
        IDPB H,E
        XCTRI XW,[MOVEM W,(D)]
         CAIA
          BUG
        ADD D,[700000,,]
        TLNN D,500000
         ADD D,[500001,,1]
        XCTRI XW,[MOVEM D,(B)]
         CAIA
          BUG
        TLNE D,700000
         JRST PLDZ
BJIUNP: PUSHJ P,BJIUNH  ;UNHANG CREATOR
        JRST PLDZ
\f
;BOJ DEVICE BLOCK OUTPUT
BJBO:   SKIPGE JBCG(A)
         POPJ P,
        XCTR XRW,[MOVES D,(C)]  ;D GETS IOT POINTER
        LDB E,[410300,,D]
        CAIGE E,3
         POPJ P,
        HLRO B,D
        IORI B,700000   ;FLUSH CHAR CNT
        HRRZ T,D
        SUB T,B
        CAILE T,-1
         JRST IOADC             ;DON'T WRAP AROUND (WHY NOT?)
        UMOVE H,(D)             ;H GETS FIRST WORD
        MOVEI B,1
        PUSHJ P,BJBWT           ;WAIT FOR JOB INPUT IOT, COME BACK WITH CLK OFF.
         JRST CLKONJ            ;UNHANG
        MOVEI I,1               ;FOR BJBB
        MOVE TT,JBSTS(A)
        TLNE TT,200000
         JRST BJBB      ;CREATOR IOT IS IN BLOCK MODE
        JUMPGE TT,BJBOA ;CREATOR IOT IS ASCII
        ADD D,[1,,1]
BJBO1:  PUSH P,C
        PUSH P,D
        PUSHJ P,BJUO1
        POP P,D
        POP P,C
        XCTRI XW,[MOVEM D,(C)]
         SKIPA T,IOTTB+BDBO
          BUG
BJBEX:  TLNN D,700000
         JRST CLKONJ    ;BOJ BLOCK POINTER EXHAUSTED
        MOVE E,JBWST(A)
        CONO PI,CLKON
        TLNN E,%JBVAL   ;SKIP IF JOB IOT STILL WAITING FOR MORE
         TLNN E,%JBUNH
          JRST (T)      ;TRANSFER MORE
        POPJ P,         ;UNHANG BOJ IOT PREMATURELY

;BOJ BLOCK ASCII OUTPUT FETCH CHARACTER
BJBOA:  MOVE E,BTOCHT-3(E)
        MOVE W,H
        ILDB H,E
        ADD D,[700000,,]
        TLNN D,500000
         ADD D,[500001,,1]
        JRST BJBO1

;BOJ BLOCK IOT WAIT.  AWAITS JOB IOT, UNLESS UNHANGING.
;TURNS CLKOFF.  SKIPS UNLESS SUPPOSED TO UNHANG.
BJBWT:  MOVEM B,SRN3(U)         ;SAVE WHAT JOB UUO TO WAIT FOR
        HRLZ T,A                ;SET UP ARG FOR BJWAIT FLSINS
        HRR T,JBCUI(A)
        MOVE TT,JBWST(A)        ;CHECK FOR DON'T HANG MODE
        TLNE TT,%JBUNH
         JRST BJBWT1
        PUSHJ P,CWAIT           ;WAIT FOR JOB IOT
            PUSHJ P,BJWAIT
        JRST POPJ1

BJBWT1: CONO PI,CLKOFF          ;IF NOT ALREADY IN JOB IOT, DON'T WAIT
        JRST BJWAIT             ;TEST CREATOR STATUS, POPJ OR POPJ1
\f
;BOJ DEVICE UNIT MODE INPUT
BJUI:   MOVE B,[SETZ 1] ;WAIT FOR OUTPUT IOT
        MOVEM B,SRN3(U)
        HRLZ T,A        ;JOB INDEX
        HRR T,JBCUI(A)  ;CREATOR'S USER INDEX
        PUSHJ P,CWAIT   ;WAIT FOR CREATOR TO IOT, RETURN WITH CLKOFF
            PUSHJ P,BJWAIT
        PUSHJ P,BJUI1
        JRST CLKONJ

BJUI1:  MOVE TT,JBSTS(A)
        TLNE TT,200000
         JRST BJUIB     ;BLOCK MODE CREATOR IOT
        LDB D,[.BP (%JBSIOT),JBWST(A)]
        JUMPN D,BJUIS
        MOVE W,AC0S+W(T)
        JRST BJIUNH     ;SUCCESSFUL

;BOJ UNIT INPUT FROM JOB SIOT
BJUIS:  PUSHJ P,BJBINI
        XCTRI XBYTE,[ILDB W,(B)]
         SKIPA C,AC0S+C(T)
          BUG
        XCTR XRW,[SOSG (C)]
         JRST BJIUNP
        JRST PLDZ

;BOJ UNIT INPUT FROM JOB BLOCK IOT
BJUIB:  PUSHJ P,BJBINI
        SKIPL JBSTS(A)
         JRST BJUIBA
        XCTRI XR,[MOVE W,(D)]
         CAIA
          BUG
        ADD D,[1,,1]
        XCTRI XW,[MOVEM D,(B)]
         CAIA
          BUG
        JUMPGE D,BJIUNP
        JRST PLDZ

;BOJ UNIT INPUT FROM JOB BLOCK IOT, ASCII MODE
BJUIBA: LDB E,[410300,,D]       ;CHAR COUNT
        MOVEI W,0
        CAIGE E,3
         JRST BJIUNP
        XCTRI XR,[MOVE W,(B)]
         SKIPA E,BTOCHT-3(E)
          BUG
        ILDB W,E
        ADD D,[700000,,]
        TLNN D,500000
         ADD D,[500001,,1]
        XCTRI XW,[MOVEM D,(B)]
         CAIA
          BUG
        TLNN D,700000
         JRST BJIUNP
        JRST PLDZ
\f
;BOJ DEVICE BLOCK MODE INPUT
BJBI:   SKIPGE JBCG(A)
         POPJ P,                ;EOF
        XCTR XRW,[MOVES D,(C)]  ;D GETS IOT POINTER
        LDB B,[410300,,D]
        CAIGE B,3
         POPJ P,
        HLRO E,D
        IORI E,700000   ;FLUSH CHAR CNT
        HRRZ T,D
        SUB T,E
        CAILE T,-1
         JRST IOADC     ;DON'T WRAP AROUND
        MOVE B,[SETZ 1]
        PUSHJ P,BJBWT           ;WAIT FOR JOB OUTPUT IOT, COME BACK WITH CLK OFF
         JRST CLKONJ            ;UNHANG
        MOVEI I,0               ;FOR BJBB
        MOVE TT,JBSTS(A)
        TLNE TT,200000
         JRST BJBB      ;CREATOR IOT IS IN BLOCK MODE
        PUSH P,C
        PUSH P,D
        PUSHJ P,BJUI1   ;GET DATA OUT OF CREATOR UNIT MODE IOT
        POP P,D
        POP P,C
        MOVE H,W
        MOVEI T,BJBI
        JUMPGE TT,BJBIA ;ASCII
        XCTRI XW,[MOVEM H,(D)]
         CAIA
          BUG
        ADD D,[1,,1]
        JRST BJBIX

;BOJ BLOCK ASCII INPUT STORE CHAR
BJBIA:  LDB E,[410300,,D]
        CAIGE E,3
         JRST CLKONJ
        XCTRI XR,[MOVE W,(D)]
         SKIPA E,BTOCHT-3(E)
          BUG
        IDPB H,E
        XCTRI XW,[MOVEM W,(D)]
         CAIA
          BUG
        ADD D,[700000,,]
        TLNN D,500000
         ADD D,[500001,,1]
BJBIX:  MOVEI T,BJBI
        XCTRI XW,[MOVEM D,(C)]
         JRST BJBEX
          BUG
\f
BJOV:   BJBI
        BJBO

;BOJ BLOCK IOT TO/FROM JOB BLOCK IOT
BJBB:   MOVE J,T
        HRLI J,%UMALL   ;UMAPS FOR PURELY CREATOR IOT
        MOVEM J,SRN4(U)
BJBBL:  MOVE J,SRN4(U)
        PUSHJ P,PLD1
        MOVE E,SRN3(T)
        XCTRI XRW,[MOVES H,(E)]
         CAIA           ;H HAS JOB BLOCK IOT POINTER
          BUG
        PUSHJ P,PLDZ
        XCTRI XRW,[MOVES D,(C)]
         CAIA           ;D HAS BOJ BLOCK IOT POINTER
          BUG
        JUMPGE H,[PUSHJ P,BJIUNH
                  MOVE T,BJOV(I)
                  JRST BJBEX]
        JUMPGE D,CLKONJ
        HLRE B,H
        CAML D,H
         HLRE B,D       ;CHOOSE SMALLER OF TWO BLOCK SIZES
        MOVNS B         ;COUNT TO BE XFERRED
        HRLZ E,H        ;JOB ADDRESS
        HRR E,D         ;JOB,,BOJ  (FROM,,TO FOR BOJ INPUT)
        HLRZ Q,E        ;JOB ADDRESS
        CAIGE Q,20
         JRST BJBB1     ;JOB ADDR IS AN AC
        HRRZ J,T        ;SET UP UMAPS (JOB USER INDEX IN RH)
        TRZE E,400000
         TLOA J,%UMMPL  ;TO HI PG, HACK OUR LO PAGE
          TLO J,%UMMPU  ;TO LO PG, HACK OUR HI PAGE
        TLZE E,400000
         TLOA J,%UMLTU  ;TO POINT TO HIS UPPER
          TLO J,%UMUTL  ;TO POINT TO HIS LOWER
        TLNN J,%UMMPU+%UMUTL    ;MAPPING HIS UPPER FROM OUR LOWER?
         JRST BJBB3     ;YES.  MAKE SURE NOT SCREWED BY AC PNTR
BJBB3A: PUSHJ P,PLD1
        TRZ Q,400000
        MOVNS Q         ;LIMIT SIZE OF XFER TO MIN OF
        ADDI Q,400000   ;DIST OF TO ADR FROM SEG BOUNDARY
        CAMLE B,Q       ;AND DIST OF FROM ADR FROM SEG BOUNDARY
         HRRZ B,Q
        MOVNI Q,(E)     ; - BOJ ADDR
        ADDI Q,400000
        CAMLE B,Q
         HRRZ B,Q
        TLNN J,%UMMPL   ;BUGGER ADDRESSES SO RIGHT DBRS WILL BE USED
         TLOA E,400000  ;SET JOB ADDR TO HI SEG
          TRO E,400000  ;SET BOJ ADDR TO HI SEG
        SKIPE I
         MOVSS E        ;XFER OTHER DIRECTION
        MOVE Q,E        ;SAVE COPY OF BLT POINTER
        ADDI B,(E)      ;GET LA + 1
        XCTRI XBRW,[BLT E,-1(B)]        ;XFER DATA
         HRRZS E,B      ;NO FAULT.  SIMULATE STORE BACK OF POINTER (CAN BE 1,,0)
        PUSH P,J
        PUSHJ P,PLDZ
        SUBM E,Q
BJBB2:  HRLS Q          ;NUMBER OF WORDS ACTUALLY XFERRED IN BOTH HALVES
        XCTRI XRW,[ADDM Q,(C)]  ;UPDATE BOJ BLK PNTR
         JRST .+2
          BUG
        MOVE J,SRN4(U)
        PUSHJ P,PLD1    ;MAP TO CREATOR
        POP P,J
        MOVE W,SRN3(T)
        XCTRI XRW,[ADDM Q,(W)] ;UPDATE JOB BLK PNTR
         JRST .+2
          BUG
        CAIN B,(E)
         JRST BJBBL     ;NO FAULT, LOOP BACK
        PUSHJ P,PLD1    ;RESTORE TO FROB AT TIME OF FAULT
BJBBF:  PUSHJ P,TPFLT   ;TAKE FAULT (TURNS CLK ON)
        PUSHJ P,MPLDZ   ;RESTORE NORMAL MAP
        JRST @BJOV(I)   ;RESTART THE IOT
\f
;JOB ADDR IS AN AC
BJBB1:  ADDI Q,UUOACS(T)
        JUMPN I,BJBB1A
        MOVE B,(Q)      ;READ JOB WORD
BJBB3C: XCTRI XW,[MOVEM B,(E)]
         JRST .+2
          JRST BJBBF
BJBB2A: MOVEI Q,1       ;1 WORD XFERRED
        HRRZ B,E        ;FAKE OUT FAULT TEST
        PUSH P,J
        JRST BJBB2

BJBB1A: XCTRI XR,[MOVE B,(E)]
         JRST .+2
          JRST BJBBF
        MOVEM B,(Q)
        JRST BJBB2A

BJBB3:  TLNE E,777760   ;SKIP ON XFERRING FROM AC AREA, HI TO HI
         JRST BJBB3A    ;NO.  OK TO DO BLT
        JUMPN I,BJBB3B
        HRLI J,%UMALL   ;HACK OUR HI TO POINT TO HIS HI
        PUSHJ P,PLD1
        XCTRI XR,[MOVE B,(Q)]
         JRST .+2
          BUG
        PUSHJ P,PLDZ
        HRRZ E,D        ;TO ADDRESS
        JRST BJBB3C

BJBB3B: XCTRI XR,[MOVE B,(D)]
         JRST .+2
          JRST BJBBF
        HRLI J,%UMALL
        PUSHJ P,PLD1    ;HACK OUR HI TO POINT TO HIS HI
        XCTRI XW,[MOVEM B,(Q)]
         JRST .+2
          BUG
        PUSHJ P,PLDZ
        JRST BJBB2A
\f
;.CALL JOBGET
;ARG 1 - BOJ CHNL
;UP TO SIX WDS RETURNED
;WD1 BITS:
%JG==1,,525252
                ;4.9-4.7 => IMAGE/ASCII, BLOCK/UNIT, OUTPUT/INPUT
                ;    4.9-4.7 SHOULDN'T BE USED, SINCE THE FULL MODE IS IN WD7 ON AN OPEN
%JGCLS==40000   ;4.6 => CLOSE  (NOTE 4.5 USED TO BE A CLS BIT ALSO)
%JGSIO==1000    ;4.1 => SIOT (ONLY IF OPCODE = 1)
%JGFPD==200     ;3.8 => THIS CALL WAS PCLSRED AND IS RESTARTING
;1.4-1.1 => TYPE OF OPERATION
%JO==,,-1
%JOOPN==0       ;OPEN
%JOIOT==1       ;IOT/SIOT
%JOLNK==2       ;MLINK
%JORST==3       ;RESET
%JORCH==4       ;RCHST
%JOACC==5       ;ACCESS
%JORNM==6       ;FDELE (DELETE OR RENAME)
%JORWO==7       ;FDELE (RENAME WHILE OPEN)
%JOCAL==10      ;SYMBOLIC .CALL

;WD2 SET ONLY FOR BLOCK IOT POINTER, ACCESS POINTER, NEW FN1 FOR FDELE
;WD3    FN1
;WD4    FN2
;WD5    SYS NAME
;WD6    LEFT ADJUSTED DEVICE NAME
;WD7    NEW FN2 FOR FDELE.
;IGNORE ALL RETURNED INFO ON AN ERROR RETURN
;IF 4.5 OR 4.6 IS SET THEN ALL ELSE IS MEANINGLESS

NJBGT:  SETZM T         ;INDICATE JOBGET, NOT JOBCAL
NJBCL0: HLRZ E,H        ;GET JOB CHNL IDX FROM LH OF IOCHNM WD
        TLNN R,%CLSBJ   ;NOT A BOJ CHANNEL => WRONG TYPE DEVICE
         JRST OPNL34
        CONO PI,CLKOFF
        MOVE C,JBWST(E)
        TLNN C,%JBVAL
         JRST NJBGTE    ;FAIL IF VALID NOT SET
        TLZ C,%JBSTR
        MOVEM C,JBWST(E)        ;CLEAR STORED BIT
        MOVE B,JBCUI(E)
        MOVE B,SUUOH(B)
        CONO PI,CLKON
        MOVE A,JBSTS(E)
        TLZ A,077777    ;FLUSH RANDOM BITS FROM LH
        TLNE B,%PCFPD
         TLO A,%JGFPD
        TLNE C,%JBSIOT
         TLO A,%JGSIO
        JUMPN T,NJBCL1  ;BRANCH IF JOBCAL
NJBGT0: MOVE B,JBST2(E)
        MOVE C,JBOFN1(E)
        MOVE D,JBOFN2(E)
        MOVE TT,JBODEV(E)
        MOVE I,JBNFN2(E)
        MOVE E,JBOSYN(E)
        CONO PI,CLKON
        JRST POPJ1

NJBGTE: SKIPL JBCG(E)   ;HAS CREATOR GONE AWAY?
         JRST OPNL36    ;NO, VALID CLEAR
        CONO PI,CLKON   ;YES, GIVE CLOSE
        MOVSI A,%JBLOS
        IORM A,JBWST(E)
        MOVSI A,%JGCLS  ;GIVE CLOSE BITS
        JRST POPJ1      ;DON'T GIVE ANYTHING ELSE WHETHER JOBGET OR JOBCAL
\f
;       .CALL ADR
;       ERROR RETURN
;       NORMAL RETURN

;ADR:   SETZ
;       SIXBIT /JOBCAL/
;       [BOJCHNL]
;       [-N,,ADR OF DATA BUFFER]        ;OPTIONAL
;       SETZM OPCODE
; OPCODE WILL BE THE SAME AS RETURNED IN WD1 BY JOBGET
; IF OPCODE<10 THEN WD2-WD7 OF JOBGET WILL BE WRITTEN INTO DATA BUFFER
;       FOLLOWED BY JOB'S EPDL AND EPDL3 (THE BPS FOR BP-STYLE OPENS, ETC).
;IF OPCODE=10 THEN JOB'S LAST .CALL WILL BE DESCRIBED:
;       WORD 1 OF DATA BUFFER => SIXBIT OF OPERATION (I.E. THE NAME
;               OF THE .CALL)
;       WORD 2 OF DATA BUFFER => FLAG BITS OF .CALL
;       WORD 3 OF DATA BUFFER => # OF ARGS TO .CALL
;       WORDS 4-12 => INPUT ARGS TO .CALL

NJBCL:  CAIL W,2                ;DID CALLER SUPPLY AOBJN POINTER?
         SKIPN T,B              ;IF SO AND NON-ZERO USE IT
          MOVEI T,1             ;OTHERWISE SET T NONZERO
        JRST NJBCL0             ;GO JOIN JOBGET CODE FOR ERROR CHECKING

NJBCL1: JUMPGE T,POPJ1          ;BACK FROM JOBGET - ANY AOBJN PNTR?
        MOVEI C,9               ;YES - OPCODE 10?
        TRNN A,10
         JRST NJBCL2            ;NO - JUST COPY 9 STANDARD ARGS
        HLRE D,T                ;GET LENGTH OF USERS DATA BUFFER
        MOVE B,JBCUI(E)         ;GET JOB'S USER INDEX
        MOVE C,LSCALL(B)        ;GET NAME OF JOB'S LAST CALL
        UMOVEM C,(T)            ;PUT INTO CALLERS BUFFER
        AOJE D,POPJ1            ;IF NO MORE ROOM - DONE
        MOVE C,CTLBTS(B)        ;GET USER'S .CALL FLAG BITS
        UMOVEM C,1(T)
        AOJE D,POPJ1
        LDB C,[230400,,JBSTS(E)]        ;GET # OF ARGS
        UMOVEM C,2(T)
        JUMPE C,POPJ1           ;ANY ARGS TO PASS?
        ADD T,[3,,3]            ;YES - COPY INTO BUFFER
NJBCL2: JUMPGE T,POPJ1          ;ANY ROOM LEFT?
        MOVNS C                 ;GET SMALLEST WORD COUNT
        HLRE B,T
        CAMLE C,B
         HRL T,C                ;MAKE AOBJN PNTR AS SMALL AS POSSIBLE
        MOVE H,E                ;JOB INDEX IN H FOR USING JBACTB
        MOVEI B,JBACTB          ;GET PNTR TO ARG TABLES
NJBCL3: MOVE C,@(B)             ;GET NEXT ARG
        UMOVEM C,(T)            ;GIVE TO CALLER
        AOS B
        AOBJN T,NJBCL3
        JRST POPJ1              ;DONE - GO SKIP
\f
;       .CALL ADR
;       ERROR RETURN
;       NORMAL RETURN

;ADR:   SETZ
;       SIXBIT /JOBRET/
;       [BOJCHNL]
;       [OPEN LOSS #(IF RH = 0),,# TIMES FOR CREATING JOB TO SKIP]
;       SETZ [-N,,ADR OF DATA BUFFER]

;RETURN DATA (E.G. RETURN TO RCHST,STATUS OR THE RETURN ARGS TO A .CALL)
;WILL BE COPIED FROM THE CALLER'S DATA BUFFER

NJBRT:  HLRZ E,H        ;GET JOB CHNL IDX FROM LH OF IOCHNM WD
        TLNN R,%CLSBJ   ;NOT BOJ CHNL => WRONG TYPE DEVICE.
         JRST OPNL34
        CAIGE W,3       ;RETURN ARGS PROVIDED?
         SETZM C        ;NO - ZERO IT
        JUMPGE C,NJBRT1 ;DO NOTHING IF NO RETURNS OR NO AOBJN
        HLRE D,C        ;GET LENGTH OF BUFFER
        CAMGE D,[-8.]   ;MAKE SURE AREA AT MOST 8 LONG
         MOVNI D,8      ;OVER 8 - USE 8
        HRL C,D         ;FIX AOBJN PNTR
        MOVMS D
        ADDI D,-1(C)    ;GET ADDRESS OF LAST WORD NEEDED
        XCTR XR,[SKIP (C)]      ;MAKE SURE PAGES ARE IN
        XCTR XR,[SKIP (D)]
NJBRT1: CONO PI,CLKOFF  ;NOW OK TO TURN CLOCK OFF
        MOVE A,JBWST(E)
        TLNE A,%JBVAL
         TLNE A,%JBSTR
          JRST OPNL36   ;FAIL IF STORED IS SET OR IF VALID IS CLEARED
        SKIPGE JBCG(E)
         JRST OPNL41
        HRRZ TT,JBCUI(E)
        MOVE D,FLSINS(TT)
        CAME D,JBFLS
         BUG
        TLO A,%JBWIN
        TLZ A,%JBVAL+%JBSTR
        MOVEM A,JBWST(E)        ;SET SUCCESSFUL JOBRET BIT, CLEAR VALID AND STORED
        DPB B,[350400,,JBSTS(E)]        ;NUMBER OF TIMES TO SKIP
        MOVSS B
        DPB B,[270600,,JBSTS(E)]        ;OPEN LOSS
        MOVSI B,-6              ;DEFAULT # WDS TO RETURN FOR .RCHST IS 6.
        MOVEM B,JBAC11(E)
        JUMPGE C,NJBRT3         ;ANY RETURN ARGS?
        MOVEM C,JBAC11(E)       ;REMEMBER HOW MANY, FOR .RCHST TO RETURN THAT MANY.
        MOVE H,E                ;YES - COPY THEM
        MOVEI D,JBACTB
NJBRT2: XCTRI XR,[MOVE B,(C)]   ;GET IT
         AOSA D
          BUG                   ;PAGE IS TIED - NO?
        MOVEM B,@-1(D)          ;PUT INTO ARG TABLE
        AOBJN C,NJBRT2
NJBRT3: SETZM FLSINS(TT)        ;RESTART CREATOR
        JRST CLKOJ1

;JOB DEVICE CLOSE ROUTINE
JOBCLS: SETOM JBCG(A)
        MOVE E,A
        CONO PI,CLKOFF
        PUSHJ P,JBINT   ;INTERRUPT POOR BOJ GUY
        JRST CLKONJ     ;SINCE HE HAS NO CREATOR
\f
; ROUTINES FOR JOB ACCESS, RFPNTR, RESET, AND STATUS

RFPJOB: MOVEI J,4               ;USE OLD .RCHST OPERATION, OPCODE 4
        HRRM J,JBSTS(A)
        MOVE E,A
        CONO PI,CLKOFF
        PUSHJ P,JBWT            ;SIGNAL JOB, WAIT FOR ANSWER
        HLRE TT,JBAC11(E)       ;GET # VALUES RETURNED
        MOVNS TT
        CAIL TT,5
         SKIPA A,JBODEV(E)      ;GET ACCESS POINTER RETURNED
          SETO A,               ;NO ACCESS POINTER RETURNED, USE -1
        CAIL TT,6               ;UP TO TWO MORE EXTRA RCHST RESULTS MIGHT BE RETURNED
         MOVE Q,JBNFN2(E)
        CAIL TT,7
         MOVE I,JBAC7(E)
        CAIL TT,5
         MOVEI W,1(TT)          ;# RESULTS FOR RCHST
        MOVEI B,36.             ;ALWAYS RETURN 36. AS BYTE SIZE UNTIL MORE WINNING
        JRST POPJ1              ;CONVENTIONS EXIST.

JBSTAT: HLRZ A,(R)      ;GET JOB INDEX
        HRRZ D,JBWST(A) ;GET MOST RECENT STATUS
        POPJ P,

JBORS:
JBIRS:  MOVEI D,3       ;RESET IS OPCODE 3
        HLRZ A,(R)
        HRRM D,JBSTS(A)
        CONO PI,CLKOFF
        MOVE E,A
        PUSHJ P,JBWT    ;WAIT FOR IT TO GET PROCESSED
        POPJ P,

JBACCS: MOVEI D,5       ;ACCESS IS OPCODE 5
        HLRZ A,(R)
        HRRM D,JBSTS(A)
        MOVEM B,JBST2(A)
        CONO PI,CLKOFF
        MOVE E,A
        PUSHJ P,JBWT
        JRST POPJ1
\f
;.CALL JOBIOC           (OLD NAME SETIOC STILL WORKS)
;ARG1:  CHANNEL BOJ DEVICE IS OPEN ON
;ARG2:  TYPE OF IOCER TO CAUSE

;THIS CALL CAUSES THE NEXT IOT EXECUTED BY THE
;PROCEDURE ON THE OTHER END OF THE CHANNEL TO GET
;THE SPECIFIED IO CHANNEL ERROR

NSTIOC: HLRZ E,H        ;GET JOB CHNL IDX FROM LH OF IOCHNM WD.
        CAIL B,MIOTER
         CAILE B,NIOTER
          JRST OPNL33   ;BAD ARG. (NOT LEGAL IOCER)
        TLO B,(SETZ)    ;IN CASE IOCER 0 EVER EXISTS
        TLNN R,%CLSBJ
         JRST OPNL34    ;NOT BOJ CHANNEL
        CONO PI,CLKOFF
        MOVE A,JBCUI(E) ;PREPARE TO STOP CREATOR.
        SKIPGE JBCG(E)
         JRST OPNL41    ;CREATOR WENT AWAY
        MOVE H,APRC(A)
        TLNE H,BULGOS
         JRST OPNL41    ;HE'S BEING KILLED NOW.
        PUSHJ P,RPCLSR  ;STOP
        MOVEM B,JBIOCJ(E)
        AOS (P)
        JRST UPCLSR


;.CALL JOBSTS
;ARG1 - CHANNEL BOJ IS OPEN ON   - REMAINING ARGS ARE OPTIONAL  -
;ARG2 - NEW STATUS (RIGHT HALF OF STATUS WORD ONLY - I.E. DEVICE DEPENDENT STUFF)
;ARG3 - NEW DEVICE NAME FOR PEEK, WHO-LINE STATUS, RFNAME/RCHST
;ARG4 - NEW FN1 FOR ..
;ARG5 - NEW FN2 FOR ..
;ARG6 - NEW SNAME FOR ..
;ARG7 - NEW OPEN MODE FOR ..
;ARG8 - BP TO ASCIZ STRING IN USER ADDRESS SPACE CONTAINING FULL FILENAMES.

NJBSTS: TLNN R,%CLSBJ
         JRST OPNL34
        HLRZ A,(R)      ;GET JOB INDEX
        CAIGE W,2       ;DID HE SUPPLY STATUS?
         MOVEI B,SNJOB  ;NO - RESET TO INITIAL
        HRRM B,JBWST(A) ;REMEMBER WHAT HE SAYS
        MOVEI B,8
        SUB B,W
        JUMPGE B,.+1(B) ;STORE WHATEVER ADDITIONAL ARGS WERE GIVEN
          JSP B,NJBST2          ;8
          JSP B,NJBST1          ;7
          MOVEM TT,JBSYS(A)     ;6
          MOVEM E,JBFN2(A)      ;5
          MOVEM D,JBFN1(A)      ;4
          MOVEM C,JBDEV(A)      ;3
          JRST POPJ1            ;2
          JRST POPJ1            ;1   (DON'T TAKE THIS INSN OUT)

NJBST1: XOR I,JBOPNM(A)
        TRNE I,.BAO#.UAI
         JRST OPNL12            ;NOT ALLOWED TO CHANGE BLOCK VS UNIT, IN VS OUT
        XORM I,JBOPNM(A)
        JRST (B)

NJBST2: MOVE R,Q                ;STORE BP IN Q INTO JBFNP WORD,
        PUSHJ P,ASCIND          ;AFTER DOING INDEXING AND INDIRECT.
        MOVEM R,JBFNP(A)
        JRST (B)
\f
;       .CALL ADR       ;SKIPS UNLESS JOB END OF CHNL NOT THERE

;ADR:   SETZ
;       SIXBIT /JOBINT/
;       401000,,BOJCH

;GIVE CREATOR A SECOND WORD INT ON CHANNEL CORRESP TO BOJCH

NJBINT: TLNN R,%CLSBJ   ;ERROR IF NOT BOJ CHNL.
         JRST OPNL34
        CONO PI,CLKOFF
        HLRZ E,H
        SKIPGE JBCG(E)
         JRST OPNL41
        MOVE A,JBCUI(E)
        MOVSI D,%CLSJ
        SETZ C,
        PUSHJ P,CHSCAA
            PUSHJ P,[HRRZ B,(R)
                     SKIPGE R           ;IOPDL CHNLS DON'T INTERRUPT
                      TDNN D,CLSTB(B)
                       POPJ P,
                     HRRZ B,R
                     SUBI B,IOCHNM(A)
                     IOR C,CHNBIT(B)
                     POPJ P,]
        AND C,MSKST2(A)
        JUMPE C,OPNL41  ;I CAN'T
        MOVN B,C
        AND C,B         ;INT ONLY ONCE, ON HIGHEST NUMBERED CHANNEL
        IORM C,IFPIR(A)
        JRST CLKOJ1


;.CALL JOBREU
;ARG 1 - SIMULATED DEVICE NAME
;ARG 2 - FN1 OF ..
;ARG 3 - FN2 OF ..
;ARG 4 - SNAME OF FILE WHICH HANDLER LOADED FROM
;ARG 5 - AMOUNT OF TIME TO SLEEP WAITING FOR SOMEONE TO OPEN

;THIS CALL, WHEN EXECUTED BY A JOB DEVICE HANDLER JOB, MAKES
;THE HANDLER AVAILABLE FOR RE-USE.  TAKES SUCCESS RETURN IF
;SOMEONE REUSES YOU; YOU SHOULD THEN DO THE "INITIAL JOBGET"

NJBREU: SKIPGE H,JBI(U)
         JRST OPNL10    ;NOT A BOJ HANDLER JOB
        SKIPL JBCG(H)
         PUSHJ P,UFLS   ;WAIT FOR CLOSE TO FINISH HAPPENING
        MOVEM A,JBODEV(H)
        MOVEM B,JBOFN1(H)
        MOVEM C,JBOFN2(H)
        MOVEM D,JBOSYN(H)
        TLNE E,1000
         JRST [ MOVNI E,(E)     ;IMMEDIATE TIME, LOSE ON PCLSR
                SUB E,TIME      ;BUT ACCEPT ANYWAY SINCE NETBLK DOES
                JRST NJBRU1 ]
        MOVE TT,E
        UMOVE E,(TT)    ;GET TIME ARGUMENT
        JUMPL E,NJBRU1
        MOVNS E
        SUB E,TIME
        UMOVEM E,(TT)   ;POS REL TIME GIVEN, MAKE NEG ABS AND WRITE BACK
NJBRU1: MOVSI TT,%JBREU         ;E NOW HAS NEGATIVE TIME TO SLEEP UNTIL
        IORM TT,JBWST(H)
        PUSHJ P,LOSSET
            NJBRUL              ;TURN OFF %JBREU WHEN CALL EXITED FOR WHATEVER REASON
        SKIPA T,H
         PUSHJ P,NJBRUW
          PUSHJ P,UFLS
        SKIPGE JBCG(H)
         JRST OPNL41    ;TIMED OUT
        JRST LSWPJ1

;FLSINS ROUTINE TO WAIT UNTIL TIMED OUT OR OPENED BY SOMEONE
NJBRUW: MOVN A,AC0S+E(U)
        CAML A,TIME
         SKIPL JBCG(T)
          AOS (P)
        POPJ P,

;LOSSET ROUTINE TO LEAVE AWAITING-REUSE STATE
NJBRUL: MOVSI A,%JBREU
        MOVE T,AC0S+H(U)
        ANDCAM A,JBWST(T)
        POPJ P,
\f
SUBTTL PERIPHERAL DEVICE ROUTINES IN SEPARATE FILES

IFN NMTCS,[
 IFN TM10P,[
$INSRT MTAPE
 ]
 IFN TM03S,[
$INSRT NMTAPE
]
]
IFN NUNITS,[
$INSRT UTAPE
]

$INSRT DISK

IFN NETP,[      ; General ITS network code, includes specific nets
OVHMTR NET
$INSRT NET
]

IFN E.SP,[
$INSRT ITSDIS
]

IFN MSPP,[
$INSRT ITSMSP
]

$INSRT TS3TTY

$INSRT ITSDEV

.BYTE 0         ;RECORD THE SYMS .EVAL'ED BY USER PROGRAMS
$INSRT EVSYMS
.BYTE
\f
SUBTTL DM DAEMON UUO'S

IFE DEMON,ADEMON==ILUUO

IFN DEMON,[
ADEMON: JUMPE J,[AOJA J,.+2]    ;IF J = 0 THEN SUBTRACT ONE
        UMOVE J,(J)     ;GET VALUE HERE
        PUSHJ P,LSWTL
        400000,,DEMSW
        PUSHJ P,DEMUSR  ;FIND CURRENT USER IN DEMON TABLE
        JRST UTOLKJ     ;FAIL, JUST RETURN, NOT DEMON
        HRRE TT,DMTTBL+2(B)
        SUB TT,J
        HRRM TT,DMTTBL+2(B)     ;PUT NEW COUNT IN DEMON TABLE
        SKIPLE TT
UTOLJ1: AOS (P)
UTOLKJ: CONO PI,UTCON
        JRST LSWPOP

ADEMSIG:MOVE D,B
        CONO PI,CLKOFF  ;DON'T LET SYS JOB LOOK TILL WE'RE READY.
        MOVSI T,SCLDMN  ;TELL IT TO LOOK FOR US, AFTER UFLS TURNS CLOCK ON.
        IORM T,SUPCOR
        SETZB T,SRN3(U) ;SYS JOB WILL SETOM SRN3 TO RESTART US
        SKIPN SRN3(U)   ;WITH 0 IN T => FILE EXISTS, OR OPNL CODE.
         PUSHJ P,UFLS   ;SYS JOB DETECTS US BY PC=ADEMS1.
                        ;DEMON NAME IS EXPECTED TO BE IN A.
ADEMS1: JUMPN T,OPNL1-1(T)
        CAIGE W,2       ;NO SECOND ARG, JST SIGNAL
         JRST ADEMS3
        JUMPL D,NUDMTB  ;IF 2ND ARG < MERELY CALL NUJBST, NO DEMON ENTRY
        TDZA TT,TT      ;ZERO OUT TT
ADEMS3:  SETOM TT       ;SET FLAG
        PUSHJ P,LSWTL   ;SIEZE SWITCH
            DEMSW
        PUSHJ P,DEMSIG
         JRST LSWPOP    ;SIGNAL FAILED
        SKIPN TT        ;FLAG NOT SET
         HRLM D,DMTTBL +2(B)    ;SET TIME RQ
        JRST CKOPJ1     ;RELEASE SWITCH

NUDMTB: PCLT
        PUSHJ P,DMBLK1  ;WAIT TILL DEMON BLOCK IS CLEARED
         PUSHJ P,UFLS
        HRROI T,DMBLK
        MOVEM A,DMBLK   ;SAVE IN BLOCK NOW
        PUSHJ P,NUJBST
         JRST NUDMTB    ;IF FAILURE AFTER WAIT LOOP BACK
        JRST POPJ1      ;SUCCESS

DMBLK1: SKIPGE DMBLK+1  ;FOR DEMON BLOCK TEST
         POPJ P,        ;RETURN, NOT FINISHED LOADING
        MOVE T,UTTYCT
        CAIGE T,MXCZS   ;ROOM IN RING BUFFER
         AOS (P)
        POPJ P, ;SKIP IF ROOM
\f;UTILITY ROUTINES FOR DEAMONS

DEMSIG: PUSHJ P,DEMNAM  ;LOOK FOR NAME
        JRST DEMSG2     ;HAVE TO MAKE NEW ENTRY
DEMSG1: AOS (P)
        HLLZ E,DMTTBL+2(B)      ;18 BITS 2'S COMPLEMENT
        AOS DMTTBL+2(B)
        HLLM E,DMTTBL+2(B)      ;MUST DO THIS WAY TO FIT ABOVE
        SKIPE DMTTBL+1(B)       ;DOWN, WANT SYS JOB TO LOOK AT
        POPJ P,
        MOVSI E,SCLDMN
        IORM E,SUPCOR
        AOS REQCNT      ;ONLY SIGNAL IF NECESSARY
        POPJ P,

DEMSG2: SOSGE DEMCNT    ;IF NO ROOM FLUSH
        POPJ P,
        PUSH P,A
        MOVEI A,DMTLL   ;BUMP POINTER
        ADDB A,DMTPTR
        IDIVI A,DMLNG   ;TRUNCATE TO LENGNTH OF TABLE
        SKIPE DMTTBL(B)
        JRST .-4        ;SEARCH FOR NEW ENTRY
        POP P,DMTTBL(B) ;SET NAME IN TABLE
        JRST DEMSG1

;ROUTINES TO FIND ENTRY IN TABLE.
;DEMNAM TAKES NAME IN A, DEMUSR TAKES USER INDEX IN U
;THEY SKIP RETURN IF SUCCESSFUL, RETURN OTHERWISE
;IF SUCCESSFUL DEMON TABLE INDEX IS IN B

DEMUSR: JUMPL U,CPOPJ
        MOVSI B,-DMLNG
        CAMN U,DMTTBL+1(B)
        JRST POPJ1
        ADD B,[DMTLL,,DMTLL]
        JUMPL B,.-3
        POPJ P,

DEMNAM: MOVSI B,-DMLNG  ;SEARCH BY NAME
        CAMN A,DMTTBL(B)
        JRST POPJ1
        ADD B,[DMTLL,,DMTLL]
        JUMPL B,.-3
        POPJ P,

DEMOUT: PUSHJ P,LSWTL   ;CALLED BY KILLING JOB (IN CASE OWNED)
        400000,,DEMSW
        PUSHJ P,DEMUSR
        JRST UTOLKJ
        SETZM DMTTBL+1(B)       ;MARK AS DOWN,SYSTEM JOB DECIDES WHAT TO DO
        AOS REQCNT
        MOVSI B,SCLDMN
        IORM B,SUPCOR
        JRST UTOLKJ

DEMMRV: SETZM DMTTBL+2(B)       ;CALL WITH UTCOFF (SYS JOB) REMOVES ENTRY FROM TBL
        SETZM DMTTBL+3(B)       ;WITH INDEX OF DEMON IN B
        SETZM DMTTBL(B)
        MOVEI B,1
        AOSGE DEMCNT
        MOVEM B,DEMCNT
        JRST UTCONJ

\f
;DEAMON READ AND SET STATUS ROUTINES

ARDDMST:        PUSHJ P,LSWTL   ;READ DEAMON STATUS
        DEMSW
        PUSHJ P,DEMNAM
        JRST RDDMS1     ;LOST TRY USER INDEX
        MOVE A,DMTTBL+1(B)
        MOVEI C,L
        IDIVM C,A       ;DIVIDE BY L, DON'T CLOBBER B
RDDMS2: MOVE C,DMTTBL+3(B)
        MOVE B,DMTTBL+2(B)
        PUSHJ P,LSWPOP
        JRST POPJ1

RDDMS1: PUSH P,U
        MOVE U,A
        PUSHJ P,DEMUSR  ;BAD USER
        JRST LKUPOP
        POP P,U
        MOVE A,DMTTBL(B)
        JRST RDDMS2
LKUPOP: POP P,U
        JRST LSWPOP

ASTDMST:        PUSHJ P,LSWTL   ;SET DEAMON STATUS
        400000,,DEMSW
        MOVE D,B
        PUSHJ P,DEMNAM
        JRST STDMS1
STDMS2: JUMPL D,STDMS4
STDMS3: SOSLE W
        MOVEM D,DMTTBL+2(B)
        SOSLE W
        MOVEM C,DMTTBL+3(B)
        JRST UTOLJ1
STDMS1: PUSH P,U
        MOVE U,A
        PUSHJ P,DEMUSR
        JRST UTULKP
        POP P,U
        JUMPGE D,STDMS2
STDMS4: SKIPGE DMTTBL+1(B)      ;REMOVE FROM TABLE IF POSSIBLE
        JRST UTOLKJ     ;CAN'T DELETE, LOADING
        SETZM DMTTBL+1(B)       ;DOWN
        SETZM DMTTBL+2(B)       ;REMOVE REQUESTS
        AOS REQCNT      ;SIGNAL SYS JOB
        MOVSI B,SCLDMN
        IORM B,SUPCOR
        JRST UTOLJ1
UTULKP: POP P,U
        JRST UTOLKJ
]

\f
SUBTTL .GETSYS UUO

;.GETSYS AC,    ;TRANSFERS SYSTEM AREA SPECIFIED BY C(AC+1)
                ;TO USER AREA STARTING AT R.H. C(AC) OF LENGTH MINUS L.H. C(AC)

AGETSYS:
; Alan 4/2/86:  Took this out because people don't use .GETSYS this way
; anymore:
;       PUSHJ P,UDELAY          ;CAUSE A SCHEDULE TO STOP GETSYSER FROM
;                               ; MONOPOLIZING SYSTEM
        MOVSI A,-LGSNAM         ;NEGATIVE OF TABLE LENGTH
        UMOVE B,1(J)            ;LOOK AT USERS AC+1, THE 6BIT NAME
        CAME B,GSNAME(A)        ;CYCLE THROUGH TABLE
         AOBJN A,.-1            ;OF NAMES, POINTER IN RIGHT HALF OF A
        JUMPGE A,AGETSL         ;JUMP IF NOT IN TABLE
        UMOVE B,(J)             ;GET POINTER TO USERS RECEPTACLE BLOCK
AGETS1: HLRZ C,GSYS1(A)         ;GET LOW END OF BLOCK
        HRRZS A                 ;CLEAR COUNT IN L.H. OF A
        CAIGE A,NUTCFN          ;SKIP IF UTC OFF NOT REQUIRD
         CONO PI,UTCOFF         ;TURN OFF ALL CHANNELS BUT CH 1
        skipn c                 ; If LH contains 0, RH is routine to call.
         jrst @gsys1(a)         ; (JUMPE C,@GSYS1(A) generates spurious
                                ; page faults, so don't "fix" this.)
        HRRZ D,GSYS1(A)         ;GET HIGH END OF BLOCK
;AT THIS POINT:         ;B USER'S POINTER (UNRELOCATED)
                        ;C BEGINNING OF AREA IN SYS
                        ;D END OF AREA
agets2: SUBI D,-1(C)            ;BLOCK LENGTH TO BE SENT
        HLRZ E,B                ;GET NEG BLK LENGTH FROM USERS PNTR
        ADDI E,-1(D)            ;-1 CAUSES CARRY BIT IF .GT.
        TLNE E,-1               ;CARRY INDICATES LOSS
         JRST AGETS5            ;MORE THAN USER WANTS
        HRLS D                  ;BLOCK LENGTH IN BOTH HALVES
        HRRZ E,B                ;FIRST WORD (UNRELOCATED)
        HRL E,C                 ;SOURCE ADDRESS FOR BLT
        HRRZ C,E                ;DESTINATION INTO C
        ADD C,D                 ;FINAL ADDRESS +1
AGETS7: XCTRI XBW,[BLT E,-1(C)] ;BLT IT TO HIM
         AOSA (P)               ;INCREMENT RETURN, INDICATE SUCCESS
          JRST AGETS6
        CONO PI,UTCON
        ADD B,D
        UMOVEM B,(J)            ;TELL USER HOW MUCH HE GOT
AGETS4: POPJ P,

AGETSL: XCTR XW,[SETZM 1(J)]    ;INDICATE BAD SIXBIT
        POPJ P,

AGETS5: MOVNS D                 ;TELL USER HOW MUCH HE NEEDS
        CONO PI,UTCON           ;NEGATIVE OF RIGHT BLOCK LENGTH
        XCTR XRW,[HRLM D,(J)]   ;SET UP PROPER BLOCK LENGTH IN HIS AC
        JRST AGETS4

AGETS6: CONO PI,UTCON           ;ONE PAGE WASN'T THERE
        XCTR XRW,[MOVES (E)]    ;SO TOUCH IT (TAKE MPV INTERRUPT IF REAL MPV)
        JRST AGETS1             ;AND TRY AGAIN (BLT WILL GET FARTHER THIS TIME)
                                ;HAD TO RETRY FROM BEGINNING SINCE THIS MAY BE
                                ;ONE THAT HAS TO BE TRANSFERRED INTACT WITH UTCOFF
\f
GSNAME: SIXBIT /MEMORY/
IFN NUNITS,SIXBIT /UTAPE/
IFN NCPP,[SIXBIT /NCPSM/
        SIXBIT /NCPPQ/
        SIXBIT /NCPHT/
]
NUTCFN==.-GSNAME        ;NUMBER TO GET WITH UTCOFF (same as NETOFF)
        SIXBIT /USERS/
        SIXBIT /USER/
        SIXBIT /GETS/
        SIXBIT /DEVS/
        SIXBIT /CALLS/
IFN IMXP,       SIXBIT /IMPX/
        SIXBIT /CLINK/
        SIXBIT /DSYMS/
        SIXBIT /USYMS/  ;.UPC, .VAL, .TTY, ETC.
        SIXBIT /CHDEVS/
        SIXBIT /NCALLS/
        SIXBIT /TTYVAR/
        SIXBIT /USRVAR/
        SIXBIT /ITSNMS/
LGSNAM==:.-GSNAME

;ENTRIES ARE:   BOTTOM,,TOP  OF AREA TO BE TRANSMITTED OR INST TO EXECUTE
GSYS1:  IOBFTL,,EMEMTL          ;lh zero => jrst to THIS ENTRY
IFN NUNITS, UTCHNT,,UTCHE       ;UTAPE
IFN NCPP,[IMSOKB,,IMSOKE        ;NCP SOCKET MAP
        IMPBPQ-1,,IMPEPQ        ;NCP PENDING RFC QUEUE
        IMPHTB,,IMPHTB+255.     ;NCP HOST TABLE
]
        0,,USRSV                ;USERS
        0,,USR1V                ;USER
        GSNAME,,GSNAME+LGSNAM-1 ;GETS
        DEVTAB,,EDEVS           ;DEVS
        SYSYMB,,SYSYME          ;CALLS
IFN IMXP,       IMXTBB,,IMXTBE  ;IMPX
        CLVBEG,,CLVEND          ;CLINK
        0,,DSYMS                ;DSYMS
        SYSUSB,,SYSUSE          ;USYMS
        DCHSTB,,DCHSTE          ;CHDEVS
        SYSCTB,,SYSCTB+LSYSCT-1 ;NCALLS
        TYVTAB,,TYVTAB+LTYVTA-1 ;TTYVAR
        USETTB,,USETTB+MXVAL-1  ;USRVAR
        ITSNMS,,ITSNMS+LITSNM-1 ;ITSNMS
IFN LGSNAM-<.-GSYS1>, .ERR GSNAME and GSYS1 don't match.

ITSNMS: ITSIRP [
        SIXBIT /ITS/
        ]
LITSNM==:.-ITSNMS
        0
        0                       ; Make it easy to add more.

USRSV:  MOVEI C,USRSTG
        MOVE D,USRHI
        ADDI D,USRSTG-1
        JRST agets2

USR1V:  UMOVE C,2(J)
        IMULI C,LUBLK
        CAML C,USRHI
         JRST USR1VL
        ADDI C,USRSTG
        MOVE D,C
        ADDI D,LUBLK-1
        JRST agets2

USR1VL: XCTR XW,[SETOM 2(J)]
        JRST AGETS4

DSYMS:  HRRZ C,DDT-2
        HLRE D,DDT-2
        SETCMM D        ;OFFSET BY ONE
        ADD D,C
        JRST agets2
\f
SUBTTL .GETLOC, .EVAL, ETC.

;GET AN ABSOLUTE LOCATION       ;.GETLOC AC,    ;C(A)=FROM(ABS),,TO(RELATIVE)
;
AGETLOC:UMOVE A,(J)             ;GET TO ADDRESS
        HLRZ B,A                ;GET FROM ADDRESS
        XCTRI [MOVE C,(B)]
         JRST .+2
          JRST ILEXPF           ;ILLEGAL EXEC PAGE FAULT
        UMOVEM C,(A)            ;GIVE TO USER
        POPJ P,

;SET AN ABSOLUTE LOCATION       ;.SETLOC AC,    ;C(AC)=FROM(RELATIVE),,TO(ABS)
;
ASETLOC:TDZA D,D        ;CLEAR COND FLAG, SKIP

;SET AN ABSOLUTE LOCATION ONLY IF C(ABS)=C(TEST) & SKIP IF SUCCESSFUL
;.IFSET AC,     ;C(AC)=<POINTER TO 2 WORD BLOCK>,,TO ADR(ABS)
;WORD 1=TEST    ;WORD 2=NEW C(ABS)

AIFSET: MOVNI D,1       ;SET COND FLAG
        XCTR XR,[HRRZ A,(J)]    ;GET TO ADDRESS (ABSOLUTE)
        XCTR XR,[HLRZ B,(J)]
        UMOVE C,(B)             ;GET WORD
        XCTRI [MOVES (A)]
         JRST .+2
          JRST ILEXPF
        JUMPE D,ASPST1  ;NORMAL SETLOC
        UMOVE D,1(B)    ;GET NEW VALUE
        CONO PI,CLKOFF  ;PREVENT INTERRUPTS
        CAME C,(A)      ;CHECK WORD AGAINST TEST WORD
         JRST CLKONJ    ;NOT EQUAL => IGNORE
        MOVE C,D
        AOS (P)         ;CAUSE RETURN TO SKIP
        CAIG A,SYSB_10. ;CHECK IF IN SYS
         JRST ASPST1    ;YES SO DO REG SETLOC
        EXCH D,(A)      ;NO SO DO NOW BEFORE SHUFFLE & GET OLD
ASPST2: MOVE C,D
        HRROS A         ;LET SYS JOB KNOW ALREADY DONE
ASPST1: CAMN C,(A)      ;SKIP IF DIFFERENT FROM C(TO ADR)
         JRST CLKONJ    ;SAME
        MOVE D,SYSITM   ;IF SYSTEM JOB HAS BEEN HUNG OR LOOPING FOR 30 SEC,
        ADDI D,30.*30.
        CAMGE D,TIME
         JUMPGE A,ASPST3        ;GO DO THE WORK OURSELVES (BUT DON'T DO IT TWICE).
ASPST4: MOVE D,UNAME(U) ;GET UNAME OF SETLOCER
        MOVSI T,SCLSET
        PUSHJ P,CWAIT   ;WAIT TILL VARIABLES TO COMMUNICATE WITH SYS JOB ARE FREE
            TDNE T,SUPCOR       ;ARG TO CALL IN .-1
        MOVEM A,SETSLC  ;REMEMBER ABS LOCATION
        MOVEM C,SETSLQ  ; " NEW CONTENTS (OR OLD IF LH(SETSLC)=-1)
        MOVEM D,SETSU   ; " USER
CSPST:  IORM T,SUPCOR   ;TELL SYS JOB TO DO IT
        JRST CLKONJ

ASPST3: HRRZ D,UPC      ;SYS JOB HAS BEEN HANGING FOR 30 SEC.
        CAIN D,SCOR1    ;WHY? JUST SLEEPING?
         JRST ASPST4    ;YES => SIGNAL IT TO DO THE WORK
        MOVEM C,(A)     ;ELSE GIVE UP ON IT AND DO IT NOW
        JRST CLKONJ
\f
;LOOK UP ITS SYMBOL     ;.EVAL AC,      ;C(AC)=SQUOZE SYMBOL
;REPLACES SYMBOL BY VALUE & SKIPS IF SUCCESSFUL
;IF YOU WANT TO .EVAL A SYMBOL IN A PROGRAM HABITUALLY AND IMPLICITLY,
;AND WANT IT TO CONTINUE TO WORK, YOU HAD BETTER ADD AN ENTRY TO THE FILE
;AI:SYSTEM;EVSYMS > SAYING WHAT PROGRAM AND WHAT SYMBOL. THEN, ITS HACKERS
;CAN AVOID SCREWING YOU WITHOUT WARNING.

AEVAL:  PUSHJ P,SWTL
        ARDFSW
        UMOVE B,(J)     ;GET SYM
        PUSHJ P,SYMLK   ;LOOK UP
        JRST LSWPOP     ;NOT FOUND
        MOVE A,(C)      ;GET VALUE
        PUSHJ P,LSWPOP
        AOS (P)         ;CAUSE UUO TO SKIP
        JRST APTUAJ     ;RETURN VALUE

;REDEFINE ITS SYMBOL    ;.REDEF AC,     ;C(AC)=POINTER TO 2 WORD BLOCK
;WORD 1 = SYMBOL        ;WORD 2 = VALUE
;DELETE SYM IF ALL 4 FLAG BITS SET
;  OTHERWISE SET SYMBOL FLAGS TO THOSE SPECIFIED, EXCEPT REJECT ANY ATTEMPT TO
;  ADD A PROGRAM NAME
;ADD SYM IF NOT FOUND   ;FAIL ONLY IF NOT ENOUGH ROOM
;SKIPS IF SUCCESSFUL

AREDEF: PUSHJ P,SWTL
            ARDFSW
        XCTR XR,[HRRZ D,(J)]    ;GET POINTER FROM AC
        UMOVE B,(D)     ;GET SYMBOL
        PUSHJ P,SYMLK   ;LOOK UP
        JRST ARDF2      ;NOT FOUND, CREATE
        XCTR XR,[SETCM A,(D)]   ;GET SYM (COMPLEMENTED)
        TLNN A,740000   ;SKIP IF ANY FLAGS NOT SET
        JRST ARDF3      ;ALL SET => DELETE
        SETCA A,
        TLNN A,740000
        JRST LSWPOP
        MOVEM A,-1(C)
        UMOVE A,1(D)    ;GET VALUE
        MOVEM A,(C)     ;STORE IN SYMTAB
        JRST ARDF4      ;SORT AND SKIP-RETURN.

ARDF2:  MOVE C,DDT-2    ;GET POINTER
        SUB C,[2,,2]    ;DECREMENT FOR NEW ENTRY
        MOVEI A,-1(C)   ;FUDGE FOR BLOCK CALC
        LSH A,-10.      ;CONVERT TO # OF BLOCKS UP TO SYMTAB -1
        UMOVE B,(D)     ;GET SYM
        MOVE T,FDDTPG
        LSH T,10.
        TLNE B,740000   ;LOSE IF PROG NAME
        CAMLE A,T       ;CHECK FOR LOSSAGE
         JRST LSWPOP    ;DON'T OVERWRITE ITS
        EXCH B,2(C)     ;STORE OVER GLOBAL BLOCK HEADER,
        MOVEM B,(C)     ;MOVE THAT HEADER DOWN 2 WDS.
        UMOVE A,1(D)    ;GET VALUE
        EXCH A,3(C)
        ADD A,[-2,,]    ;1 MORE SYM IN GLOBAL BLOCK.
        MOVEM A,1(C)    ;STORE
        MOVEM C,DDT-2   ;UPDATE POINTER
        JRST ARDF4      ;GO SORT AND SKIP-RETURN.

ARDF3:  MOVE B,DDT-2    ;GET POINTER
        MOVE A,(B)      ;MOVE THE GLOBAL HEADER
        EXCH A,2(B)     ;UP OVER 1ST SYM
        MOVEM A,-1(C)   ;WHICH GOES INTO FREE SLOT.
        MOVE A,1(B)
        ADD A,[2,,]     ;GLOBAL BLOCK 1 SYM SHORTER.
        EXCH A,3(B)
        MOVEM A,(C)
        MOVE A,[2,,2]
        ADDM A,DDT-2    ;UPDATE POINTER
ARDF4:  MOVSI E,(SETZ)  ;TELL DDT ITS SYMTAB WAS ALTERED.
        IORM E,DDT-1
        PUSHJ P,SBUBL   ;DO 1 BUBBLE-SORT UP AND 1 DOWN.
        JRST LSWPJ1     ;FREE ARDFSW AND EXIT.
\f
;DO ONE BUBBLE SORT PASS UP, ONE DOWN; LEAVE J <0 IFF DID AN EXCHANGE.
;CLOBBER A-E.
SBUBL:  MOVE E,DDT-2
        HLL E,1(E)
        ADD E,[2,,2]    ;AOBJN -> SYMS IN GLOBAL BLOCK.
SBUBL0: SETZ J,
        MOVE B,[2,,2]   ;INCREMENT FOR UPWARD PASS.
        MOVE C,[JUMPL A,SBUBL1]
        SUBI E,2        ;(WILL INCREMENT BEFORE ACTING)
        MOVE A,E
        PUSHJ P,SBUBL2
        MOVNS B         ;DECREMENT FOR DOWNWARD PASS.
        MOVE C,[CAMN A,E]
        JRST SBUBL2

SBUBL1: MOVE D,1(A)     ;CHECK NEXT PAIR OF ENTRIES.
        CAMG D,3(A)
         JRST SBUBL2    ;IN CORRECT ORDER.
        EXCH D,3(A)
        MOVEM D,1(A)    ;WRONG ORDER, EXCHANGE.
        MOVE D,(A)
        EXCH D,2(A)
        MOVEM D,(A)
        SETO J,         ;SAY DID AN EXCHANGE.
SBUBL2: ADD A,B         ;MOVE TO NEXT ENTRY.
        XCT C           ;TEST IF FINISHED.
         POPJ P,
        JRST SBUBL1     ;(NOT FINISHED)

;LOOK UP SYMBOL IN B IN ITS SYMBOL TABLE (CLOBBERS A,B,C)
;RETURN WITH POINTER TO VALUE WORD IN C
;SKIPS IF SUCCESSFUL

SYMLK:  TLZ B,740000    ;FLUSH FLAGS
        MOVE C,774000-2 ;PICK UP AOBJN POINTER TO SYMTAB FROM EXEC DDT
SYMLK2: MOVE A,(C)      ;GET SYM
        AOBJP C,[JRST 4,.+1]    ;INCREMENT POINTER
        TLNE C,376      ;GO THROUGH HAIR EVERY 200 SYMS
        JRST SYMLK3     ;NOT THIS TIME
        PUSHJ P,OPBRK
SYMLK3: TLNN A,200000   ;SKIP IF DELETE INPUT (FLAG PREVENTS MATCH)
        TLZE A,740000   ;FLUSH FLAGS & CAUSE LOSS IF ALL 0 (PROG NAME)
        CAME A,B        ;COMPARE
        AOBJN C,SYMLK2  ;LOSS, TRY ANOTHER
        JUMPL C,POPJ1   ;SKIP RETURN IF FOUND
        POPJ P,         ;NOT SO IF LOSS

AWSNAME:XCTR XR,[SKIPE B,(J)]   ;OPER 35
         MOVEM B,USYSNM(U)
        POPJ P,

AUPISET:UMOVE B,(J)     ;OPER 36
        ASH B,-35.
        EXCH B,PICLR(U)
        UMOVEM B,(J)
        SKIPN PICLR(U)
         POPJ P,
        JRST APISE1
\f
;GENERATE A UNIQUE SYM  ;.GENSYM AC,    ;LOADS AC WITH SYM
;
AGENSYM:PUSHJ P,SWTL    ;WAIT TILL INTERLOCK FREE THEN SEIZE IT
          GENSSW
        MOVEI TT,IGNSYM
        PUSHJ P,SIXAOS  ;INCREMENT SYM
        MOVE A,IGNSYM   ;GET SYM
        PUSHJ P,LSWPOP  ;UNLOCK FOR NEXT USER
        JRST APTUAJ     ;GIVE USER GENERATED SYMBOL

;GENERATE A UNIQUE NUM  ;.GENNUM AC,    ;LOADS AC WITH NUMBER 
;
AGENNUM:AOS A,IGNNUM    ;INCREMENT NUMBER
        JRST APTUAJ     ;AND GIVE IT TO USER

EBLK

GENSSW: -1
        0
IGNSYM: SIXBIT /SYS/

IGNNUM: 0

BBLK

SIXAOS: PUSH P,I
        PUSH P,J
        AOS (TT)        ;INCREMENT SYM
        MOVE I,[440600,,(TT)]   ;GET POINTER TO FIRST CHAR
SIXAS2: ILDB J,I        ;GET FIRST (NEXT) CHAR
        SKIPN J         ;SKIP IF NOT ZERO
        MOVEI J,1       ;REPLACE EMBEDDED SPACE WITH "!"
        DPB J,I         ;PUT BACK
        CAME I,[60600,,(TT)]    ;SKIP IF FIRST FIVE CHARS HAVE BEEN EXAMINED
         JRST SIXAS2    ;GO TO NEXT CHAR
        POP P,J
        POP P,I
        POPJ P,
\f
IFN KL10P,[

SUBTTL KL10 PERFORMANCE COUNTER

;KLPERF SYMBOLIC SYSTEM CALL
;ARG 1: <JOB> TO MEASURE PERFORMANCE DURING;
        ;-3 => NULL JOB, -4 => ALL JOBS
;ARG 2: P.A. ENABLES WORD (SEE NON-EXISTENT KL10 SYS REF MAN)
        ;0 => FREE THE FACILITY, ELSE TRIES TO GRAB IT
;NO ARGS => JUST READS THE VALUES WITHOUT CHANGING THE ENABLING CONDITIONS.
        ;IN THAT CASE, IT IS OK IF FACILITY IS OWNED BY SOMEONE ELSE
;VAL 1: PREVIOUS <JOB> SETTING
;VAL 2: PREVIOUS P.A. ENABLE WORD
;VAL 3: TIME BASE HIGH WORD
;VAL 4: TIME BASE LOW WORD
;VAL 5: PERF CTR HIGH WORD
;VAL 6: PERF CTR LOW WORD

KLPERF: CONO PI,CLKOFF
        JUMPN W,KLPER1
KLPER0: MOVE J,MTRJOB   ;NO ARGS => DONT CHANGE SETTINGS,
        MOVE B,PAEON    ;JUST RETURN CURRENT COUNT.
        JRST KLPER3

KLPER1: JUMPN B,KLPER2  ;TRYING TO TURN IT ON?
        CAME U,MTRUSR
         JRST KLPER0    ;FREEING THE FACILITY WHEN DON'T OWN IT?
        PUSHJ P,PRFOFF  ;NO, TRYING TO FREE IT - DO SO.
        MOVEI J,-2
        JRST KLPER3

KLPER2: SKIPGE MTRUSR   ;IF FACILITY IS FREE, SIEZE IT.
         MOVEM U,MTRUSR
        CAME U,MTRUSR
         JRST OPNL10    ;ALREADY BELONGS TO SOME OTHER JOB.
        MOVEI J,2(A)
        CAIN J,-2       ;ALL JOBS?
         JRST KLPER4
        CAIN J,-1       ;NULL JOB?
         JRST KLPER3
        MOVE J,A
        JSP T,NCRUI2    ;ELSE DECODE JOB SPEC; OBJECT TO PDP6
         JFCL
        CAME J,U
         JRST KLPER3
;TRYING TO TURN ON FOR SELF OR ALL JOBS - IT OUGHT TO BE ON RIGHT NOW!
KLPER4: CONO MTR,2001   ;TURN ON TIME BASE, INTERVAL PIA=1
        WRPAE B         ;SET ENABLES
KLPER3: EXCH B,PAEON
        SKIPGE A,MTRJOB
         TRZA A,2       ;UN CONVERT -1 => -3, -2 => -4
          LSH A,-9      ;IDIVI A,LUBLK
IF2 IFN LUBLK-1000,.ERR NO DIVIDE
        HRREM J,MTRJOB
        RCCL C          ;C,D GET TIME BASE
        RPERFC E        ;E,TT GET PERFC
        JRST CLKOJ1

;TURN OFF THE PERFORMANCE COUNTER.  PUT BACK IN RUN-TIME MEASURING MODE
PRFOFF: MOVNI A,2       ;NOT ATTACHED TO ANY JOB
        MOVEM A,MTRJOB
        WRPAE [1576,,1200]      ;MEASURE MAIN-PROGRAM TIME IN 80 NS UNITS (MODEL A)
        CONO MTR,4001   ;TIME-BASE OFF, INTERVAL PIA=1
        RPERFC STPERF   ;START-OF-QUANTUM TIME IS NOW
        RPERFC NULPRF   ;ALSO FOR NULL-JOB
        SETOM MTRUSR    ;NO LONGER IN USE
        POPJ P,
] ;END IFN KL10P
\f
$INSRT CORE             ;CORE JOB AND MEMORY MANAGEMENT ROUTINES

SUBTTL NULL DEVICE
;  IMMEDIATE EOF ON INPUT, HAS NO EFFECT ON OUTPUT
;
NULO:   HLRS A,C                ;REMEMBER MODE FOR .STATUS
        JSP Q,OPSLC3            ;SET UP IOCHNM WORD AND EXIT
            NLIDN,,NLODN        ;ARG
            NLBIDN,,NLBDN       ;ARG

;UNIT NULL DEVICE INPUT
NULI:   JRST UNIEOF

;BLOCK NULL DEVICE INPUT
NULBI:  POPJ P,

;BLOCK NULL DEVICE OUTPUT ENTRY
;ADVANCE BLOCK MODE .IOT POINTER
NULBOD: XCTR XR,[HLRE A,(C)]    ;GET NEG LENGTH FROM LEFT HALF
        MOVNS A                 ;GET POSITIVE LENGTH
        XCTR XR,[ADD A,(C)]     ;ADD STARTING LOC (R.H.)
        XCTR XW,[HRRZM A,(C)]   ;STORE BACK "COUNTED OUT" POINTER
        POPJ P,

;STANDARD DEVICE .STATUS ROUTINE
STDSTA: DPB A,[60300,,D]        ;A HAS LH OF IOC WORD
        TRO D,1_9               ;SYS BUF CAP FULL
        TRNE D,1_6              ;SKIP IF INPUT
        TRC D,3_9               ;TURN OFF SYS BUF CAP FULL, SET EMPTY
        POPJ P,
\f
SUBTTL USER DEVICE

UBPFJ==10       ;DEMAND FOREIGN JOB (BIT IN LH (DEV) FOR .OPEN (USR))

USROJ:  TDZA J,J        ;ENTRY FROM JOB DEVICE DONT GET CORE.
USRO:   MOVNI J,1       ;INDICATE NOT FROM JOB OPEN
        CAIA
USROOJ:  MOVEI J,1      ;OJB DEVICE; EXISTING JOB OK ONLY IF %OPOJB BIT SET.
        PCLT
        SKIPL CORRQ(U)
        PUSHJ P,UFLS    ;PREVENT ATTEMPT TO CORE, PCLSR OUT, AND THINK YOU'VE WON AT SETBF1, ETC
        PUSHJ P,SWTL
            TREESW
        JUMPE B,USRO4   ;JNAME = 0 => UNAME IS JOB SPEC.
        SKIPN A         ;IF UNAME=0
         MOVE A,UNAME(U)        ;MAKE IT THIS JOB'S UNAME
        CAME A,UNAME(U) ;SKIP IF FIRST FILE NAME IS UNAME OF OPENER
         JRST USROA
        CAME B,[SIXBIT /PDP10/] ;SKIP IF SECOND FILE NAME IS "PDP10"
         CAMN B,[SIXBIT /PDP6/] ;OR PDP6
IFN PDP6P,JRST PDPO
    .ELSE JRST OPNL1
USROA:  CONO PI,CLKOFF
        PUSHJ P,LSWPOP  ;TREESW
USROB:  SETZ TT,
USRO3:  CAME A,UNAME(TT)
         JRST AGIN
        CAMN B,JNAME(TT)
         JRST UFN1      ;FOUND UNAME JNAME PAIR
AGIN:   ADDI TT,LUBLK
        CAMGE TT,USRHI
         JRST USRO3
        TLNE C,UBPFJ    ;JOB MUST EXIST TO WIN IF UBPFJ SET
         JRST OPNL4
        CAME A,UNAME(U) ;INFERIOR PROCEDURE MUST HAVE SAME UNAME
         JRST OPNL20
        PUSH P,U
TCORS:  MOVSI T,%TBNOT+%TBDTY   ;DOESN'T HAVE TTY, ISN'T GIVING IT AWAY
        PUSHJ P,USTRA
         JRST TCORS1    ;USTRA FAILED - SEE WHY, MAYBE RETRY (U CLOBBERED)
        MOVEM A,UNAME(U)
        MOVEM B,JNAME(U)
        MOVEM A,USYSNM(U)
        MOVE TT,U
        POP P,U
        MOVE A,UTMPTR(U)
        MOVEM A,UTMPTR(TT)
        MOVE A,HSNAME(U)
        MOVEM A,HSNAME(TT)
        MOVE A,XUNAME(U)
        MOVEM A,XUNAME(TT)
        MOVEM B,XJNAME(TT)
        PUSHJ P,USRST5  ;SET UP TTY STUFF
        MOVSI A,400000
        SKIPGE APRC(U)
         IORM A,APRC(TT)        ;NEW INFERIOR IS DISOWNED IF CREATOR IS.
        JUMPE J,CLKOJ1  ;RETURN HERE FOR JOB DEVICE (INDEX IN TT)
        PUSHJ P,ULUP1   ;FIND AN INTERRUPT BIT FOR THE JOB.
         JRST NOGO1     ;NONE => GO KILL THE JOB AND RETURN FAILURE.
        CONO PI,CLKON   ;NOW CAN'T FAIL TO CREATE THE JOB FOR GOOD.
        HRLZ B,B
        HRR B,U
        MOVEM B,SUPPRO(TT)
        MOVE U,TT
        PUSHJ P,UFOUND  ;SET UP THE OPENER'S CHANNEL.
         JFCL
        MOVE Q,TT
        MOVEI B,1
        PUSHJ P,ACORE1  ;MAY PCLSR OUT, BUT CORE JOB WILL DO WORK ANYWAY.
         SKIPA R,UUAC(U);NO CORE AVAILABLE, KILL THE JOB
          JRST POPJ1    ;SUCCESS
        ADDI R,IOCHNM(U)
        PUSHJ P,AUCLOSE
        JRST OPNL37     ;NO CORE AVAILABLE
\f
ULUP1:  CLEARB A,T
ULUP:   HRRZ E,SUPPRO(T)
        SKIPN UNAME(T)  ;SKIP IF VARIABLE BLOCK IN USE
        JRST ULUP2
        CAIN E,(U)      ;SKIP IF NOT AN INFERIOR
        IOR A,SUPPRO(T) ;IOR IN INTERRUPT BIT OF INFERIOR
ULUP2:  ADDI T,LUBLK    ;ADVANCE TO NEXT BLOCK
        CAMGE T,USRHI   ;SKIP IF ALL EXAMINED
        JRST ULUP       ;LOOP
UFIN:   MOVEI B,1       ;SELECT INT BIT
UFIN2:  TLON A,(B)
        JRST POPJ1
        LSH B,1
        CAIGE B,1_<NINFP>
        JRST UFIN2
        POPJ P,

NOGO1:  MOVSI T,BULGO+BULGOS
        IORM T,APRC(TT) ;TELL THE SYS JOB TO KILL THE JOB WE JUST GOT
        MOVSI T,SCLGUN
        IORM T,SUPCOR
        JRST OPNL5      ;DIREC FULL (TOO MANY LOSERS)

NOGO4:  SUB P,[1,,1]
        JRST OPNL6

TCORS1: PCLT            ;COME HERE FROM TCORS IF ATTEMPT TO FIND FREE JOB SLOT FAILED.
        SKIPGE SJCFF    ;IF THIS IS NEGATIVE, USTRA DIDN'T EVEN REQUEST MORE
         JRST [ SKIPGE SJCFF
                 PUSHJ P,UFLS
                JRST TCORS2]
        MOVE TT,USRHI
        CAIL TT,MAXJ*LUBLK
         JRST NOGO4                     ;USER MEM EXPANDED TO MAX
        SKIPGE SUPCOR   .SEE SCLEX      ;PRESUMABLY USTRA ASKED SYS JOB FOR MORE JOB SLOTS
         PUSHJ P,UFLS                   ;SO WAIT TILL SYS JOB ANSWERS THE REQUEST
TCORS2: CONO PI,CLKOFF                  ;AND SEE IF THERE ARE NOW ENOUGH SLOTS.
        JRST TCORS
\f
USRO4:  EXCH J,A        ;USR: OPEN WITH JNAME=0: USE UNAME AS JOB SPEC.
        JSP T,NCORUI
         JFCL
IFN PDP6P,[
        CAIN J,-1       ;SPEC'D JOB IS PDP6 => OK,
         JRST PDPO
]
        CONO PI,CLKOFF
        PUSHJ P,LSWPOP  ;SOS DIELOK(J)
        PUSHJ P,LSWPOP  ;TREESW
        MOVE TT,J
        MOVE J,A
;COME HERE WHEN JOB ALREADY EXISTS, WITH CLOCK OFF AND USR IDX IN TT.
;A, B, C STILL HAVE UNAME, JNAME AND OPEN MODE.
UFN1:   JUMPE J,[ADDI B,10000   ;OPENING JOB-DEVICE AND JOB EXISTS??
                 JRST USROB]    ;KEEP CHANGING JNAME UNTIL WE CREATE A JOB.
        CAIG TT,LUBLK
         JUMPL J,UFNDF          ;SKIP SOME CHECKS ON SYS & CORE
        JUMPG J,[MOVSI T,%OPOJB         ;OJB DEVICE OPEN; IF JOB DOESN'T HAVE %OPOJB SET,
                TDNE T,OPTION(TT)       ;THEN IT HASN'T GIVEN PERMISSION TO BE HACKED.
                 SKIPL JBI(TT)          ;IF IT'S ALREADY A JOB DEVICE DON'T HACK IT.
                  JRST [CONO PI,CLKON   ;IN EITHER CASE, WAIT TILL ALL'S OK,
                        SKIPL JBI(TT)
                         PUSHJ P,UFLS
                        TDNN T,OPTION(TT)
                         PUSHJ P,UFLS
                        JRST USROOJ]    ;THEN RE-TRY THE OPEN.
                LDB T,[.BP BULGOS_22,APRC(TT)]
                JUMPN T,OPNL42
                JRST CLKOJ1]    ;RETURN SUCCESS TO JOBO6C.
        TLNE C,UBPFJ
         JRST UFNDF     ;USER WANTS IT AS FOREIGN JOB
        HRRZ E,SUPPRO(TT)
        CAIN E,(U)
         JRST UFN1C     ;OPENING UP INFERIOR
        SKIPGE T,APRC(TT)
         SKIPL SUPPRO(TT)       ;UNLESS IT'S A TOP-LEVEL DISOWNED JOB,
          JRST UFNDF    ;THEN FOREIGN JOB
        PUSHJ P,UFN2B   ;REOWN DISOWNED TREE
         POPJ P,        ;CAN'T
        JRST UFOUND     ;DID

UFN1C:  MOVE U,TT       ;OPENING PROCEDURE IMMEDIATE SUPERIOR OF PROCEDURE BEING OPENED
        JRST UFOUND
\f
;
; REOWN A DISOWNED PROCEDURE TREE
;

NREOWN: TLNN R,%CLSFU           ;MUST BE A FOREIGN USER CHANNEL
         JRST OPNL34
        CONO PI,CLKOFF
        HLRZ TT,H
        SKIPGE T,APRC(TT)
         SKIPL SUPPRO(TT)
          JRST OPNL31           ;TO A TOP-LEVEL DISOWNED JOB
        HRLM R,(P)
        PUSHJ P,UFN2B           ;REOWN THE JOB (TURNS CLOCK ON)
         POPJ P,                ;FAILED
        HLRZ R,(P)              ;TURN THE CHANNEL INTO AN INFERIOR CHANNEL.
        MOVNI T,FUWIDN-UWIDN
        ADDM T,(R)
        JRST POPJ1

;REOWN JOB TT POINTS TO, ITS APRC IS IN T.  SKIPS IF SUCCESSFUL.
;CALL WITH CLKOFF, WILL TURN IT ON.
UFN2B:  TLNE T,BULGOS
         JRST OPNL42    ;CAN'T REOWN JOB WHICH IS LOGGING OUT.
        SKIPGE APRC(U)  ;IF REOWNING JOB IS DISOWNED, PROHIBIT SO THAT
         JRST OPNL31    ;IT DOESN'T REOWN ITSELF AND SCREW THINGS UP
        PUSHJ P,ULUP1   ;FIND AN INTERRUPT BIT FOR IT. (IN B)
         JRST OPNL5     ;WE HAVE 8 INFERIORS ALREADY.
        AOS (P)         ;GOING TO WIN
        SETOM DLSRCH    ;INHIBIT SCHEDULING
        CONO PI,CLKON   ;TURN CLOCK BACK ON, THIS MAY TAKE A WHILE
        MOVSI A,BUMRTL  ;DOOMED DETACHED JOBS ARE RESCUED BY REOWNING.
        ANDCAM A,APRC(TT)
        MOVE A,UNAME(U) ;PICK UP NEW UNAME
        SETCM D,APRC(U)
        TLZ D,#400000   ;SIGN OF D SET IFF REOWNER ISN'T DISOWNED.
        MOVE J,UTMPTR(U) ;PICK UP NEW USER RESOURCE POINTER
        HRR D,J
        SUBI J,USRRCE   ;GET NEW CONSOLE #
        CAIL J,NCT      ;IF NEW TREE STILL HAS NO TTY,
         MOVEI J,%TINON ;"DISOWNED" TTY CHNLS SHOULD REMAIN SUCH
;HERE, A HAS UNAME, D HAS <SIGN IFF MAKING NON-DISOWNED>,,UTMPTR, J HAS CONSOLE # OR %TINON,
;U HAS REOWNER, TT HAS JOB BEING REOWNED.
UFN2A:  PUSH P,B        ;SAVE INTERRUPT BIT
UFN3:   MOVEM A,UNAME(TT)       ;SET TO NEW UNAME
        HRRZM D,UTMPTR(TT)      ;SET TO NEW USER RESOURCE POINTER
        MOVEI R,IOCHNM(TT)
        PUSHJ P,CHSCAN
        PUSHJ P,UFN3ZZ
        HLLZ T,D                ;LH(D) HAS 0 IF REOWNER DISOWNED, ELSE 400000
        ANDCAM T,APRC(TT)       ;MARK AS NOT DISOWNED IF REOWNER ISN'T DISOWNED.
UFNL3:  MOVE B,JNAME(TT)        ;PICK UP CURRENT JNAME
        MOVEI E,0       ;LOOP ON ALL USERS
UFNL1:  CAMN A,UNAME(E) ;SKIP ON NOT SAME UNAME
         CAME B,JNAME(E) ;SKIP ON SAME UNAME-JNAME
          JRST UFNL2    ;NOT SAME NAME AND/OR VAR BLK NOT IN USE
        JRST UFN7       ;NAME CONFLICT, RESOLVE
UFNL2:  ADDI E,LUBLK
        CAMGE E,USRHI
         JRST UFNL1
        MOVEI E,0       ;INITIALIZE FOR LOOP TO LOOK FOR INFERIORS AND DUPLICATE NAMES
UFN4:   SKIPN UNAME(E)  ;SKIP IF VAR BLOCK IN USE
         JRST UFN5      ;TRY NEXT
        HRRZ I,SUPPRO(E)        ;PICK UP SUPERIOR POINTER OF BLOCK BEING EXAMINED
        CAIN I,(TT)     ;SKIP IF NOT INFERIOR
         JRST UFN6      ;INFERIOR, PSEUDO-RECURSE
UFN5:   ADDI E,LUBLK    ;ADVANCE TO NEXT BLOCK
        CAMGE E,USRHI   ;SKIP IF ALL EXAMINED
         JRST UFN4      ;LOOP
        SKIPGE SUPPRO(TT)       ;SKIP IF NOT BACK TO TOP
         JRST UFNX      ;BACK TO TOP LEVEL
        MOVE E,TT       ;POP BACK UP
        HRRZ TT,SUPPRO(E)       ;TO PREVIOUS LEVEL
        MOVE B,JNAME(TT)        ;RESTORE B
        JRST UFN5       ;PROCEED AT PREVIOUS LEVEL
\f
UFNX:   POP P,B
        HRLM B,SUPPRO(TT)
        HRRM U,SUPPRO(TT)       ;SET UP SUPERIOR POINTER IN TO LEVEL DISOWNED
        SETZM DLSRCH            ;RE-ENABLE SCHEDULING
        MOVE U,TT
        POPJ P,

UFN6:   MOVE TT,E       ;PSEUDO-RECURSE
        JRST UFN3       ;START UP ON LOWER LEVEL

UFN7:   CAMN E,TT       ;SKIP UNLESS FOUND SELF
         JRST UFNL2
        ADDI TT,JNAME   ;SET UP ARG TO SIXAOS
        PUSHJ P,SIXAOS  ;INCREMENT JNAME
        SUBI TT,JNAME   ;RESTORE TT
        JRST UFNL3      ;RESTART LOOP

;RESUSCITATE TTY CHNLS
UFN3ZZ: HRRZ Q,(R)
        CAIL Q,TYIDN
        CAILE Q,TYOBN
         POPJ P,        ;NOT A TTY CH
        HLRZ Q,(R)
        TRNN Q,%TICNS
         POPJ P,        ;NOT CONSOLE
        CAIE J,%TINON
         AOS TTNTO(J)
        DPB J,[$TIIDX,,(R)]
        POPJ P,

UFOUND: HLRZS C         ;U HAS INF PROC
        HRL A,U
        MOVE U,USER
        HRRZ R,UUAC(U)
        ADDI R,IOCHNM(U)        ;CLOBBERED BY CORE
        JSP Q,OPSLC3
            UWIDN,,UWODN
            UBIDN,,UBODN

UFNDF:  TLNE C,1
         JRST OPNL12    ;ATTEMPTED OUTPUT
        LDB A,[.BP BULGOS_22,APRC(TT)]
        JUMPN A,OPNL42  ;USER GOING AWAY
        HRL A,TT
        JSP Q,OPSLD1
            FUWIDN,,FUBIDN
\f
USRST:  PUSHJ P,AUCL2   ;.RESET SIMULATES CLOSING AND REOPENING
         POPJ P,
        CONO PI,CLKON
        PUSHJ P,1USTOP
        EXCH U,A        ;BUT WITH LESS OVERHEAD
        PUSH P,A
        PUSHJ P,IODCL
        MOVEI B,BULGOS  ;WE'RE NOT REALLY TRYING TO KILL THE INFERIOR,
        ANDCAM B,APRC(U) ;SO DON'T LET OTHERS THINK HE'S BEING KILLED.
        MOVE Q,U
        SETZ B,
        EXCH U,(P)
        PUSHJ P,ACRF1   ;FLUSH ALL OF CORE
         BUG
USRST1: MOVEI B,1
        MOVE Q,(P)
        PUSHJ P,ACRF1   ;THEN GET 1 PAGE
         JRST [ PUSHJ P,UDELAY
                JRST USRST1]
        EXCH U,(P)
        MOVSI T,%TBNOT+%TBDTY
        MOVEM T,TTYTBL(U)
        MOVE J,U
        EXCH U,(P)
        PUSHJ P,MPLDJ
        XCTR XW,[CLEARM 0]
        MOVEI T,1
        XCTR XBRW,[BLT T,1777]
        PUSHJ P,MPLDZ
        EXCH U,(P)
        PUSHJ P,LOGUSE
        CONO PI,CLKOFF
        PUSHJ P,USRST2
        CONO PI,CLKON
        PUSHJ P,USRST4  ;SHOULD SKIP
         BUG
        POP P,A
        EXCH U,A
        MOVE TT,A
USRST5: MOVE A,TTSTSV(U)        ;INITIALIZE SAVED TTYSET OF NEW JOB EQUAL TO CREATOR'S.
        SKIPL B,TTYTBL(U)       ;NOTE THAT THE WHEREABOUTS OF THE CREATOR'S TTYSET
         MOVE A,TTYST1(B)       ;DEPENDS ON WHETHER HE HAS THE TTY NOW.
        MOVEM A,TTSTSV(TT)
        MOVE A,TTSTSV+1(U)
        SKIPL B
         MOVE A,TTYST2(B)
        MOVEM A,TTSTSV+1(TT)
        MOVEI A,(TT)            ;RH OF NEW JOB'S SAVED TTYSTS IS HIS INDEX.
        HRLI A,%TSCNS           ;NOW CONSTRUCT THE LH.
        MOVE B,UTMPTR(TT)       ;TO DO THAT, FIND THE TREE'S TTY NUMBER
        MOVE B,TTYOPT-USRRCE(B) ;TO FIND THE TTY'S TTYOPT WORD,
        TLNE B,%TOROL           ;WHICH TELLS HOW TO INIT THE BITS IN THE TTYSTS.
         TLO A,%TSROL
        TLNN B,%TOMOR
         TLO A,%TSMOR
        TLNE B,%TOSA1
         TLO A,%TSSAI
        MOVEM A,TTSTSV+2(TT)
        POPJ P,
\f
;.CALL USRMEM
; ARG 1   JOB WHOSE MEMORY SHOULD BE READ OR WRITTEN
; ARG 2   ADDRESS TO READ OR WRITE
; ARGS 3,4  LIKE USRVAR, TTYVAR
; VAL 1   PREVIOUS CONTENTS OF LOCATION
; VAL 2   NEW CONTENTS OF LOCATION (SAME AS PREVIOUS IF NOT WRITING).
;         (NOT VALID IN BLOCK MODE)

; BIT 1.1  IF SET, THEN IF PAGE ISN'T READABLE OR WRITEABLE, GIVE AN MPV
;               OR PURE INTERRUPT TO THE JOB BEING REFERENCED.
; BIT 2.9  IF SET, ALLOWS US TO WRITE IN ANY JOB.

NUSRMEM:
        MOVE J,A
        JSP T,NCORUI
         JRST NUSRM1            ;WE CAN SURELY WRITE.
        MOVE H,CTLBTS(U)
        CAIGE W,3               ;ELSE, IF WE WANT TO WRITE,
         TRNE H,1               ;OR WANT TO GIVE THE REFERENCED JOB INTERRUPTS,
          TRNE H,400000         ;THEN UNLESS WE ARE FORCING IT,
           JRST NUSRM1
        JSP T,NCORWR            ;SEE IF IT IS A JOB WE ARE ALLOWED TO WRITE IN.
         JRST OPNL31
NUSRM1: MOVE H,CTLBTS(U)
        CAIE J,-1
         CAIG J,LUBLK           ;CAN'T GIVE SYS OR CORE JOBS INTERRUPTS, OR PDP6.
          TRNN H,1
           CAIA
            JRST OPNL31
IFN PDP6P,[
        CAIN J,-1
         JRST NUSRMS
];PDP6P
        CAILE J,LUBLK
         CAMN J,U
          JRST NUSRMS
        MOVE A,J                ;IF TARGET JOB ISN'T SELF OR PDP6
        PUSHJ P,RPCLSR          ; OR SYS OR CORE, STOP IT.
        PUSHJ P,SOSSET
            USTP(J)
NUSRMS: PUSHJ P,NUSRM2          ;DO THE WORK
         POPJ P,                ;LOST, OPNL HAS LSWCLR'ED
        JRST LSWCJ1             ;POSSIBLY UNLOCK USTP, DIELOK AND TAKE SUCCESS RETURN

NUSRM2: PUSHJ P,VARCAL          ;E:=ADDR, D:=DATA, W:=INSTRUCTION
        HRRZS E
        CAIGE E,20
         JRST NUSRM6            ;ACS ALWAYS SWAPPED-IN AND ACCESSIBLE
        PUSH P,U
        MOVE U,J
        LDB A,[121000,,E]       ;GET PAGE # IN A AND REF'D JOB IN U.
IFE PDP6P, PUSHJ P,UPLC
IFN PDP6P,[
        PUSHJ P,[ CAIE J,-1     ;SKIP IF PDP6
                   JRST UPLC    ;DECODE THEM FOR ORDINARY JOB.
                  CAIL A,LPDP6M
                   TDZA T,T     ;FOR PDP6, MOST PAGES DON'T EXIST,
                    MOVE T,[002200,,[600000]]   ;AND THE REST ARE WRITABLE.
                  POPJ P,]
];PDP6P
        POP P,U
        LDB A,T                 ;GET PAGE ACCESS HALFWORD.
        TRNN A,600000           ;IF PAGE SWAPPED OUT, PUT ACCESS BITS IN PLACE THEY WOULD BE
         LSH A,16.              ; FOR AN IN-CORE PAGE.
        JUMPE A,NUSRM9          ;LOSE IF NO PAGE THERE
        TRNN A,400000           ;OR IF WE ARE TRYING TO WRITE THE WORD AND PAGE IS READ-ONLY.
         JUMPN W,NUSRM8
NUSRM6: PUSHJ P,MPLDJ           ;NOW LOAD MAP OF JOB IN J
        HRLI E,(SKIP)           ;GET ACCESS TO DATA WORD, SWAP IN PAGE
        SKIPE W
         HRLI E,(MOVES)
NUSRM4: CONO PI,CLKOFF          ;CLK OFF SO ONCE IN CAN'T SWAP OUT AGAIN
        XCTRI XRW,E             ;NOT GETTING BENEFIT OF USUAL PCLSR BEFORE
         JRST NUSRM5            ;SWAP OUT FEATURE SINCE IT'S ANOTHER JOB
        PUSHJ P,TPFLT
        JRST NUSRM4

NUSRM5: UMOVE B,(E)             ;NOW THAT PAGE IS IN, GET OLD CONTENTS
        MOVE A,B                ;IN A AND B
        JUMPE W,NUSRM3
        HRRI W,B                ;IF WRITING,
        XCT W                   ;EXECUTE USER'S INSN., MODIFYING 2ND VALUE IN B,
        TRNN J,-1               ;SYSTEM JOB?
         JRST OPNL31            ;******* WRITING SYS, TURN INTO .SETLOC *******
        UMOVEM B,(E)            ;AND STORE IT BACK INTO REF'D JOB.
NUSRM3: PUSHJ P,MPLDZ           ;RESTORE NORMAL PAGE MAP, TURN CLKON.
        JRST POPJ1              ;SUCCESS

NUSRM8: SKIPA T,[%PIWRO]        ;HERE IF TRYING TO WRITE IN READ ONLY PAGE.
NUSRM9:  MOVEI T,%PIMPV         ;HERE IF ACCESSING NONEXISTENT PAGE.
        TRNN H,1                ;SKIP IF TO GIVE INTERRUPT
         JRST OPNL32
        CAMN J,USER
         JRST UUOERR            ;INTERRUPT TO SELF
        IORM T,PIRQC(J)         ;INTERRUPT OTHER USER
        JRST OPNL32             ;CAN'T GET THAT ACCESS TO PAGE.
\f
;COMMENTS BELOW APPLY TO UBI IN MANY CASES.  FOR UBO, TRANSFER GOES THE
;OTHER DIRECTION

UBO:    MOVNI I,1
        JRST UBIL

UBI:    MOVEI I,0       ;SIGNAL UBI

UBIL:   JUMPL C,UBIA
        XCTR XRW,[MOVES TT,(C)] ;MAKE SURE WRITE CYCLES WILL WIN
UBIB:   TRNE A,200000   ;SKIP UNLESS 6
         MOVNI A,1      ;SO CAILE BELOW WILL SKIP OVER SUSTPR AMONG OTHER REASONS
        CAILE A,LUBLK   ;SKIP ON SYS JOB, CORE JOB, PDP6 OR JOB ALREADY STOPPED
         PUSHJ P,SUSTPR ;RANDOM JOB STOP
        JUMPGE TT,UBI4  ;THRU
        TLO A,400000    ;INDICATE ALREADY STOPPED SO WONT TRY IT AGAIN
        HLRO B,TT
        MOVNS B         ;COUNT TO BE XFERRED
        HRLZ E,IOCHST-IOCHNM(R) ;EXAMINED USER ADDRESS
        HRR E,TT        ;FROM,,TO (INFERIOR ADR,,SUPERIOR ADR)
        HLRZ Q,E
        TLNE A,200000
         JRST UBI5A     ;PDP6
UBI5:   CAIGE Q,20      ;INF ADR IN Q
         JRST UBI3      ;READ AC
        HRRZ J,A        ;SET UP UMAPS WORD
        TRZE E,400000
         TLOA J,%UMMPL  ;TO HI PG, HACK OUR LOW PG
          TLO J,%UMMPU  ;TO LOW PG, HACK OUR HI PG
        TLZE E,400000
         TLOA J,%UMLTU  ;TO POINT TO HIS UPPER
          TLO J,%UMUTL  ;TO POINT TO HIS LOWER
        TLNN J,%UMMPU+%UMUTL    ;MAPPING HIS UPPER WITH OUR LOWER?
         JRST UBI3A     ;YES MAKE SURE NOT SCREWED BY AC PNTR
UBI3B:  PUSHJ P,MPLD1
        TRZ Q,400000
        MOVNS Q         ;LIMIT SIZE OF XFER TO MIN OF DESIRED
        ADDI Q,400000   ;DIST OF TO ADR FROM SEG BOUNDARY
        CAMLE B,Q
         HRRZ B,Q
        MOVNI Q,(E)     ;AND DIST OF FROM ADR FROM SEQ BOUNDARY
        ADDI Q,400000
        CAMLE B,Q
         HRRZ B,Q
        TLNN J,%UMMPL   ;BUGGER ADDRESSES SO RIGHT DBRS WILL BE USED
         TLOA E,400000  ;SET FROM ADR TO HI PG
          TRO E,400000  ;SET TO ADR TO HI PG
        SKIPE I         ;SKIP ON UBI
         MOVSS E                ;UBO, XFERR OTHER DIRECTION
        MOVE Q,E        ;SAVE COPY OF BLT PNTR
        ADDI B,(E)      ;GET LA +1
UBI3H:  XCTRI XBRW,[BLT E,-1(B)]        ;XFERR DATA
UBI3K:   MOVEI E,(B)    ;NO FAULT, SIMULATE STORE BACK OF BLT PNTR AFTER COMP OF BLT (RH ANYWAY)
UBI3L:  PUSH P,J
        PUSHJ P,MPLDZ   ;RETURN TO NORMAL MAP TO STORE BACK USER PNTR
        POP P,J         ;SAVE PREV MAP FOR EVENTUAL USE
        SUBM E,Q        ;FIGURE OUT HOW MANY WDS ACTUALLY XFERRED
        HRRZS Q
UBI3E:  HRLS Q          ;# WDS TRANSFERRED,,SAME
        JUMPL C,UBIC    ;UPDATE USER PNTR
        XCTRI XRW,[ADDM Q,(C)]
         JRST .+2
          BUG           ;SHOULD HAVE ALREADY CHECKED THIS
UBID:   ADD Q,IOCHST-IOCHNM(R)  ;UPDATE INFERIOR PNTR
        HRRM Q,IOCHST-IOCHNM(R) ;WRAPPING AROUND IF PASS 1,,0
        TLZ B,-1
        CAIN B,(E)      ;WAS THERE A FAULT?
         JRST UBIL      ;NO, LOOP
        PUSHJ P,UBI4    ;UNSTOP THE JOB.
        PUSHJ P,MPLD1   ;RESTORE TO FROB AT TIME OF FAULT
UBI3C:  PUSHJ P,TPFLT
        PUSHJ P,MPLDZ
        JRST UBIL
\f
UBI4:   TLNN A,200000   ;SKIP ON REALLY PDP6
         TLZ A,400000   ;FLUSH RANDOM BIT SO COMPARE WILL WORK
        CAILE A,LUBLK
         JRST UPCLSR
        POPJ P,

UBMCK1: PUSHJ P,UBI4
        JRST IOADC

UBIA:   TRNE C,777760
         BUG
        MOVE TT,(C)
        JRST UBIB

UBIC:   TRNE C,777760
         BUG
        ADDM Q,(C)
        JRST UBID

UBI5A:  CAIL Q,400000
         JRST UBMCK1
        JRST UBI5

UWO:    SKIPGE C
         SKIPA D,(C)
          UMOVE D,(C)
        TDZA I,I
UWI:     SETO I,        ;0 FOR OUTPUT, -1 FOR INPUT.
        TRNE A,200000
         MOVNI A,1      ;-1 MEANS PDP6.
        CAMN A,USER
         HRLI A,-1      ;DON'T STOP SELF
        CAIG A,LUBLK
         JRST UWI1      ;SYS, CORE, SELF, OR PDP6
        PUSHJ P,SUSTPR
        PUSHJ P,SOSSET  ;MIGHT TAKE PAGE FAULT AND GET PCLSRED
            USTP(A)
UWI1:   HRRZ E,IOCHST-IOCHNM(R)
        HRRZ J,A
        PUSHJ P,MPLDJ   ;MAP JOB BEING IOT'ED FROM.
        XCTR XRW,[      MOVE W,(E)
                        MOVEM D,(E)]+1(I)
        AOS IOCHST-IOCHNM(R)    ;ADVANCE ACCESS POINTER
        CAILE A,LUBLK
         PUSHJ P,LSWPOP
        JRST MPLDZ
\f
UBI3A:  TLNE E,777760   ;SKIP ON XFERRING FROM AC AREA, HI TO HI
         JRST UBI3B     ;NO OK
        JUMPN I,UBO3A   ;UBO
        PUSHJ P,MPLDJ
        XCTRI XR,[MOVE B,(Q)]   ;PICK UP WD
         JRST .+2       ;OK
          JRST UBI3C    ;TAKE FAULT
        PUSHJ P,MPLDZ   ;BACK TO NORMAL MAP
        HRRZ E,TT       ;TO ADR
        JRST UBI3D

;USR DEV IOT STOP ROUTINE
USUSTP: SOS USTP(A)
SUSTPR: MOVSI T,BCSTOP+BUCSTP
        TDNE T,USTP(A)  ;WAIT TILL NOT BEING SHUFFLED
         PUSHJ P,UFLS
        PUSHJ P,RPCLSR  ;AOS'ES USTP
        MOVSI T,BCSTOP+BUCSTP
        TDNE T,USTP(A)
         JRST USUSTP
        POPJ P,

UBI3:   ADDI Q,AC0S(A)
        JUMPN I,UBO3    ;UBO
        TLNE A,200000
         TDZA B,B       ;READ PDP6 AC
          MOVE B,(Q)    ;READ NORMAL AC
UBI3D:  XCTRI XW,[MOVEM B,(E)]
         JRST .+2
          JRST UBI3C    ;TAKE FAULT
UBI3G:  MOVEI Q,1       ;1 WD XFERRED
        HRRZ B,E        ;FAKE OUT FAULT TEST
        JRST UBI3E

UBO3:   TLNE A,200000
         JRST UBI3G     ;TRYING TO WRITE PDP6 AC IGNORE
        XCTRI XR,[MOVE B,(E)]
         JRST .+2
          JRST UBI3C
        MOVEM B,(Q)
        JRST UBI3G


UBO3A:  XCTRI XR,[MOVE B,(TT)]
         JRST .+2
          JRST UBI3C    ;TAKE FAULT
        PUSHJ P,MPLDJ   ;MAP HIM.
        XCTRI XW,[MOVEM B,(Q)]
         JRST .+2
          JRST UBI3C
        PUSHJ P,MPLDZ   ;BACK TO NORMAL
        JRST UBI3G
\f
SUBTTL CORE LINK DEVICE

EBLK
CLVBEG: NCLCH
CLSYN:  BLOCK NCLCH     ;SYSTEM NAME ;0=>VARIABLES FREE
CLN1:   BLOCK NCLCH     ;FN1
CLN2:   BLOCK NCLCH     ;FN2
CLUSR:  REPEAT NCLCH,-1 ;LH=WRITING USER ;RH=READING USER ;-1=>NOT OPEN THAT HALF
CLRAC:  BLOCK NCLCH     ;4.9=LOCKED BY CORE ALLOCATOR
                        ;4.8=VERY SLOW CLOCK ROUTINE CONSIDERING FLUSHING THIS BUFFER
 %CAFLS==100000         ;4.7=INPUT CLOSED, TURN OUTPUT INTO NUL DEVICE
 %CA==1,,500000         ;RH=UT BUFFER NUMBER (IOBFT ADR)

CLOSW:  -1      ;USER LOCK TO STOP MORE THAN ONE PERSON FROM SIMULTANEOUSLY MODIFYING
        0       ;THE CORE LINK VARIABLES
CLVEND==.-1
BBLK

;FORMAT OF CORE LINK 200 WORD BUFFER
;
CLBVSP==8
CLBCHS==100.
CLBEOF==<CLBCHS+4>/5
IFG CLBVSP+CLBCHS+CLBEOF-128.,.ERR CLBXXX LOSSAGE

;
;0:   CHARACTER COUNT
;1&2: READ AND WRITE CHARACTER OR WORD POINTERS
;3&4: READ AND WRITE EOF POINTERS
;CLBVSP TO CLBVSP+CLBCHS-1: CHARACTERS OR WORDS
;CLBVSP+CLBCHS UP: EOF BITS STORED AS SEVEN FIVE BIT BYTES PER WORD,
;               EACH BIT CORRESPONDING TO A CHARACTER POSITION.

CLAO:   SKIPA J,[2]     ;CLA .OPEN (TO ANSWER A CLI INTERRUPT)
CLIO:    MOVNI J,1      ;CLI .OPEN (INTERRUPTS USER SPECIFIED BY FILE NAME)
        JRST CLI2

CLUO:   TDZA J,J        ;CLU .OPEN
CLOO:    MOVEI J,1      ;CLO .OPEN
CLI2:   JUMPL C,CLFDEL  ;JUMP IF AN .FDELE
        PUSHJ P,FLDRCK
         JRST CLO1      ;NOT FILE DIRECTORY
        MOVEI J,2
        JRST LISTF7
\f
CLFDEL: MOVEI J,3
CLO1:   PUSHJ P,SWTL    ;SEIZE SWITCH TO STOP VARIABLES FROM CHANGING UNDER YOU
            CLOSW
        LDB H,[220100,,C]       ;DIRECTION BIT
        JUMPL J,CLOO5
CLOO5B: MOVE Q,USYSN1(U)        ;PICK UP SNAME
        MOVSI I,-NCLCH
        CAIN J,2        ;SKIP UNLESS CLA
         JRST CLO1A     ;JUMP IF CLA .OPEN
        CAIGE J,0
CLO1A1:  MOVE Q,[SIXBIT/_CLI_/]
CLOL:   CAMN Q,CLSYN(I) ;LOOK FOR SNAME, FN1, & FN2
         CAME A,CLN1(I)
          JRST CLOO1
        CAME B,CLN2(I)
         JRST CLOO1
        JUMPL J,OPNL23  ;"FILE LOCKED" IF ALREADY EXISTS, FOR CLI:.
        CAIN J,3        ;SKIP UNLESS DELETE
         JRST CLO1D     ;FOUND FILE TO DELETE
CLO1A6: LDB TT,CLOOT1(H)
        CAIE TT,-1
         JRST OPNL23    ;ALREADY OPEN THIS DIRECTION (FILE LOCKED)
        HRRZ TT,CLRAC(I)
        LDB Q,[IOSA,,IOBFT(TT)]
        LSH Q,6
CLOX:   DPB U,CLOOT1(H) ;STORE USER INDEX
        MOVSI TT,200000
        ANDCAM TT,CLRAC(I)      ;CLEAR VERY SLOW CLOCK BIT
        PUSHJ P,LSWPOP  ;RELEASE SWITCH
        HRL A,I
        LDB C,[220300,,C]
        SKIPGE J
         PUSHJ P,CLOX1  ;FOR CLI:, PUT OUR UNAME AND JNAME INTO BUFFER.
        MOVEI TT,44     ;WORD
        TRNN C,6
         MOVEI TT,7     ;UNIT ASCII
        ADD Q,H         ;OFFSET FOR DIRECTION
        DPB TT,[300600,,1(Q)]   ;SET UP ITEM POINTER
        MOVEI TT,5      ;WORD
        TRNN C,6
         MOVEI TT,1     ;UNIT ASCII
        DPB TT,[300600,,3(Q)]   ;SETUP EOF POINTER
        JSP Q,OPSLC7    ;SET UP IOCHNM OF USER
         DCLUAI,,DCLUAO ;UNIT ASCII INPUT ;UNIT ASCII OUTPUT
         DCLBI,,DCLBO   ;BLOCK INPUT ;BLOCK OUTPUT
         DCLUBI,,DCLUBO ;UNIT BINARY INPUT ;UNIT BINARY OUTPUT
         DCLBI,,DCLBO

CLOX1:  MOVEI TT,44     ;CHANGE OUTPUT BYTE SIZE TO 36.
        DPB TT,[300600,,2(Q)]
        MOVEI TT,5      ;WHICH INVOLVES STORING 5 CHARACTERS OF EOF BITS AT ONCE.
        DPB TT,[300600,,4(Q)]
        PUSH P,C
        HRROI C,TT
        MOVE TT,UNAME(U)
        PUSHJ P,CLOXO   ;NOW WE CAN IOT WORDS OUT, EVEN IF CHANNEL IS ASCII MODE.
        SUBI Q,1
        MOVE TT,JNAME(U)
        PUSHJ P,CLOXO
        SOJA Q,POPCJ    ;NOW RETURN, AND SET UP THE CORRECT BYTE SIZES.
\f
CLOO1:  AOBJN I,CLOL    ;LOOP FOR ALL SETS OF CORE LINK VARIABLES
        CAIE J,1
         JUMPGE J,OPNL4 ;CLA, CLU DELETE LOSE
        MOVSI I,-NCLCH
CLOO3:  SKIPN CLSYN(I)  ;LOOK FOR FREE VARIABLES TO CREATE FILE
         JRST CLOO2
        AOBJN I,CLOO3
        JRST OPNL5      ;GIVE DIREC FULL ERROR

CLOOT1: 2200,,CLUSR(I)  ;READING
        222200,,CLUSR(I) ;WRITING

CLOO2:  MOVEM A,CLN1(I) ;SET UP VARIABLES
        MOVEM B,CLN2(I)
        MOVEI D,SCNCLO(I)       ;SYS CHNL NO
        PUSHJ P,TCALL   ;GET 200 WORD BUFFER
            JRST IUTCONS
         JRST CLOO4     ;NO MEM AVAIL
        MOVEM Q,CLSYN(I)        ;DONT SET UP SYS UNTIL MEM AVAIL
        HRRM A,CLRAC(I)
        LDB Q,[IOSA,,IOBFT(A)]  ;SET UP BUFFER
        LSH Q,6
        SETZM (Q)       ;CHAR COUNT
        MOVE TT,Q
        ADDI TT,CLBVSP  ;SET UP BUF POINTERS
        MOVEM TT,1(Q)
        MOVEM TT,2(Q)
        HRLI TT,440000
        ADDI TT,CLBCHS  ;SET UP EOF POINTERS
        MOVEM TT,3(Q)
        MOVEM TT,4(Q)
        JRST CLOX

;NO MEMORY AVAILABLE FOR 200-WD BUFFERS
CLOO4:  AOS SWPOPR      ;MAYBE SWAPPING SOMETHING OUT WILL HELP
        PUSHJ P,LSWPOP  ;UNLOCK CLOSW
        PUSHJ P,UDELAY  ;WAIT A WHILE
        JRST CLO1       ;TRY AGAIN
\f
CLOO5:  CONO PI,CLKOFF  ;TURN OFF CLOCK TO STOP U&J NAMES FROM CHANGING
        MOVEI Q,2*LUBLK
CLOO5A: CAMN A,UNAME(Q) ;LOOK FOR USER WHOSE NAMES MATCH THE SPECIFIED FILE NAMES
        CAME B,JNAME(Q)
         JRST CLOO6
        MOVEI T,%PICLI  ;IF GET TO HERE, HAVE FOUND USER WITH RIGHT NAMES
        TDNN T,MSKST(Q) ;SKIP IF HE HAS CLI INT DISABLED
         JRST OPNL11
        IORM T,PIRQC(Q) ;GIVE USER INT
        CONO PI,CLKON
        JRST CLOO5B

CLOO6:  ADDI Q,LUBLK    ;GO TO NEXT USER SLOT
        CAMGE Q,USRHI   ;SKIP IF ALL EXAMINED
         JRST CLOO5A
        JRST OPNL11

CLO1D:  MOVE T,CLUSR(I)
        AOJN T,OPNL23   ;FILE LOCKED
        AOS (P)
        MOVE A,I
        PUSHJ P,CLIOTB  ;NO TIMING ERROR SINCE CORE JOB WILL PCLSR USR ON
        SKIPN B,SRN3(U) ;CORE LINK BEFORE MOVING BUFFER
         JRST CLO1D2
        MOVEM B,CLN1(A)
        MOVE B,SRN4(U)
        MOVEM B,CLN2(A)
        JRST LSWPOP     ;CLOSW

CLO1A:  MOVE A,UNAME(U)
        MOVE B,JNAME(U)
        JRST CLO1A1
\f
;CORE LINK .IOT SET UP ROUTINE

CLIOTB: SKIPGE CLRAC(A) ;WAIT IF BUFFER LOCKED BY CORE ALLOCATOR
         PUSHJ P,UFLS   ;(DO NOT CHANGE ABOVE TO "SKIPGE TT,CLRAC(A)")
        HRRZ TT,CLRAC(A)
        LDB Q,[IOSA,,IOBFT(TT)] ;GET POINTER TO BUFFER
        LSH Q,6
        POPJ P,


;CORE LINK .IOT ROUTINE FOR UNIT ASCII INPUT

CLUAI:  PUSHJ P,CLIOTB  ;SETUP
        MOVSI T,%CAFLS
        TDNE T,CLRAC(A)
         PUSHJ P,UFLS
        SKIPN (Q)       ;WAIT TILL CHAR COUNT NON-ZERO
         PUSHJ P,UFLS
CLUAI1: MOVE J,3(Q)
        ILDB I,J        ;GET EOF BIT
        JUMPN I,UNIEOF
CLUAIE: ILDB W,1(Q)     ;GET CHARACTER
        SOS (Q)         ;DECREMENT BUF COUNT
CLFAXP: LDB TT,[700,,1(Q)]      ;FIX UP POINTERS
        CAIN TT,CLBVSP+CLBCHS-1
         PUSHJ P,CLFAX2 ;MAYBE TIME TO RING BUFFER
        HLRZ TT,J       ;GET BYTE POSITION AND SIZE
        CAIN TT,010100  ;IF TO END OF 35-BIT WORD, ADVANCE
         IBP J          ;TO NEXT WORD (5-BIT BYTES 1 BIT AT A TIME)
        MOVEM J,3(Q)
        POPJ P,

UNIEOF: HRROI W,EOFCH
        JRST POPJ1

CLFAX2: LDB TT,[370500,,1(Q)]   ;PICK UP TOP 5 BITS OF BYTE POSITION
        JUMPN TT,CPOPJ  ;NOT QUITE YET
CLFBX2: MOVEI TT,CLBVSP ;J HAS NEW EOF PNTR
        DPB TT,[700,,1(Q)]      ;RING CHAR POINTER
        MOVEM J,3(Q)
        MOVEI J,44
        DPB J,[360600,,1(Q)]
        MOVEI TT,CLBVSP+CLBCHS
        DPB TT,[700,,3(Q)]      ;RING EOF POINTER
        DPB J,[360600,,3(Q)]
        MOVE J,3(Q)
        POPJ P,
\f
;CORE LINK .IOT ROUTINE FOR UNIT ASCII OUTPUT

CLUAO:  MOVE T,CLRAC(A)
        TLNE T,%CAFLS
         POPJ P,
        PUSHJ P,CLIOTB  ;SETUP
        MOVEI T,CLBCHS*5-11.
        CAMGE T,(Q)     ;WAIT TILL THERE IS SPACE IN BUF
         PUSHJ P,UFLS
        MOVE J,4(Q)
        SKIPGE C
         SKIPA B,(C)    ;GET CHAR FROM EXEC
          UMOVE B,(C)   ;GET CHAR FROM USER
        MOVEI TT,0
        IDPB TT,J       ;INDICATE NOT AN EOF
        IDPB B,2(Q)     ;STORE IN BUF
        MOVEI TT,1      ;GET MASK FOR LOW ORDER BIT
        ANDCAM TT,@2(Q) ;FLUSH IN CURRENT WORD
CLCWU2: AOS (Q)         ;INCREMENT BUF COUNT
        MOVEI I,0       ;FAKE OUT EOF TEST
        AOJA Q,CLFAXP   ;FAKE OUT CLFAXP AND FIX UP POINTERS


CLBI:   JSP W,WRDBTI    ;BLOCK INPUT.

;CORE LINK .IOT ROUTINE FOR UNIT BINARY INPUT

CLUBI:  PUSHJ P,CLIOTB  ;SETUP
        MOVSI T,%CAFLS
        TDNE T,CLRAC(A)
         PUSHJ P,UFLS
        MOVEI T,5
        CAMLE T,(Q)     ;WAIT TILL A WORD IS AVAILABLE
         PUSHJ P,UFLS
CLUBI1: MOVE J,3(Q)
        ILDB I,J        ;GET EOF BITS
        JUMPN I,CLUBIF  ;JUMP ON EOF
CLUBIE: ILDB W,1(Q)     ;GET WORD
CLCRB2: MOVNI T,5
        ADDB T,(Q)      ;DECREMENT COUNT
        JUMPGE T,CLFBXP
        SETZM (Q)       ;CAME FROM CLCLRL WITH PARTIAL WORD IN BUFFER
CLFBXP: JRST CLFAXP

CLUBIF: TROE I,20       ;SKIP IF EOF NOT ON FIRST CHAR OF WORD
         JRST POPJ1
        DPB I,J         ;SET EOF ON FIRST CHAR
        MOVE J,1(Q)
        ILDB W,J        ;PICK UP WORD WITH EOF IN MIDDLE
        POPJ P,
\f
;CORE LINK .IOT ROUTINE FOR UNIT BINARY OUTPUT

CLUBO:  MOVE T,CLRAC(A)
        TLNE T,%CAFLS
         POPJ P,
        PUSHJ P,CLIOTB  ;SETUP
;CLI: OPEN CALLS HERE TO OUTPUT UNAME AND JNAME.
CLOXO:  MOVEI T,CLBCHS*5-11.
        CAMGE T,(Q)     ;WAIT TILL THERE IS SPACE FOR A WORD
         PUSHJ P,UFLS
        MOVE J,4(Q)
        SKIPGE C
         SKIPA B,(C)    ;GET WORD FROM EXEC
          UMOVE B,(C)   ;GET WORD FROM USER
        MOVEI TT,0
        IDPB TT,J       ;INDICATE NOT AN EOF
        IDPB B,2(Q)     ;STORE IN BUF
CLCWB2: MOVEI TT,5
        ADDM TT,(Q)     ;INCREMENT COUNT
        AOJA Q,CLFAXP   ;FAKE OUT CLFBXP AND FIX UP POINTERS


;CORE LINK .IOT ROUTINE FOR BLOCK OUTPUT

CLBO:   MOVE I,C        ;SAVE A POINTER TO USERS BLKO POINTER
        XCTR XR,[SKIPL H,(I)]   ;PICKUP BLKO POINTER
         POPJ P,
        SKIPA E,H       ;SECOND COPY, ALSO FLAG TO CLBIN
CLBI2:   UMOVEM E,(I)   ;TO INFORM USER & IN CASE YOU ARE PCLSR'ED
        HRRZ C,E
        PUSHJ P,CLUBO   ;TRANSFER ONE WORD
        AOBJN E,CLBI2   ;TRY FOR NEXT
CLBI3:  UMOVEM E,(I)    ;COUNT EXHAUSTED OR EOF
        POPJ P,
\f
;CORE LINK .CLOSE ROUTINE FOR BINARY OR BLOCK OUTPUT

CLCLWB: PUSHJ P,CLCWC   ;STORE EOF BITS FOR WORD
         JRST CLCWU6    ;NO ROOM SO LAST MUST HAVE BEEN EOF HACK SO FLUSH
        IBP 2(Q)        ;KEEP WORD POINTER IN STEP
        PUSHJ P,CLCWB2  ;FIX UP COUNT AND POINTERS
CLCWU6: MOVNI B,1
        DPB B,[222200,,CLUSR(A)]        ;OBLITERATE USER INDEX
        MOVSI B,%CAFLS
        ANDCAM B,CLRAC(A)
        JRST LSWPOP     ;RELEASE SWITCH

;CORE LINK .CLOSE ROUTINE FOR UNIT ASCII OUTPUT

CLCLWU: PUSHJ P,CLCWC   ;STORE EOF BIT FOR CHAR
         JRST CLCWU6
        MOVEI TT,EOFCH
        IDPB TT,2(Q)    ;STORE AN EOF CHAR
        PUSHJ P,CLCWU2  ;FIX UP COUNT AND POINTERS
        SOS Q           ;CLCWU2 AOJAS
        LDB TT,[360600,,2(Q)]
        SOJE TT,CLCWU6  ;JUST FILLED A WHOLE WORD => STOP PADDING.
        PUSHJ P,LSWPOP  ;ELSE PAD ONCE MORE.
        JRST CLCLWU


;COMMON SUBROUTINE FOR CORE LINK OUTPUT .CLOSE ROUTINES

CLCWC:  PUSHJ P,SWTL    ;LOCK SWITCH (IF SIGN OF CLRAC IS EVER REALLY USED,
            CLOSW       ;THIS MIGHT CAUSE A DEADLY EMBRACE).
        PUSHJ P,CLIOTB  ;SETUP
        MOVEI T,CLBCHS*5-5.
        CAMGE T,(Q)     ;WAIT FOR THERE TO BE ROOM
         POPJ P,
        MOVE J,4(Q)
        MOVNI TT,1
        IDPB TT,J       ;SET EOF BIT(S)
        JRST POPJ1
\f
;CORE LINK .CLOSE ROUTINE FOR INPUT

CLO1D2: SETZM CLSYN(A)  ;FREE VARIABLES
        HRRZS A,CLRAC(A) ;CORE LINK NO LONGER IN USE
        PUSHJ P,BRTN    ;RETURN BUFFER TO FREE STATE
        JRST LSWPOP

CLISTA: PUSHJ P,CLIOTB  ;CORE LINK INPUT STATUS
        SKIPN J,(Q)     ;COUNT
         TRO D,1_10.    ;SYS BUF CAP EMPTY
        CAIL J,CLBCHS*5-5
         TRO D,1_9      ;SYS BUF CAP EMPTY
        POPJ P,

CLCLRA: TDZA C,C        ;UNIT ASCII
CLCLRB:  MOVNI C,1      ;IMAGE OR BLOCK (I.E. WORDS)
        PUSHJ P,CLIOTB
        PUSHJ P,SWTL
            CLOSW
;FLUSH ALL REAL DATA
CLCLRL: SKIPN (Q)       ;SKIP IF BUFFER CONTAINS DATA, READ IT UNTIL EOF
         JRST CLCLR1
        PUSHJ P,[JUMPE C,CLUAI1 ? JRST CLUBI1]
         JRST CLCLRL
CLCLR2: MOVE J,3(Q)     ;FOUND AN EOF, FLUSH THE EOF WORD
        ILDB I,J
        PUSHJ P,[JUMPE C,CLUAIE ? JRST CLUBIE]
        MOVE T,1(Q)
        TLNE T,760000
         JRST CLCLR2    ;NOT YET TO WORD BOUNDARY
        JRST CLCLR3

CLCLR1: MOVSI B,%CAFLS
        IORM B,CLRAC(A)
        PUSH P,A
        PUSH P,Q
        HLRZ A,CLUSR(A)
        PUSHJ P,NJRPCL
        PUSHJ P,NJUPCL
        POP P,Q
        POP P,A
CLCLR3: HLLOS B,CLUSR(A)        ;NO LONGER OPEN FOR INPUT
        SKIPN (Q)               ;IF NO DATA IN BUFFER
         AOJE B,CLO1D2          ;AND NOT OPEN FOR OUTPUT, GO FREE THE BUFFER AND VARS
        JRST LSWPOP
\f
SUBTTL COMMON I/O ROUTINES

;STANDARD DEVICE OPEN

STDOP1: MOVEI R,R       ;ENTRY TO NOT CLOBBER IOCHNM
STDOPN: HLRZ A,(Q)      ;LH MASK ON 4.9-3.2 OF LH OPEN WRD
        AND D,A ;RH POINTER TO ..USR,..USE PAIR
        ROT D,-1        ;FOLLOWING WORDS CONTAIN LIST FOR ALL MASKED STATES
        ADDI D,(Q)      ;LH MSKED STATE =0, RH =1, IOTTB ENTRY NUMBERS
        HRRZ A,1(D)
        SKIPL D
        HLRZ A,1(D)
        JUMPE A,OPNL12  ;MODE NOT AVAIL
        HRRZ E,(Q)
        CONO PI,CLKOFF
        CAME U,(E)
        SKIPGE 1(E)
        AOSA 1(E)
        JRST OPNL10     ;DEVICE NOT AVAIL
        MOVEM U,(E)
        HLL A,C
        JRST OPNSLT

OPSLD1: ANDI D,1        ;ENTRY TO USE BOTTOM BIT OF AC D
OPSLD3: ANDI D,3        ;ENTRY TO USE BOTTOM TWO BIT OF AC D
        MOVE C,D
OPSLC3: ANDI C,3        ;ENTRY TO USE BOTTOM TWO BITS OF AC C
OPSLC7: ANDI C,7        ;ENTRY TO USE BOTTOM THREE BITS OF AC C
        ROT C,-1
        ADDI C,(Q)
        HRR A,(C)
        SKIPL C
        HLR A,(C)
OPNSLT: MOVEM A,(R)     ;SET USERS IOCHNM
        JRST CLKOJ1
\f
;BLOCK OUTPUT TO CHARACTER DEVICE 
;ADR OF CHR ROUTINE IN E
; THAT ROUTINE MUST NOT CLOBBER C, D, E, OR TT
;C POINTS TO AOBJN POINTER IN USER SPACE
;MUSTN'T CLOBBER J (TTY OUTPUT ASSUMES).

NBTOCH: XCTR XRW,[MOVES D,(C)]  ;CHECK WRITEABILITY OF AOBJN PTR
        LDB TT,[410300,,D]      ;USE HIGH 3 BITS OF USER PNTR AS CHR CNT
        CAIGE TT,3
         POPJ P,                ;USER TRYING TO XFER >32K FLUSH
        SKIPA TT,BTOCHT-3(TT)   ;PICK UP APPROPRIATE BYTE PTR (WORD IN W)
NBTO1:   UMOVEM D,(C)           ;UPDATE USER'S AOBJN PTR
        UMOVE W,(D)             ;FETCH CURRENT WORD FROM USER
        ILDB A,TT               ;FETCH CURRENT CHARACTER
        PUSHJ P,(E)             ;SEND TO DEVICE
        ADD D,[700000,,]        ;UPDATE PTR
        TLNE D,500000
         JRST NBTO1             ;GO TO NEXT CHR
        MOVE TT,BTOCHT+4
        ADD D,[500001,,1]       ;INCR TO NEXT WORD
        JUMPL D,NBTO1
        UMOVEM D,(C)    ;COUNTED OUT, UPDATE FINAL TIME & RETURN
        POPJ P,

BTOCHT: REPEAT 5,<44-<4-.RPCNT>*7>_14+700,,W

;BLOCK INPUT FROM CHARACTER DEVICE
;E AND C SET UP LIKE NBTOCH
;INTERNALLY LH OF E USED FOR FLAGS:
; 4.9 EOF FLAG (SIGN)
; 4.8 => JUST RETURN WITHOUT ERROR IF AT BEGINNING OF WORD,
;        OTHERWISE IGNORE BIT.
; 4.7 => RETURN WITHOUT ERROR EVEN IF NOT AT BEGINNING OF WORD.

INBTCH: HRRZS E         ;CLEAR GARBAGE IN LH
        XCTR XRW,[MOVES D,(C)] ;SET UP LIKE NBTOCH
        LDB TT,[410300,,D]
        CAIGE TT,3
         POPJ P,
        SKIPA TT,BTOCHT-3(TT)
INBTO1:  UMOVEM D,(C)
        XCTR XRW,[MOVES (D)] ;CHECK WRITABILITY OF CURRENT WORD
        JUMPL E,INBTO2  ;JUMP IF EOF
        PUSH P,C
        PUSH P,D
        PUSH P,TT
        PUSH P,R
        HLRZ A,(R)
        PUSHJ P,(E)     ;RETN CHR IN W
         JRST .+3
          TLO E,200000
        TLO E,400000
        MOVE I,W
        POP P,R
        POP P,TT
        POP P,D
        POP P,C
        LDB W,[410300,,D]
        TLNN E,100000
         CAIN W,7       ;SKIP IF NOT AT 1ST CHAR.
          TLNN E,300000
           JRST INBTO3
        POPJ P,

INBTO3: UMOVE W,(D)             ;PICK UP CURRENT WORD
        IDPB I,TT               ;INSERT CHARACTER
        UMOVEM W,(D)            ;PUT WORD BACK
        ADD D,[700000,,]
        TLNE D,500000
         JRST INBTO1            ;DO ANOTHER CHR THIS WORD
        MOVE TT,BTOCHT+4
        ADD D,[500001,,1]       ;INCR TO NEXT WD
        SKIPL E                 ;SKIP IF EOF
         JUMPL D,INBTO1
        UMOVEM D,(C)            ;DONE, UPDATE POINTER AND RETURN
        POPJ P,

INBTO2: MOVEI I,EOFCH           ;EOF, STORE EOF CHARACTER
        JRST INBTO3

;BLOCK IO TO WORD DEVICE
;C POINTS TO AOBJN POINTER IN USER SPACE
;Q POINTS TO WORD HANDLING ROUTINE (POINTER WILL BE IN C)
;MUST NOT CLOBBER Q OR H (PTR ROUTINES DO POPJ2 SOMETIMES)
;WRDBRT CHECKED FOR ON PDL BY TVC ROUTINES

WRDBT:  MOVE H,C
        UMOVE C,(H)             ;FETCH USER'S AOBJN POINTER
        JUMPGE C,CPOPJ
        JRST WRDBT3

WRDBT2: PUSHJ P,OPBRK
WRDBT3: ANDI C,-1
        PUSHJ P,(Q)
WRDBRT:  JRST WRDBT5            ;NO SKIP - WORD XFERRED
         SKIPA C,[1,,1]         ;1 SKIP - LAST WORD XFERRED
          POPJ P,               ;2 SKIPS - EOF, NO WORD XFERRED
        XCTR XRW,[ADDM C,(H)]
        POPJ P,

WRDBT5: MOVE C,[1,,1]
        XCTR XRW,[ADDB C,(H)]
        JUMPL C,WRDBT2
        POPJ P,

;JSP W,WRDBTI TO DO WRDBT FOR A UNIT MODE INPUT ROUTINE SATISFYING NEW
;CALLING CONVENTION FOR THOSE.
WRDBTI: JSP Q,WRDBT
        XCTR XRW,[MOVES (C)]
        PUSH P,W
        PUSHJ P,(W)
         JRST WRDBT4
         JRST POPWJ2
        AOS -1(P)
WRDBT4: UMOVEM W,(C)
        MOVEI Q,WRDBTI+1
        POP P,W
        POPJ P,
\f
;CHANGED CONVENTIONS: 
 ;1) EOF IS NO LONGER CHECKED FOR CHARACTER BY CHARACTER.
 ;   INSTEAD, THE GET-BUFFER ROUTINE SHOULD SET UP THE BYTE COUNT
 ;   TO A SMALLER VALUE THAN USUAL.
 ;   AN ATTEMPT TO GET ANOTHER BUFFER AFTER REACHING EOF
 ;   SHOULD CAUSE THE GET-BUFFER ROUTINE TO SKIP TWICE.
 ;2) THE THE BUFFER POINTER IS NOW A B.P. EVEN IN IMAGE MODE.
 ;   ALSO, THE L.H. OF THE B.P. IS NOT INITTED HERE.
 ;   IT MUST BE SET UP BY THE OPEN ROUTINE. ALSO, ACCESS ROUTINES
 ;   FOR DSK MUST KNOW HOW TO SET IT UP.
 ;   ALSO, THE BUFFER GET ROUTINE SHOULD SET IT UP,
 ;   INSTEAD OF RETURNING THE BUFFER ADDRESS IN TT.
 ;3) THE BYTE SIZE THE FILE IS OPEN ON IS PASSED AS AN ARGUMENT.
 ;   THIS ROUTINE WORKS FOR ANY CHANNEL BYTE SIZE WITH ANY
 ;   SIOT BYTE SIZE.

;GENERAL BLOCK I/O
;RH OF E HAS # BYTES/WORD OF FILE BYTE SIZE.  LH OF E HAS B.P. 44NN00.
;RH(C) = ADDR OF COUNT, IN USER MEMORY
;RH(TT) = ADDR OF USER'S B.P.
; ARGUMENTS B ->
;0(B)   ADDR OF ACTIVE BUFFER BYTE PTR, 4.9=0 => INPUT, =1 => OUTPUT
;1(B)   ADDR OF COUNT OF BYTES REMAINING IN CURRENT BUFFER
;2(B)   ROUTINE TO GET NEXT BUFFER.  NO SKIP IF NO MEMORY
;        OTHERWISE SKIP; BUFFER BYTE COUNT IN @1(B)
;        AND BUFFER BYTE POINTER ALREADY SET UP.
;         2 SKIPS => THERE IS NO BUFFER, DUE TO EOF.
;       WHEN THIS ROUTINE IS CALLED, E CONTAINS THE
;       NUMBER OF BYTES/WORD (GOOD FOR DETERMINING CHANNEL MODE).
;3(B)   ROUTINE TO PUT BUFFER (OUTPUT) OR DISCARD (INPUT)
;       MAY REACTIVATE CURRENT BUFFER BY SETTING @1(B) TO NONZERO,
;       IN WHICH CASE IT SHOULD CONTAIN THE NEW NUMBER OF BYTES.
;4(B)   NOT USED
;5(B)   IF POSITIVE, INSTRUCTION TO WAIT FOR I/O
;       IF NEGATIVE, ROUTINE ASSUMES 2(B) AND 3(B) WILL WAIT

;RELOADING ROUTINES MUST NOT CLOBBER B,E,A,C,I
;SIOKT CLOBBERS C,D,J,TT, AND WHATEVER THE RELOADING ROUTINES CLOBBER.

SIOKT:  PUSH P,E
        PUSH P,TT
        PUSH P,C
        JRST SIOKT1

;NEXT BUFFER

SIOKNB: PUSHJ P,@3(B)   ;"DISCARD" BUFFER
        SKIPE J,@1(B)   ;CHECK AMOUNT REMAINING ONE MORE TIME
         JRST SIOKT1    ;IT SPRUNG BACK TO LIFE (WRITE OVER MODE LAST BLOCK OF FILE)
        SKIPG 5(B)      ;NEED TO WAIT FOR DEVICE?
         JRST SIOKF1    ;NO.
SIOKN1: SKIPG 5(B)      ;COME HERE IF MUST WAIT FOR SOME REASON OR OTHER
         JRST SIOKW1    ;DEVICE CAN'T WAIT SO UDELAY
        XCT 5(B)        ;DEVICE WAIT
SIOKF:  PUSHJ P,UFLS

SIOKF1: PUSHJ P,@2(B)   ;NOW GET NEXT BUFFER
         JRST SIOKN1    ;HMM, HAVE TO WAIT
          JRST SIOKT1   ;BUFFER HAS BEEN GOT.
        JRST POP3J1     ;EOF, TRANSFER IS COMPLETE

SIOKT1: UMOVE TT,@(P)   ;GET COUNT OF BYTES TO TRANSFER
        JUMPLE TT,POP3J1        ;COUNT DECREMENTED TO 0; TRANSFER DONE.
        SKIPG D,@1(B)   ;CHECK AMOUNT LEFT IN BUFFER
         JRST SIOKNB    ;NEW BUFFER NEEDED
        CAMLE TT,D      ;AMT OF ROOM LEFT IN CURRENT BUFFER
         MOVE TT,D      ;TRANSFER ONLY AMT LEFT IN BUFFER
        UMOVE J,@-1(P)
        IBP J
        LDB D,[301400,,J]
        MOVE C,@(B)
        IBP C           ;TO TRANSFER WORD-WISE, BOTH B.P.'S MUST
        HRL J,C
        LDB C,[301400,,C]
        CAIE C,(D)      ;HAVE SAME BYTE SIZE,
         JRST SIOKS1
        LDB D,[060600,,C]
        ANDI C,77
        ADDI C,(D)
;DROPS THROUGH
\f;DROPS IN
        CAIGE TT,@-2(P) ;THERE MUST BE AT LEAST 1 WORD TO TRANSFER,
         JRST SIOKS1
        CAIE C,44       ;AND MUST BE ABOUT TO START THE NEXT WORD.
         JRST SIOKSL
        PUSH P,TT+1
        IDIVI TT,@-3(P) ;GET # WDS TO BLT
        POP P,TT+1
        SKIPGE (B)
         MOVSS J        ;WRITING, SWAP BLT POINTER
        MOVE D,J
        ADDI TT,(D)     ;1+LAST WORD TO BLT INTO
        SKIPGE (B)
         JRST SIOKN6    ;JUMP IF WRITING
        XCTRI XBW,[BLT D,-1(TT)] ;READING
SIOKN7:  MOVEI D,(TT)   ;NO FAULT, UPDATE PTR TO LAST WORD + 1 (LIKE KL10)
SIOKN8: SUBM D,J
        HRRZS J         ;# WDS ACTUALLY XFERRED
        ADDM J,@(B)     ;INCR BUFFER PNTR
        XCTR XRW,[ADDM J,@-1(P)]
        IMULI J,@-2(P)
        MOVNS J
        XCTR XRW,[ADDM J,@(P)]
        ADDM J,@1(B)    ;DECREMENT COUNT LEFT IN BUFFER
        CAIE D,(TT)     ;SKIP IF TRANSFERRED ALL WE COULD
         PUSHJ P,TPFLT  ;TAKE FAULT
SIOKN3: SKIPN @1(B)
         PUSHJ P,@3(B)  ;BUFFER EXHAUSTED, DISCARD (MAY COME BACK TO LIFE).
        JRST SIOKT1     ;TRY AGAIN TO TRANSFER.

SIOKW1: PUSHJ P,UDELAY
        JRST SIOKF1

SIOKN6: XCTRI XBR,[BLT D,-1(TT)] ;WRITING TRANSFER
         JRST SIOKN7
        JRST SIOKN8

;COME HERE FOR SLOW (BYTE AT A TIME) SIOT TO BLOCK MODE DEVICE.
;TT HAS NUMBER OF BYTES TO TRANSFER - IT IS KNOWN THAT THE DEVICE
;CAN SUPPLY THAT MANY FROM ITS CURRENT BUFFER.
SIOKSL: SUBM C,D        ;D GETS SIZE; C HAS # BITS REMAINING TO BE HANDLED
        IDIV C,D        ;C GETS # BYTES TO XFER TILL REACH WORD BOUNDARY.
        MOVE TT,C       ;XFER THAT MANY, THEN TRY AGAIN, SO WILL USE FAST MODE.
SIOKS1: SKIPL (B)
         JRST SIOKSI    ;INPUT AND OUTPUT PART HERE
        LDB D,[300600,,@(B)]    ;BYTE SIZE IN THE BUFFER
        MOVEI C,36.
        IDIV C,D        ;D := # EXTRA BITS AT RIGHT END OF WORD
        MOVEI J,1
        LSH J,(D)
        SOS J           ;J := MASK FOR THEM
        UMOVE C,@-1(P)  ;GET COPY OF USER'S B.P. FOR SWAPPING IN PAGES.
SIOKS3: IBP C           ;IF NOT FOR THESE 2 INSNS, ILDB MIGHT GET PAGE FAULT
        UMOVE (C)       ;WHICH WOULD CAUSE EXTRA INCREMENTING OF B.P.
        XCTR XBYTE,[ILDB D,@-1(P)] ;FETCH NEXT BYTE,
        IDPB D,@(B)
        MOVE D,@(B)
        ANDCAM J,(D)    ;TURN OFF EXTRA BITS IN THIS WORD OF BUFFER
        SOS @1(B)
        XCTR XRW,[SOS @(P)]
        SOJG TT,SIOKS3
        JRST SIOKN3

SIOKSI: UMOVE C,@-1(P)  ;GET COPY OF USER'S B.P., FOR WRITEABILITY TESTING.
SIOKS2: IBP C
        XCTR XRW,[MOVES (C)]    ;MAKE SURE WE CAN WRITE IN NEXT BYTE.
        ILDB D,@(B)             ;GET NEXT BYTE FROM DEVICE BUFFER
        XCTR XBYTE,[IDPB D,@-1(P)];GIVE IT TO USER.
        XCTR XRW,[SOS @(P)]     ;UPDATE USER'S COUNT
        SOS @1(B)               ;AND THE SYSTEM'S COUNT.
        SOJG TT,SIOKS2
        JRST SIOKN3

;CONVENIENT EXIT ROUTINE FOR BUFFER-GET ROUTINES.
;ASSUMES ADDR OF START OF BUFFER IN TT,
;SIZE (IN WORDS) OF DATA AREA IN J.
;E SHOULD HAVE WHAT IT HAD WHEN SIOKT WAS CALLED.
SIOBGX: IMULI J,(E)
SIOBG1: HLL TT,E
SIOBG2: MOVEM TT,@(B)
        MOVEM J,@1(B)
        JRST POPJ1
\f
;BYTE AT A TIME I/O TO BLOCK MODE DEVICE
;SEE PRECEDING PAGE (SIOKT) FOR COMMENTS ON CALLING SEQUENCE
;EXCEPT: ON INPUT, VALUE RETURNED IN W, AND C,D HAVE NO SIGNIFICANCE;
;ON OUTPUT, RH(C) HAS ADDRESS OF ARG, SIGN(C) SET IFF ADDRESS IS EXEC-MODE,
; AND D HAS NO SIGNIFICANCE.

CHRKT:  SKIPGE (B)
         JRST CHRKTO    ;WRITING
        JRST CHRKTI     ;READING

CHRKTI: SOSGE @1(B)     ;DECREMENT ACTIVE CHAR COUNT
         JRST CHRKT1    ;GET NEW BUFFER
        ILDB W,@(B)     ;READ - GET NEXT CHAR
        POPJ P,

CHRKTO: SKIPGE C        ;USED WHEN FILLING OUT BLOCK AT CLOSE, AND ELSEWHERE.
         SKIPA J,(C)
          UMOVE J,(C)   ;GET CHAR. FROM USER
        SOSGE @1(B)     ;DECREMENT ACTIVE CHAR COUNT
         JRST CHRKT1    ;GET NEW BUFFER
        IDPB J,@(B)     ;DEPOSIT IN BUFFER
        CAIE E,5        ;SKIP IF ASCII
         POPJ P,
        MOVEI J,1
        MOVE D,@(B)
        ANDCAM J,(D)    ;CLEAR EXTRA BIT
        POPJ P,

CHRKT1: AOS @1(B)       ;COMPENSATE FOR OVER-SOS
        PUSHJ P,@3(B)   ;GET RID OF THIS BUFFER
        SKIPLE J,@1(B)  ;CHECK AMOUNT REMAINING ONE MORE TIME
         JRST CHRKT     ;SPRUNG BACK TO LIFE (LAST BLOCK OF FILE WRITE OVER)
        SKIPG 5(B)      ;NEED TO WAIT FOR DEVICE?
         JRST CHRKF1    ;NO.
CHRKN1: SKIPG 5(B)      ;HAVE TO WAIT
         JRST [ PUSHJ P,UDELAY
                JRST CHRKF1 ]
        XCT 5(B)        ;DEVICE WAIT
         PUSHJ P,UFLS

CHRKF1: PUSHJ P,@2(B)   ;GOBBLE NEW BLOCK
         JRST CHRKN1    ;NOT READY, WAIT
          JRST CHRKT
        CAME E,[444400,,1]
         JRST UNIEOF    ;READING PAST EOF IN ASCII MODE.
        JRST IOCER2     ;READING PAST EOF IN IMAGE MODE.
\f
;GENERAL BLOCK I/O
;E HAS BPLH,,# BYTES/WORD OF FILE BYTE SIZE - MUST BE 444400,,1
;RH(C) = ADDR OF AOBJN POINTER
; AND 4.9 => AOBJN PTR IS IN EXEC ADDRESS SPACE,
;     4.8 => BLOCK IT POINTS TO IS IN EXEC ADDRESS SPACE. (INPUT ONLY)
; ARGUMENTS B ->
;0(B)   ADDR OF ACTIVE BUFFER BYTE PTR, 4.9=0 => INPUT, =1 => OUTPUT
;1(B)   ADDR OF COUNT OF BYTES REMAINING IN CURRENT BUFFER
;2(B)   ROUTINE TO GET NEXT BUFFER.  NO SKIP IF NO MEMORY
;        OTHERWISE SKIP; BUFFER BYTE COUNT IN @1(B)
;        AND BUFFER B.P. IN @(B) ALREADY SET UP.
;         2 SKIPS => THERE IS NO BUFFER, DUE TO EOF.
;3(B)   ROUTINE TO PUT BUFFER (OUTPUT) OR DISCARD (INPUT)
;       MAY REACTIVATE CURRENT BUFFER BY SETTING @1(B) TO NONZERO.
;4(B)   NOT USED
;5(B)   IF POSITIVE, INSTRUCTION TO WAIT FOR I/O
;       IF NEGATIVE, ROUTINE ASSUMES 2(B) AND 3(B) WILL WAIT

;RELOADING ROUTINES MUST NOT CLOBBER B,E,A,C,I
;BLKT CLOBBERS C,D,J,TT, AND WHATEVER THE RELOADING ROUTINES CLOBBER.

;CODE IS ON NEXT PAGE
\f
BLKT:   CAME E,[444400,,1]
         BUG            ;BLKT CALLED ON UNIT ASCII MODE CHANNEL??
        SKIPL C         ;SKIP IF POINTER IN USER SPACE
         XCTR XRW,[MOVES (C)] ;USER SPACE, MAKE SURE WRITE CYCLE WILL WIN
        JRST BLKT1

;NEXT BUFFER

BLKTNB: PUSHJ P,@3(B)   ;"DISCARD" BUFFER
        SKIPE @1(B)     ;CHECK AMOUNT REMAINING ONE MORE TIME
         JRST BLKT1     ;IT SPRUNG BACK TO LIFE (WRITE OVER MODE LAST BLOCK OF FILE)
        SKIPG 5(B)      ;NEED TO WAIT FOR DEVICE?
         JRST BLKTF1    ;NO.
BLKTN1: SKIPG 5(B)      ;COME HERE IF MUST WAIT FOR SOME REASON OR OTHER
         JRST BLKTW1    ;DEVICE CAN'T WAIT SO UDELAY
        XCT 5(B)        ;DEVICE WAIT
BLKTF:  PUSHJ P,UFLS

BLKTF1: PUSHJ P,@2(B)   ;NOW GET NEXT BUFFER
         JRST BLKTN1    ;HMM, HAVE TO WAIT
          JRST BLKT1
        POPJ P,         ;EOF, TRANSFER FINISHED

BLKT1:  SKIPGE C        ;SET UP FOR TRANSFER
         SKIPA J,(C)    ;GET EXEC MODE BLOCK .IOT (AOBJN) POINTER
          UMOVE J,(C)   ;GET USER MODE AOBJN POINTER
        JUMPGE J,CPOPJ  ;POINTER COUNTED OUT, TRANSFER DONE
        SKIPG D,@1(B)   ;CHECK AMOUNT LEFT IN BUFFER
         JRST BLKTNB    ;NEW BUFFER NEEDED
        HLRE TT,J
        MOVNS TT        ;DESIRED SIZE OF BLOCK
        CAMLE TT,D      ;AMT OF ROOM LEFT IN CURRENT BUFFER
         MOVE TT,D      ;TRANSFER ONLY AMT LEFT IN BUFFER
        MOVE D,@(B)     ;CANONICALIZE THE BUFFER B.P. SO RH => NEXT WORD TO XFER
        IBP D
        HRL J,D         ;MERGE WITH USER'S BLOCK ADDR TO GET BLT AC.
        SKIPGE (B)
         MOVSS J        ;WRITING, SWAP BLT POINTER
        MOVE D,J
        ADDI TT,(D)     ;1+LAST WORD TO BLT INTO
        TLNE C,200000
         JRST BLKTN9    ;JUMP IF EXEC AOBJN POINTER
        SKIPGE (B)
         JRST BLKTN6    ;JUMP IF WRITING
        XCTRI XBW,[BLT D,-1(TT)] ;READING
BLKTN7:  MOVEI D,(TT)   ;NO FAULT, UPDATE PTR TO LAST WORD + 1 (LIKE KL10)
BLKTN8: SUBM D,J
        HRRZS J         ;# WDS ACTUALLY XFERRED
        ADDM J,@(B)     ;INCR BUFFER PNTR
        HRLS J          ;PUT # WDS IN BOTH HALVES
        JUMPL C,BLKTN3  ;UPDATE AOBJN PTR IN EXEC SPACE
        XCTRI XRW,[ADDM J,(C)] ;UPDATE AOBJN PTR IN USER SPACE
         JRST .+2
          BUG           ;MUMBLE.  THIS WAS SUPPOSED TO BE THERE.

BLKTN4: MOVNI J,(J)
        ADDM J,@1(B)    ;DECREMENT COUNT LEFT IN BUFFER
        CAIE D,(TT)     ;SKIP IF TRANSFERRED ALL WE COULD
         PUSHJ P,TPFLT  ;TAKE FAULT IF ANY
        SKIPN @1(B)
         PUSHJ P,@3(B)  ;BUFFER EXHAUSTED, "DISCARD"
        JRST BLKT1      ;GO TRANSFER ANOTHER CHUNK

BLKTN3: ADDM J,(C)      ;UPDATE EXEC AOBJN POINTER
        JRST BLKTN4

BLKTW1: PUSHJ P,UDELAY
        JRST BLKTF1

BLKTN6: XCTRI XBR,[BLT D,-1(TT)] ;WRITING TRANSFER
         JRST BLKTN7
        JRST BLKTN8

BLKTN9: BLT D,-1(TT)    ;READING INTO EXEC SPACE
        JRST BLKTN7
\f
SUBTTL DIRECTORY AND ERR DEVICES

QMLSTF: MOVEI J,4       ;ENTRY TO GET MASTER 2314 DIRECTORY
        JRST LISTF7

QLISTF: MOVEI J,3       ;ENTRY FOR 2314 USER DIRECTORY
LISTF7: MOVEI I,0
LISTFE: PUSHJ P,SWTL    ;ENTER HERE FOR ALL KINDS OF DIRECTORIES.
        UDCSW
        MOVSI TT,-NUDCH
UD1:    SKIPGE UDUSR(TT)
         JRST UD2
        AOBJN TT,UD1
        PUSHJ P,LSWPOP
        PUSHJ P,UDELAY  ;DIRECTORY NOT AVAILABLE NOW, WAIT
        JRST LISTFE

UD2:    MOVEM J,DSKLST(TT)
        MOVEM I,UDUSR(TT)
        MOVEM U,UDUIND(TT)
        PUSHJ P,LSWPOP
        MOVE Q,USYSN1(U)
        MOVEM Q,UDSYSN(TT)
        JUMPG J,UDIF    ;JUMP IF NOT UTAPE DIR.
IFE NUNITS, BUG         ;HOW DID UTAPE GET HERE?
IFN NUNITS,[
        CONO PI,CLKOFF
        MOVE Q,UDIRO(I)
        MOVEM Q,DIRPT(TT)
        CONO PI,CLKON
        MOVEI J,200
        TRNE D,2
        JRST UDBIN      ;IMAGE MODE UTAPE DIR
        MOVEI Q,LISTF   ;ASCII MODE UTAPE DIR
]
UDIF1:  MOVEM Q,DIRPC(TT)
        HRL A,TT
        JSP Q,OPSLD1
        DIRCHN,,DIRBN

UDIF:   HLRZ Q,UDT-1(J) ;INITIAL COROUTINE PC
        HRRZ T,UDT-1(J) ;PLACE TO FINISH OPENING - USUALLY UDIF1.
        JRST (T)

UQL1:   HRRZM H,UUDPP(TT)       ;2314 MFD (FROM UDIF)
        MOVEI J,2000
        TRNE D,2
        JRST QUDBIN
        JRST UDIF1

UQL1A:  PUSHJ P,STMSET  ;DISK UFD (FROM UDIF). WE CAN STILL PCLSR,
        UDUSR(TT)       ;ARRANGE TO GIVE BACK THE DIRECTORY CHANNEL.
UQL1B:  PUSH P,TT
        PUSHJ P,QUDLK
        PUSHJ P,TCALL   ;GET A LOW-HALF PAGE TO COPY UFD INTO.
          JRST IOMQ     ;GET LOW HALF PAGE
         JRST UQL1W     ;NOT AVAIL NOW
        MOVEI T,MU23LS
        DPB T,[MUR,,MEMBLT(A)]  ;MARK THE PAGE AS A UFD COPY.
        LSH A,10.
        MOVEM A,DIRPT(TT)
        MOVEM A,UUDPP(TT)
        HRL A,QSNLCN(H)
        HRRI T,2000(A)
        BLT A,-1(T)     ;COPY UFD
        PUSHJ P,QUDULK
        PUSHJ P,LSWDEL  ;STMSET OF UDUSR.
        SKIPG QSNNR(H)
         BUG            ;WE ALWAYS GET OUR MAN
        PUSHJ P,LSWPOP  ;SOS QSNNR
        POP P,TT
        MOVEI J,2000
        TRNE D,2
        JRST UDBIN
        JRST UDIF1

UQL1W:  PUSHJ P,QUDULK
        POP P,TT
        PUSHJ P,UDELAY
        JRST UQL1B
\f
;LH INITIAL PC RH DISP ADR AT OPEN TIME
UDT:    NDLF,,UDIF1     ;NON DIR DEVICE
        UCL1,,UDIF1     ;CORE LINK
        UQL2,,UQL1A     ;2314 UFD
        QMLS1,,UQL1     ;2314 MFD
        ERR1,,ERR2      ;ERR DEVICE
        TTYFLD,,UDIF1   ;TTY DIR
        TTYF99,,UDIF1   ;COR DIR (LAST LINE OF TTY DIR)
UDTLN==.-UDT

QUDBIN: HRRZ T,QMDRO
        MOVEM T,DIRPT(TT)
UDBIN:  MOVEM J,NUM(TT) ;DOESN'T USE DIRPC THIS PC
        MOVEM J,ENDT(TT)
        MOVEI J,444400
        HRLM J,DIRPT(TT)
        HRL A,TT
        JSP Q,OPSLD1
        NDATAI,,NBLKI

UTDCLS: MOVE B,DSKLST(A)
        CAIN B,3
        JRST UTDCL1
UTDCLX: SETOM UDUSR(A)
        POPJ P,

UTDCL1: PUSH P,A
        MOVE A,UUDPP(A)
        LSH A,-10.
        PUSHJ P,MEMR
        POP P,A
        JRST UTDCLX

;UNIT MODE IOT ON DIR DEVICE COMES HERE (RETURN CHAR IN W)
DIRCH:  SETOM SRN3(U)   ;SAY WE WANT ONLY 1 CHARACTER.
        PUSHJ P,DIRCHR
        HRRZ W,I
        CAIN W,^C
         JRST UNIEOF
        POPJ P,

;BLOCK MODE IOT ON DIR DEVICE.
DIRB:   JSP Q,WRDBT     ;PUSHJ'S TO .+1 FOR EACH WORD.
DIRB1:  XCTR XRW,[MOVES (C)]    ;MAKE SURE WE CAN WRITE.
        PUSH P,C
        PUSH P,H
        SETZM SRN3(U)   ;SAY WE WANT A WHOLE WORD OF CHARS.
        PUSHJ P,DIRCHR
        POP P,H
        POP P,C
        LDB Q,[350700,,SRN3(U)]
        CAIN Q,^C       ;IF THE WORD STARTS WITH ^C,
         JRST POPJ2     ;IT IS EOF; DON'T RETURN IT, UNHANG IOT.
        MOVE Q,SRN3(U)
        UMOVEM Q,(C)
        MOVEI Q,DIRB1   ;FASTER THAN PUSHING AND POPPING Q.
        POPJ P,         ;RETURN INTO WRDBT

        SKIPA T,[SIOKT]
DDATAI:  MOVEI T,CHRKTI ;UNIT IMAGE INPUT FROM DIRECTORY.
        CAIA
DBLKI:   MOVEI T,BLKT   ;BLOCK IMAGE INPUT FROM DIRECTORY
        MOVE E,[444400,,1]
        JSP B,(T)       ;TO BLKT, SIOKT, OR CHRKTI
          DIRPT(A)
          NUM(A)
          POPJ2         ;EOF IF TRY TO GET ANOTHER BUFFER
          CPOPJ         ;BUFFER DISCARD ROUTINE
          BUG
          SKIPA
\f
;ERR DEVICE AND ERROR MESSAGE TABLES
; ERR DEVICE WORKS MUCH LIKE DIR DEVICE

ERRO:   MOVEI J,5
        JRST LISTF7

ERR2:   SOJE A,ERR21    ;LAST ERRONEOUS CHANNEL
        SOJE A,ERR22    ;CHANNEL SPECIFIED IN B
        SOJE A,ERR23    ;STATUS WORD IN B
        SOJE A,ERR24    ;.CALL ERROR ARG IN B
        SETOM UDUSR(TT)
        JRST OPNL11

ERR21:  LDB B,[BCHPTR]
ERR22:  ANDI B,17
        ADDI B,IOCHST(U)
        SKIPA B,(B)
ERR24:   MOVSS B
ERR23:  MOVEM B,UUDPP(TT)
        JRST UDIF1

CORO:   PUSHJ P,FLDRCK
        JRST OPNL11
        MOVEI J,7
        JRST LISTF7

ERR1:   SKIPN I,UUDPP(A)
        JRST ERR3
        LDB B,[220600,,UUDPP(A)]        ;OPEN LOSS FIELD
        JUMPE B,ERR1B
        CAIL B,NERMES+1
         MOVEI B,NERMES+1
        MOVE TT,ERMST1-1(B)
        JSP B,MESPNT
ERR1B:  LDB B,[300300,,UUDPP(A)]        ;IDS ERROR FIELD
        JUMPE B,ERR1C
        MOVE TT,ERMST2-1(B)
        JSP B,MESPNT
ERR1C:  LDB B,[330400,,UUDPP(A)]        ;IOCERR FIELD
        JUMPE B,UCL7
        CAIL B,MIOTER
        CAIL B,NERM1+MIOTER
        MOVEI B,NERM1+MIOTER
        MOVE TT,ERMST3-MIOTER(B)
        JSP B,MESPNT
        JRST UCL7

ERR3:   MOVEI TT,[ASCIZ /ISE0
/]
        JSP B,MESPNT
        JRST UCL7
\f
;LISP ASSUMES THAT NO "ERR" DEVICE MESSAGE WILL EVER CONTAIN
; !, #, ^, OR LOWER CASE LETTERS.  PLEASE MAINTAIN THIS STATE
;   GLS (GUY STEELE)

ERMST1: [ASCIZ /NO SUCH DEVICE
/]
        [ASCIZ /WRONG DIRECTION
/]
        [ASCIZ /TOO MANY TRANSLATIONS
/]
        [ASCIZ /FILE NOT FOUND
/]
        [ASCIZ /DIRECTORY FULL
/]
        [ASCIZ /DEVICE FULL
/]
        [ASCIZ /DEVICE NOT READY
/]
        [ASCIZ /DEVICE NOT AVAILABLE
/]
        [ASCIZ /ILLEGAL FILE NAME
/]
        [ASCIZ /MODE NOT AVAILABLE
/]
        [ASCIZ /FILE ALREADY EXISTS
/]
        [ASCIZ /BAD CHANNEL NUMBER
/]
        [ASCIZ /TOO MANY ARGUMENTS (CALL)
/]
        [ASCIZ /PACK NOT MOUNTED
/]
        [ASCIZ /DIRECTORY NOT AVAIL
/]
        [ASCIZ /NON-EXISTENT DIRECTORY
/]
        [ASCIZ /LOCAL DEVICE ONLY
/]
        [ASCIZ /SELF-CONTRADICTORY OPEN
/]
        [ASCIZ /FILE LOCKED
/]
        [ASCIZ /M.F.D. FULL
/]
        [ASCIZ /DEVICE NOT ASSIGNABLE TO THIS PROCESSOR
/]
        [ASCIZ /DEVICE WRITE-LOCKED
/]
        [ASCIZ /LINK DEPTH EXCEEDED
/]
        [ASCIZ /TOO FEW ARGUMENTS (CALL)
/]
        [ASCIZ /CAN'T MODIFY JOB
/]
        [ASCIZ /CAN'T GET THAT ACCESS TO PAGE
/]
        [ASCIZ /MEANINGLESS ARGS
/]
        [ASCIZ /WRONG TYPE DEVICE
/]
        [ASCIZ /NO SUCH JOB
/]
        [ASCIZ /VALID CLEAR OR STORED SET
/]
        [ASCIZ /NO CORE AVAILABLE
/]
        [ASCIZ /NOT TOP LEVEL
/]
        [ASCIZ /OTHER END OF PIPELINE GONE OR NOT OPEN
/]
        [ASCIZ /JOB GONE OR GOING AWAY
/]
        [ASCIZ /ILLEGAL SYSTEM CALL NAME
/]
        [ASCIZ /CHANNEL NOT OPEN
/]
        [ASCIZ /INPUT BUFFER EMPTY OR OUTPUT BUFFER FULL
/]
        [ASCIZ /UNRECOGNIZABLE FILE
/]
        [ASCIZ /LINK TO NON-EXISTENT FILE
/]
IFN .-ERMST1-NOPNLS,.ERR WRONG TABLE LENGTH
;ADD NEW MESSAGES HERE

IFN 0,[         A CLASSIFICATION OF OPEN-LOSS MESSAGES

FULL -  NO CORE (MMP FULL)
        DIR NOT AVAIL (DIR CHNL TABLE FULL)
        DEVICE FULL
        DIR FULL
        MFD FULL
        INPUT BUFFER EMPTY OR OUTPUT BUFFER FULL

NO SUCH - DEVICE, FILE, JOB, DIRECTORY, PAGE (CAN'T GET ACCESS)
          ILLEGAL SYSTEM CALL NAME

ALREADY ONE SUCH - FILE (FILE ALREADY EXISTS - RENAME)

WRITING - CAN'T MODIFY JOB
         DEVICE WRITE-LOCKED
         WRONG DIRECTION
         MODE NOT AVAILABLE
         CAN'T GET ACCESS TO PAGE

ARGS (THE PARAMETERS ARE RIDICULOUS) -
        SELF-CONTRADICTORY OPEN COMMAND
        ILLEGAL FILE NAME
        BAD CHANNEL NUMBER
        TOO FEW ARGS
        TOO MANY ARGS
        MEANINGLESS ARGS
        CHANNEL NOT OPEN

NOT AVAILABLE (IT EXISTS BUT YOU CAN'T USE IT) -
        DEVICE NOT READY
        DEVICE NOT AVAILABLE
               NOT ASSIGNABLE TO THIS PROCESSOR
        LOCAL DEVICE
        PACK NOT MOUNTED
        FILE LOCKED
        OTHER END OF PIPELINE GONE
        JOB GONE OR GOING AWAY

DEPTH - LINK DEPTH EXCEEDED
        TOO MANY TRANSLATIONS

OTHER - NOT TOP LEVEL
        VALID CLEAR OR STORED SET
]
\f
NERMES==.-ERMST1
        [ASCIZ /OPEN TYPE NOT DETERMINED
/]

ERMST2: [ASCIZ /IDS ILLEGAL SCOPE MODE
/]
        [ASCIZ /IDS SCOPE HUNG
/]
        [ASCIZ /MORE THAN 1K SCOPE BUFFER
/]
        [ASCIZ /IDS MEM PROTECT
/]
        [ASCIZ /IDS ILLEGAL SCOPE OP
/]
        [ASCIZ /IDS MEM PROTECT ON PDL PNTR
/]
        [ASCIZ /IDS ILLEGAL PARAMETER SET
/]

ERMST3: [ASCIZ /DEVICE HUNG OR REPORTING NON-DATA ERROR
/]
        [ASCIZ /END OF FILE
/]
        [ASCIZ /NON-RECOVERABLE DATA ERROR
/]
        [ASCIZ /NON-EXISTENT SUB DEVICE
/]
        [ASCIZ /OVER IOPOP
/]
        [ASCIZ /OVER IOPUSH
/]
        [ASCIZ /USR OP CHNL DOES NOT HAVE USR OPEN
/]
        [ASCIZ /CHNL NOT OPEN
/]
        [ASCIZ /DEVICE FULL
/]
        [ASCIZ /CHNL IN ILLEGAL MODE ON IOT
/]
        [ASCIZ /ILLEGAL CHR AFTER CNTRL P ON TTY DISPLAY
/]
        [ASCIZ /DIRECTORY FULL
/]
        [ASCIZ /DIRECTORY'S ALLOCATION EXHAUSTED
/]
;INSERT NEW MESSAGES HERE
NERM1==.-ERMST3
        [ASCIZ /IOT OR OPR TYPE NOT DETERMINED
/]
\f
;DIRECTORY LISTING ROUTINES

UQL3C:  SKIPA I,["*]
UQL3:    MOVEI I,"-
        PUSHJ P,OUTC
        JRST UQL3A

UQL2:   MOVEI TT,[MNAME ASCIZ /,  /]    ;GENERATE USER DIRECTORY
        JSP B,MESPNT
        MOVE I,UUDPP(A)
        MOVEI J,UDNAME(I)
        JSP B,SIXTYC    ;SEND DIRECTORY NAME
        MOVEI TT,[ASCIZ /
FREE BLOCKS /]
        JSP B,MESPNT
        MOVSI E,-NQS
UQL2A:  SKIPGE QACT(E)
         JRST UQL3      ;UNIT NOT ENGAGED
        MOVE J,QTUTO(E)
        TLNE J,40000
         JRST UQL3C     ;TUT FOR UNIT NOT IN
        MOVEI I,"#
        PUSHJ P,OUTC
        MOVE TT,QPKID(E)
        JSP B,GDPT      ;AND #
        MOVEI I,"=
        PUSHJ P,OUTC
        MOVE TT,QSFT(E)
        JSP B,GDPT      ;AND # FREE TRACKS
UQL3A:  PUSHJ P,OUTCS
        AOBJN E,UQL2A
        JSP B,MESPCR
        MOVE I,UUDPP(A)
        MOVEM I,DIRPT(A)
        MOVE Q,UDNAMP(I)
UQL4:   CAIL Q,2000
         JRST UCL7
        HRLI I,440600+Q
        HLLM I,DIRPT(A)
\f
UQLP:   ADDI Q,2        ;MOVE PNTR TO 3RD WRD OF FILE DESC
        MOVE I,@DIRPT(A)
        MOVEI TT,[ASCIZ /* /]   ;DELETED OR BEING WITTEN
        TLNN I,UNIGFL
         MOVEI TT,[ASCIZ /  /]
        JSP B,MESPNT
        MOVE I,@DIRPT(A)
        TLNE I,UNLINK
         JRST UQLL1     ;LINK
        LDB TT,[UNPKN+@DIRPT(A)]
        JSP B,GDPT      ;PRINT PACK #
        LDB TT,[UNPKN+@DIRPT(A)]
        CAIG TT,9
UQLL2:   PUSHJ P,OUTCS
        PUSHJ P,OUTCS
        SUBI Q,2        ;BACK TO FIRST WD
        JSP B,SIXTYA    ;SEND FIRST FILE NAME
        JSP B,SIXTYB    ;AND SECOND (AOSES Q)
        PUSHJ P,OUTCS
        AOS Q           ;SET Q TO POINT TO FILE DESC PNTR
        LDB E,[UNDSCP+@DIRPT(A)]        ;PICK UP FILE DESC PNTR
        IDIVI E,UFDBPW
        ADDI E,UDDESC   ;COMPUTE WORD ADDRESS
        MOVE I,@DIRPT(A)        ;SAVE STATUS WORD
        EXCH E,Q        ;MOVE INTO PNTR
        MOVE TT,QBTBLI(TT)
        TLO TT,Q
        HLLM TT,DIRPT(A)        ;SET UP DIRPT TO POINT TO FILE DESC
        TLNE I,UNLINK
         JRST QLL1      ;LINK
        MOVEI TT,0
UQL5:   JSP B,UQL5R     ;CHECK IF ABOUT TO INCREMENT OFF WORD
        ILDB I,DIRPT(A)
        JUMPE I,UQL5A   ;STOP
        CAILE I,UDTKMX
         JRST UQL5B
        ADD TT,I
        JRST UQL5

UQLL1:  MOVEI I,"L
        PUSHJ P,OUTC
        JRST UQLL2
\f
QLL1:   CLEARM ENDT(A)  ;CNTS TO 3 FOR USER NAME AND 2 FILE NAMES
QLL3:   CLEARM NUM(A)   ;CHR CNTR
QLLIST: JSP B,UQL5R
        ILDB I,DIRPT(A)
        JUMPE I,QLL4
        CAIN I,';
         JRST QLL2
        CAIN I,':
         JRST QLL5
QLL5A:  ADDI I,40
        PUSHJ P,OUTC
        AOS I,NUM(A)
        CAIGE I,6
         JRST QLLIST
QLL2:   PUSHJ P,OUTCS
        AOS I,ENDT(A)
        CAIGE I,3
         JRST QLL3
QLL4:   JSP B,MESPCR
        MOVEI Q,3(E)    ;ADVANCE Q
        JRST UQL4

QLL5:   JSP B,UQL5R
        ILDB I,DIRPT(A)
        JRST QLL5A

UQL5R:  MOVE I,DIRPT(A) ;CHECK IF ABOUT TO ILDB OFF WORD
        TLNE I,770000
         JRST (B)       ;NO
        MOVEI I,440600+Q        ;YES INCREMENT Q INSTEAD
        HRLM I,DIRPT(A)
        AOJA Q,(B)

UQL5B:  CAIGE I,UDWPH   ;PLACE HOLDER
         AOJA TT,UQL5   ;SKIP AND TAKE
        CAIN I,UDWPH
         JRST UQL5      ;NULL
        REPEAT NXLBYT,[JSP B,UQL5R
        IBP DIRPT(A)
]
        AOJA TT,UQL5    ;SPACE OVER 2ND HALF OF LOAD ADDRESS
\f
UQL5A:  JSP B,GDPT      ;TYPE OUT # BLOCKS
        PUSHJ P,OUTCS
        MOVE Q,E        ;FILE POINTER
        MOVEI I,"!
        SKIPGE B,@DIRPT(A)      ;SKIP ON NOT DUMPED
         MOVEI I,40
        PUSHJ P,OUTC    ;HAS NOT BEEN BACKED UP
        MOVEI I,"$
        TLNN B,UNREAP   ;SKIP ON DON'T-REAP
         MOVEI I,40
        PUSHJ P,OUTC
        MOVEI Q,1(E)
        LDB E,[1200,,DIRPT(A)]
        JUMPN E,[JRST 4,.]
        MOVE TT,@DIRPT(A)
        AOJE TT,UQL5C   ;DATE NOT KNOWN
        LDB TT,[UNMON+@DIRPT(A)]
        JSP B,GDPT      ;TYPE MONTH
        MOVEI I,"/
        PUSHJ P,OUTC
        LDB TT,[UNDAY+@DIRPT(A)]
        JSP B,GDPT      ;TYPE DAY
        MOVEI I,"/
        PUSHJ P,OUTC
        LDB TT,[UNYRB+@DIRPT(A)]
        JSP B,GDPT      ;TYPE YEAR
        PUSHJ P,OUTCS
        HRRZ TT,@DIRPT(A)
        IDIVI TT,60.*60.*2
        MOVE E,I
        JSP B,G2DPT
        MOVEI I,":
        PUSHJ P,OUTC
        MOVE TT,E
        IDIVI TT,60.*2
        MOVE E,I
        JSP B,G2DPT
        MOVEI I,":
        PUSHJ P,OUTC
        MOVE TT,E
        LSH TT,-1
        JSP B,G2DPT
UQL5D:  JSP B,MESPCR
        ADDI Q,2        ;ADVANCE Q
        JRST UQL4

UQL5C:  MOVEI I,"-
        PUSHJ P,OUTC
        JRST UQL5D

;GENERATE MFD LISTING
QMLS1:  CONO PI,CLKOFF
        MOVE Q,QMDRO
        HRLI Q,440600+Q
        MOVEM Q,DIRPT(A)
        MOVE Q,MDNAMP(Q)
        CONO PI,CLKON
QMLS2:  CAIL Q,1777
         JRST UCL7
        SKIPN @DIRPT(A)
         JRST QMLS3
        JSP B,SIXTYA
        JSP B,MESPCR
QMLS3:  ADDI Q,LMNBLK
        JRST QMLS2
\f
;DIRECTORY LISTING ROUTINES FOR UTAPE

IFN NUNITS,[
LISTF:  MOVEI Q,220600+Q
        HRLM Q,DIRPT(A)
        MOVEI Q,177
        MOVE TT,@DIRPT(A)
        AOJE TT,LISTF1
        JSP B,SIXTYP
LISTF1: MOVEI TT,[ASCIZ /
FREE FILES /]
        JSP B,MESPNT
        MOVSI Q,-23.
        MOVEI TT,0
LISTF4: SKIPE @DIRPT(A)
        AOJA Q,LISTF8
        AOS Q
        SKIPN @DIRPT(A)
        AOS TT
LISTF8: AOBJN Q,LISTF4
        JSP B,GDPT
        MOVEI TT,[ASCIZ /       FREE BLOCKS /]
        JSP B,MESPNT
        SETZB J,TT
        JSP B,BLKPNT
LISTD2: JSP B,MESPCR
        MOVSI Q,-23.
LISTF2: MOVEI I,440600+Q
        HRLM I,DIRPT(A)
        MOVE I,@DIRPT(A)
        JUMPE I,LISTF5
LISTF6: PUSHJ P,OUTCS
        JSP B,SIXTYA
        JSP B,SIXTYB
        PUSHJ P,OUTCS
        MOVEI J,1(Q)
        JSP B,BLKPNN
LISTD4: JSP B,MESPCR
LISTF3: AOBJN Q,LISTF2
];END IFN NUNITS

UCL7:   MOVEI I,14      ;END DIR WITH FORMFEED AND EOF CHARS
        PUSHJ P,OUTC
        HRROI I,EOFCH
        JRST .-2

IFN NUNITS, LISTF5:     AOJA Q,LISTF3
\f
; DIRECTORY LISTING ROUTINES FOR MISC. DEVICES + CORE LINK

NDLF:   MOVEI TT,[ASCIZ /
NON-DIRECTORY DEVICE/]
        JSP B,MESPNT
        JRST UCL7

;DIRECTORY OF CORE LINK DEVICE
UCL1:   MOVSI Q,-NCLCH
UCL6:   SKIPN CLSYN(Q)
        JRST UCL5A
        MOVEI J,CLSYN(Q)
        JSP B,SIXTYC
        MOVEI J,CLN1(Q)
        JSP B,SIXTYC
        MOVEI J,CLN2(Q)
        JSP B,SIXTYC
        HLRE B,CLUSR(Q)
        AOJE B,UCL2
        MOVEI J,UNAME-1(B)
        MOVEM B,NUM(A)
        JSP B,SIXTYC
        MOVE B,NUM(A)
        MOVEI J,JNAME-1(B)
        JSP B,SIXTYC
UCL3:   MOVEI TT,[ASCIZ /->/]
        JSP B,MESPNT
        HRRE B,CLUSR(Q)
        AOJE B,UCL4
        MOVEI J,UNAME-1(B)
        MOVEM B,NUM(A)
        JSP B,SIXTYC
        MOVE B,NUM(A)
        MOVEI J,JNAME-1(B)
        JSP B,SIXTYC
UCL5:   JSP B,MESPCR
UCL5A:  AOBJN Q,UCL6
        JRST UCL7

UCL4:   MOVEI B,UCL5
        JRST .+2
UCL2:   MOVEI B,UCL3
        MOVEI J,[SIXBIT /CLOSED/]
SIXTYC: HRLI J,440600
        MOVEM J,DIRPT(A)
        PUSHJ P,OUTCS
        JRST SIXTYP
\f
; DIRECTORY LISTING ROUTINES FOR TTY

TTYFLD: MOVEI TT,[ASCIZ /
TTY UNAME  JNAME  CORE  TOTAL IDX
/]
        JSP B,MESPNT
        MOVSI Q,-NCT
TTYF1:  HRRE E,TTYSTS(Q)
        AOJE E,TTYF5    ;JUMP IF NOT IN USE
        MOVE E,TTYSTS(Q)
        MOVEI I,"T      ;TTY
        TLNN E,%TSCNS
         MOVEI I,"D     ;"DEVICE"
        PUSHJ P,OUTC
        HRRZ TT,Q
        JSP B,G2OPT
        HRRZS E
TTYF11: MOVEI J,UNAME(E)
        JSP B,SIXTYC
        MOVEI J,JNAME(E)
        JSP B,SIXTYC
        PUSHJ P,OUTCS
        MOVE TT,NMPGS(E)
        JSP B,G4SDPT
        PUSHJ P,OUTCS
        PUSHJ P,OUTCS
        MOVEM E,DIRPT(A)
        MOVE E,UTMPTR(E)
        SETZB B,TT
TTYF3:  SKIPE UNAME(B)
         CAME E,UTMPTR(B)
          JRST TTYF4
        ADD TT,NMPGS(B)
TTYF4:  ADDI B,LUBLK
        CAMGE B,USRHI
         JRST TTYF3
        JSP B,G4SDPT
        PUSHJ P,OUTCS
        PUSHJ P,OUTCS
        HRRZ TT,DIRPT(A)
        SKIPL SUPPRO(TT)
         JRST [ HRRZ TT,SUPPRO(TT) ? JRST .-1 ]
        IDIVI TT,LUBLK
        JSP B,GOPT
        JSP B,MESPCR
TTYF5:  AOBJN Q,TTYF1
TTYF99: MOVEI TT,[ASCIZ /FREE CORE  /]
        JSP B,MESPNT
        MOVE TT,MEMFR
        SUB TT,NCBCOM
        JSP B,GDPT
        MOVEI TT,[ASCIZ / OUT /]
        JSP B,MESPNT
        MOVE TT,NPGSWO
        JSP B,GDPT
        JSP B,MESPCR
        JRST UCL7
\f
SIXTYB: AOS Q
SIXTYA: PUSHJ P,OUTCS
        MOVEI I,440600+Q
        HRLM I,DIRPT(A)

SIXTYP: ILDB I,DIRPT(A)
        ADDI I,40
        PUSHJ P,OUTC
        MOVE I,DIRPT(A)
        TLNE I,770000
        JRST SIXTYP
        JRST (B)

MESP3S: SKIPA TT,[[ASCIZ /   /]]
MESPCR: MOVEI TT,[ASCIZ /
/]
MESPNT: HRLI TT,440700
        MOVEM TT,NUM(A)
        ILDB I,NUM(A)
        JUMPE I,(B)
        PUSHJ P,OUTC
        JRST .-3

OUTCS:  MOVEI I,40
OUTC:   SKIPL TT,SRN3(U) ;IF WANT 1 CHAR, RETURN WITH IT, SAVING ACS.
         JRST OUTC1     ;IF WANT WHOLE WORD, SEE IF WORD IS FULL.
OUTC2:  MOVEM E,SAVE(A)
        MOVEM Q,SAVQ(A)
        MOVEM B,SAVB(A)
        POP P,DIRPC(A)
        POPJ P,

OUTC1:  LSH TT,6
        ADDI TT,(I)     ;MERGE THIS CHAR (IN I) INTO WORD BEING ACCUMULATED.
        LSH TT,1
        MOVEM TT,SRN3(U)
        TLNE TT,774000  ;IF THE WORD IS FULL, RETURN TO DIRB.
         JRST OUTC2
        POPJ P,         ;ELSE POPJ FROM OUTC, TO GET MORE CHARS.
\f
;NUMERIC PRINTOUT ROUTINES FOR FILE DIRECTORIES.
;ALL CALLED WITH JSP B,.  ALL TAKE ARG IN TT.

;PRINT NUMBER IN TT IN DECIMAL, RIGHT-ADJUSTED IN FOUR COLUMNS.
G4SDPT: CAIL TT,1000.
         JRST GDPT              ;IF IT NEEDS 4 DIGITS, JUST PRINT IT.
        MOVEM TT,NUM(A)
        CAIL TT,100.            ;ELSE FIGURE OUT HOW MANY LEADING SPACES ARE NEEDED
         JRST G4SDP1
        CAIL TT,10.
         JRST G4SDP2
        PUSHJ P,OUTCS           ;AND PRINT THAT MANY.
G4SDP2: PUSHJ P,OUTCS
G4SDP1: PUSHJ P,OUTCS
        MOVE TT,NUM(A)
        JRST GDPT

;PRINT CONTENTS OF TT AS TWO OCTAL DIGITS.
G2OPT:  IDIVI TT,8
        JRST G2DPT2

;PRINT CONTENTS OF TT AS THREE DECIMAL DIGITS.
G3DPT:  IDIVI TT,100.
        MOVEM I,NUM(A)
        MOVEI I,"0(TT)
        PUSHJ P,OUTC
        MOVE TT,NUM(A)
G2DPT:  IDIVI TT,10.
G2DPT2: MOVEM I,NUM(A)
        MOVEI I,"0(TT)
        PUSHJ P,OUTC
        MOVE I,NUM(A)
        ADDI I,"0
        PUSHJ P,OUTC
        JRST (B)

;PRINT ARG IN TT IN DECIMAL USING AS MANY DIGITS AS IT NEEDS.
GDPT:   HRLI B,10.
        JRST GDPT0

;PRINT ARG IN TT IN OCTAL USING AS MANY DIGITS AS NECESSARY.
GOPT:   HRLI B,8
GDPT0:  MOVSS B
        SETZM ENDT(A)
        MOVEM TT,NUM(A)
GDPT1:  PUSH P,Q
         MOVE Q,TT
         IDIVI TT,(B)
         CAME TT,ENDT(A)
          JRST .-3
        MOVEM Q,ENDT(A)
        POP P,Q
        ADDI I,"0
        PUSHJ P,OUTC
        MOVE TT,NUM(A)
        CAME TT,ENDT(A)
         JRST GDPT1
        MOVSS B
        JRST (B)
\f
;ROUTINE TO CALL A DIRECTORY COROUTINE
DIRCHR: MOVE E,SAVE(A)
        MOVE B,SAVB(A)
        MOVE Q,SAVQ(A)
        JRST @DIRPC(A)

IFN NUNITS,[
BLKPNA: MOVEI J,1(I)
        LSH J,-1
        JRST BLKPNT+1

BLKPNN: LSH J,-1
BLKPNT: MOVEI TT,0
        MOVEI I,56
BLKPN2: MOVEI E,440500+I
        HRLM E,DIRPT(A)
BLKPN1: ILDB E,DIRPT(A)
        CAIN E,37
        JRST BLKPN3
        CAMN E,J
        AOS TT
        HLRZ E,DIRPT(A)
        TRNE E,760000
        JRST BLKPN1
        AOJA I,BLKPN2
BLKPN3: JUMPE J,GDPT
        MOVSI I,-23.
BLKPN4: MOVE E,@DIRPT(A)
        AOS I
        CAMN J,@DIRPT(A)
        JUMPE E,BLKPNA
        AOBJN I,BLKPN4
        JRST GDPT
];NUNITS
EBLK

UDUSR:  REPEAT NUDCH,-1 ;-1 => FREE, ELSE UTAPE # IF UTAPE DIR, ELSE 0.
UDUIND: BLOCK NUDCH     ;IF DIR CHANNEL IN USE, HOLDS JOB # OF JOB USING IT.

IRPS X,,DIRPC:DIRPT:NUM:ENDT:SAVB:SAVQ:UDSYSN:UUDPP:SAVE:
X:      REPEAT NUDCH,-1
        TERMIN
UDCSW:  -1
        0

DSKLST: BLOCK NUDCH     ;0 LISTING UTAPE 1 NON-DIR DEVICE
                                ;2 CORE LINK 3 2311
;NO BBLK SINCE VARIABLES ON NEXT PAGE
\f
SUBTTL UTC LEVEL INTERRUPT

;NO EBLK SINCE VARIABLES ON PREVIOUS PAGE

UTCPDP: -LUTCP,,UTCP-1  ;UTC-LEVEL PDL
UTCP:   BLOCK LUTCP
UTACS:  BLOCK 20        ;UTC-LEVEL AC SAVE

IFE KS10P,[     ; On the KS10 we can take advantage of the Unibus interrupt
                ; vectoring scheme to dispatch quicker, so this code was
                ; reorganized somewhat.
UTCBRK: 0
BBLK
IFN KL10P,[
        CONSO PI,1_<7-UTCCHN>
         JRST 4,.       ;HARDWARE BUG ALLEGEDLY FIXED
]
        MOVEM U,UTACS+U
        MOVEI U,UTACS
        BLT U,UTACS+U-1
        MOVE P,UTCPDP
IFN NUNITS,[
IFE NEWDTP,[
        CONSZ DC,6
         JRST PIPOS     ;HAS CHNL >1
PIPX:
]
IFN NEWDTP,[
        SKIPGE CUINT
         JRST UTCB0
]
];IFN NUNITS
IFN IMPP,[      ; See if it's an IMP interface interrupt
IFN KAIMP,[
        CONI IMP,TT
        LDB A,[000300,,TT]
        CAIE A,NETCHN
         JRST UTCB2
        TRNE TT,IMPLW+IMPHER+IMPERR+IMPOD+IMPID
]
IFN DMIMP,[
        CONI FI,TT
        TRNN TT,70      ;CHECK PIA
         JRST UTCB2     ;DO NOT PROCESS IF NO PIA
        TRNE TT,FILW+FIDOWN+FIWASD+FIOD+FIID
]
         JRST IMPINT
UTCB2:] ;IFN IMPP

IFN DC10P,[
        CONI DC0,TT
        TRNE TT,DPIRQC
         JRST QINT
]
IFE KA10P, CONO PI,020000+200_<-UTCCHN> ;BAG-BITING DEC LOSERS
IFN T300P,[
        SKIPE DSCDON
         JRST T3INT
];T300P
IFN RP10P,[
        CONI DPC,TT
        TRNE TT,7
         TRNN TT,10     ;IF BIT IS ON IT IS INTERRUPTING - LET QINT HAVE IT
          SKIPGE QGTBZY
           JRST QINT
]
IFN RH10P,[
        CONI DSK,TT
        TRNN TT,%HIDON+%HIATN   ;INTERRUPTING HARDWARILY
         SKIPGE QGTBZY          ;INTERRUPTING SOFTWARILY
          JRST QINT
]
IFN TM10P,[
        CONI MTC,A
        CONI MTS,C
        LDB TT,[030300,,A]
        CAIE TT,MTCCHN
         JRST UTCBK2
        TRNN C,100      ;IF NOT JOB DONE
         TRZ C,30000    ; THEN DON'T BELIEVE PAR ERR OF EOF
        TRNN A,400      ;IF NEXT UNIT NOT ENABLED
         TRZ C,2        ;THEN TURN OFF NEXT UNIT FLAG
        TRNE C,440302   ; UNIT HUNG, ILLEGAL, BAD TAPE (UGH), LOAD NEXT UNIT, JOB DONE
         JRST MGHBRK
UTCBK2: SKIPN MGTBZY    ; SOFT WARE CALL
         JRST MGSBRK
]
IFN NUNITS,     JRST UTCB0

POPRET:
IFN NUNITS,[
        MOVE A,TIME
        MOVEM A,LUTOTM
]
DSKEX:
IMPEX:
MGEX:   MOVSI U,UTACS
        BLT U,U
        JRST 12,@UTCBRK

] ;IFE KS10P

IFN KS10P,[

UTCBRK: 0                       ; Still EBLK'ed from previous page...
BBLK
        MOVEM U,UTACS+U
        MOVEI U,UTACS
        BLT U,UTACS+U-1
        MOVE P,UTCPDP
        CONO PI,020000+200_<-UTCCHN>    ;BAG-BITING DEC LOSERS
IFN KSIMP,[
        AOSN IMPBZY             ;-1 if IMP wants a jump-start
         PUSHJ P,IMPINT
]
IFN RH11P,[
        SKIPGE QGTBZY
         JRST QINT
] ;RH11P
IFN TM03S,[
        SKIPN MGTBZY
         JRST MGSBRK
]
IMPEX:
MGEX:
DSKEX:  MOVSI U,UTACS
        BLT U,U
        JRST 12,@UTCBRK

;;; Interrupt routines that are directly dispatched to by the KS10/Unibus
;;; interrupt kludge should do JSR UTCSAV as their very first instruction.
;;; The word before the JSR is expected to contain the interrupted PC.
;;; They should then exit through DSKEX just like everybody else.

EBLK
UTCSAV: 0
BBLK
        MOVEM U,UTACS+U
        MOVEI U,UTACS
        BLT U,UTACS+U-1
        MOVE P,UTCPDP
        MOVE U,UTCSAV
        MOVE TT,-2(U)
        MOVEM TT,UTCBRK
        JRST (U)

] ;KS10P
\f
$INSRT SYSJOB           ;SYSTEM JOB AND RELATED STUFF


SUBTTL DCHNTB AND DCHNTC

EBLK
CHSPUR: BLOCK 8         ;NUM OF SPURIOUS INTS PER CH (ZERO = DCHK)
BBLK

IFE KS10P,[     ; KS10 doesn't even pretend to have devices.

;***** DCHNTB *****
;4.9 = KNOWN DEVICE
;4.8 = HAS PIA 2
;4.7-4.4 PIA 2 SHIFT
;4.3-4.1 PIA 2 ACTIVE VALUE
;3.9 = PIA 2 MAY BE ZERO
;3.8 = HAS PIA 1
;3.7-3.4 PIA 1 SHIFT
;3.3-3.1 PIA 1 ACTIVE VALUE
;2.9 = PIA 1 MAY BE ZERO
;2.8 = ALLOW USER DATAI, BLKI
;2.7 DATAO, BLKO
;2.6 CONI, CONSO, CONSZ
;2.5 CONO
;2.4 SPECIAL KL10 DEVICE, BLKI/BLKO ARE DATAI/DATAO TO A SECOND DEVICE REGISTER
;1.6-1.1=N, IF NON ZERO: IGNORE DEV UNLESS CONI BIT N-1 IS ON
                ;(IF DSDEV PRESENT)

;***** DCHNTC *****
;4.9 = SUSPICIOUS DEVICE
;4.8 = FOUND CLOBBERED
;4.7 = SUSPECTED OF CAUSING SPURIOUS INTS
;4.6-4.4 = CHANNEL CAUSING INTS ON
;3.9-3.1 = SUSPICION COUNT
;2.9-1.1 = CONI

DCHNTB:
IFE KL10P,[
        400200+APRCHN,,240000   ;0 APR
        SETZ                    ;4 PI
]
IFN KL10P,[
        400200+APRCHN,,250000   ;0 APR (ALLOW DATAI, "BLKI", CONI)
        SETZ 010000             ;4 PI (ALLOW NOTHING)
]

DEFINE DCHENT D,W
LOC DCHNTB+D_-2
        W
        TERMIN

IFN KL10P,[
        DCHENT PAG,SETZ 240000          ;ALLOW DATAI, CONI, BUT NOT "BLKI"
        DCHENT CCA,SETZ                 ;ALLOW NOTHING
;XCTR of some of the instructions for these devices fails to relocate
;the address to user space, due to bugs in the hardware.  Flush 'em.
;       DCHENT TIM,SETZ 250000          ;ALLOW DATAI, "BLKI", CONI
;       DCHENT MTR,[400201,,250000]     ;INTERVAL TIMER PIA=1.  ALLOW DI,BI,CI
        DCHENT TIM,SETZ                 ;20 ALLOW NOTHING
        DCHENT MTR,SETZ                 ;24 ALLOW NOTHING
        DCHENT 30,SETZ                  ;30 RESERVED
]
IFN DSDP,       DCHENT DSDEV,[REPEAT 2,400200+DSDCHN,,440000]   ;20,24
IFN DL10P,[     DCHENT DLB,SETZ 240000                  ;60 DL10
                DCHENT DLC,[400200+TTYCHN,,240000]      ;64 DL10
]
IFN STKP,       DCHENT STK,[400200+LPTCHN,,440000]      ;70 STK
IFN PTRP,       DCHENT PTP,[400200+PCHCHN,,440000]      ;100 PTP
IFN PTRP,       DCHENT PTR,[400200+PTRCHN,,440000]      ;104 PTR
IFN NOTYS,      DCHENT TTY,[400200+TTYCHN,,40000]       ;120 TTY
IFN OLPTP,      DCHENT OLPT,[400200+LPTCHN,,440000]     ;124 OLPT
IFN 340P,       DCHENT DIS,[630600+DISCHN+SDCHN_9,,440001]      ;130 DIS
IFN E.SP,       DCHENT DIS,[400200+DISCHN,,440000]              ;130 E&S
IFN KL10P,      DCHENT DTE,[400200+IFE PDCLKP,[APRCHN].ELSE [TTYCHN],,240000] ;200 DTE20
IFN RP10P,      DCHENT DPC,[400200+DSKCHN,,440000]      ;250 DPC
IFN RH10P,      DCHENT DSK,[400200+DSKCHN,,040000]      ;270 RH10
IFN NUNITS,[
IFE NEWDTP,[
                DCHENT DC,[400000,,440000]      ;200 DC
                DCHENT UTC,[400200+UTCCHN,,440000]      ;210 UTC
                DCHENT UTS,[SETZ 40000]         ;214 UTS
]
IFN NEWDTP,[
                DCHENT DTC,[630600+UTCCHN+DCCHN_9.,,440000]     ;320
                DCHENT DTS,[SETZ 40000] ;324
]
]               ;END OF IFN NUNITS
IFN TM10P,[
                DCHENT MTC,[400230+MTCCHN,,440001]      ;340 MTC
                DCHENT MTS,[SETZ 40001]                 ;344 MTS
]
IFN MTYP,       DCHENT MTY,[400200+TTYCHN,,40000]       ;400 MORTON BOX
                                                        ;420 SPACEWAR CONSOLES
IFN DMIMP,      DCHENT FI,[400230+NETCHN,,400000]       ;424 DM IMP HARDWARE
IFN NDAP,       DCHENT 454,[400200,,760000]             ;454 D/A
IFN KAIMP,      DCHENT IMP,[400000,,400001]     ;460 AI-KA/ML-KA/MC-KL IMP
                                                ; HARDWARE THIS SAYS IMP
                                                ; HAS NO PIA BECAUSE IT
                                                ; CHANGES
IFN NLPTP,      DCHENT NLPT,[400200+LPTCHN,,440000]     ;464 NEW LPT
IFN CH10P,      DCHENT CHX,[400200+CHXCHN,,040000]      ;470 CHAOSNET
IFE KL10P,      DCHENT 500,[400000,,240000]             ;500 ML-KA, DM CALENDAR; AI-KA R CLK
IFN KL10P&PDCLKP,DCHENT 500,[400200+APRCHN,,240000]     ;500 MC-KL F CLK
IFN ARMP,       DCHENT TIPDEV,[400200+TIPBCH,,440000]   ;504 ARM TIP BREAK
IFE MCOND AIKA, DCHENT 510,[400000,,360000]             ;510 ANOTHER D/A??
                        ;DOES ANYONE KNOW WHAT DEVICE 510 IS??
IFN RBTCP,      DCHENT RBTCON,[400200+TABCHN,,440001]   ;514 ROBOT CONSOLE
IFN ARMP,       DCHENT 564,[400200,,440000]             ;564 ARM TACTILE SENSE
IFN OMXP,       DCHENT OMPX,[400200+OMPCHN,,440001]     ;570 OMX
IFN IMXP,       DCHENT MPX,[SETZ 40001]                 ;574 IMX
;Comment this out since the AI-KA one is no longer on the bus
;IFN TK10P,     DCHENT NTY,[400200+TTYCHN,,40000]       ;600 NTY
IFN NTYP,       DCHENT NTY,[400200+NTYCHN,,40000]       ;    NTY FOR 11 KLUDGE
IFN DPKPP,      DCHENT DPK,[400200+TTYCHN,,40000]       ;604 DATAPOINT KLUDGE
IFN DC10P,[
                DCHENT DC0,[400200+DSKCHN,,40000]       ;610 DC0
                DCHENT DC1,[400000,,]                   ;614 DC1
]
IFN VIDP,       DCHENT NVDX,[REPEAT 4,400200+NVDCHN,,440001]    ;620-634 BAT
IFN PLTP,       DCHENT PLT,[400200+PLTCHN,,440000]      ;654 PLT
                DCHENT 704,[400000,,440000]             ;704 ???
IFN HCLKP,[
                DCHENT CLK1,[400200,,240000]            ;710 CLK1
                DCHENT CLK2,[SETZ 40000]                ;714 CLK2
]
LOC DCHNTB+127.
EBLK
DCHNTC: BLOCK 128.
DCACS:  BLOCK 20        ;SAVE ACS
CCSDEV: 0               ;+ => SOME SUSPICIOUS DEVICES
BBLK
\f
DCHK:   0       ;TO CALL FROM DDT
        MOVEM 17,DCACS+17
        MOVEI 17,DCACS
        BLT 17,DCACS+16
        MOVEI J,0
        JSP E,SPUR
        SKIPN W
         AOS DCHK
        MOVEI 17,DCACS
        BLT 17,17
        JRST @DCHK

;CHECK FOR CLOBBERED DEVS, CALL WITH JSP E,
CHECK:  JSP H,DCSTUP
CHECK1: SKIPL TT,DCHNTB(I)
         JRST CHECK4    ;UNKNOWN DEVICE
IFN DSDP,[
        TRNN TT,77
         JRST CHECK2
        ANDI TT,77
        JSP H,DCCONI
        LSH B,-1(TT)
        JUMPGE B,CHECK4
        MOVE TT,DCHNTB(I)
]
CHECK2: JSP H,DCCONI
        TLNN TT,200     ;SKIP IF PI TO TEST
         JRST CHECK4
        LDB T,[250400,,TT]      ;GET SKIP
        MOVEI Q,7
        LSH Q,(T)
        AND B,Q
        LDB Q,[220300,,TT]      ;GET CHANNEL
        LSH Q,(T)
        CAME B,Q
         JRST CHECK5
CHECK3: LSH TT,-9       ;SHIFT TO PIA2
        JRST CHECK2

CHECK5: JUMPN B,CHECKL  ;JUMP IF NONZERO AND WRONG
        TRNE TT,400000  ;SKIP IF CAN NOT BE ZERO
         JRST CHECK3    ;ZERO OK
        JRST CHECKL

CHECK4: ADD A,[400,,]   ;INCREMENT DEVICE CODE
        AOBJN I,CHECK1
SPURCX: SKIPE C
         BUG PAUSE,[BITS ],OCT,C,[MAY BE STUCK ON IN I/O BUS]
        MOVSI T,SCLCK5
        SKIPE W         ;SKIP IF NO TROUBLE DETECTED
         IORM T,SUPCOR
        JRST (E)

DCSTUP: MOVE A,[CONI B] ;SET UP
        MOVEI W,0
        MOVNI C,1
        MOVSI I,-128.
        JRST (H)
\f
DCCONI: XCT A
        AND C,B
        SKIPL DCHNTC(I) ;SKIP IF DEVICE ALREADY SUSPICIOUS,SAVES FIRST SUSPICIOUS
        HRRM B,DCHNTC(I)        ;STORE AWAY CONI
        JRST (H)

CHECKL: JSP H,DCSAOS
        MOVSI T,600000  ;CLOB
        IORM T,DCHNTC(I)
        JRST CHECK3

DCSAOS: MOVE D,A        ;MAKE A CONO
        TDZ D,[40,,-1]
        SKIPL T,DCHNTB(I)       ;SKIP IF KNOWN DEV
        JRST DCSAS2     ;JUST RESET UNKNOWN TO ZERO
        TLNE T,200000   ;SKIP IF NO PIA2
        TLNE T,400      ;SKIP IF PIA2 CAN NOT BE ZERO
        JRST DCSAS1
        LDB TT,[330300,,T]      ;GET PIA2
        LDB T,[360400,,T]       ;GET PIA2 SHIFT
        LSH TT,(T)
        IOR D,TT                ;ADD CORRECT CANNEL TO CONO
        MOVE T,DCHNTB(I)        ;SKIP IF NO PIA1
DCSAS1: TLNE T,200      ;SKIP IF PIA1 CANNOT BE ZERO
        TRNE T,400000
        JRST DCSAS2
        LDB TT,[220300,,T]      ;GET P1A 1
        LDB T,[250400,,T]       ;GET PIA 1 SHIFT
        LSH TT,(T)              ;OR IN PIA 1
        IOR D,TT                ;ZAP
DCSAS2: XCT D
        HLRZ T,DCHNTC(I)
        TLNN T,300000
         AOS W  ;THIS MAY BE THE CAUSE OF OUR TROUBLES
        ANDI T,777
        AOS T
        AOS CCSDEV
        CAILE T,777
         SOJA T,[JRST 4,.+1]    ;LOSEY LOSEY
        DPB T,[221100,,DCHNTC(I)]
        JRST (H)

;CHANNEL IN J SPURIOUS INTERRUPT ON, CALL WITH JSP E,
SPUR:   SKIPL J
         CAIL J,10
          JRST 4,SPUR1
        AOS U,CHSPUR(J)
SPUR1:  MOVE U,E
        JSP E,CHECK
        MOVE E,U
        JSP H,DCSTUP
SPUR2:  SKIPGE TT,DCHNTB(I)
         JRST SPUR4
        JSP H,DCCONI
        JUMPGE B,SPUR4
        JSP H,DCSAOS
        MOVSI T,500000
        IORM T,DCHNTC(I)
        DPB J,[360300,,DCHNTC(I)]
SPUR4:  ADD A,[400,,]
        AOBJN I,SPUR2
        JRST SPURCX

] ;IFE KS10P
\f
IFN KS10P,[

SUBTTL KS10 UNIBUS

DEFINE UBINT VEC,-REST
.VEC.==<VEC>
IFN .VEC.&3, .ERR Bogus interrupt vector: VEC
.VEC.==.VEC./4
LOC .BAS.+.VEC.
        REST
IFG .VEC.-.MAX., .MAX.==.VEC.
IFL .VEC.-.MIN., .ERR Unibus interrupt table lossage.
TERMIN

;;;
;;; Interrupt table for Unibus Q.
;;;
UBAQIT:
.MIN.==53       ; Guess smallest interrupt vector on Unibus Q
.MAX.==.MIN.-1
.BAS.==.-.MIN.
UBAQIB==:.BAS.

UBINT PHVEC, JSR DSKBRK         ; RH11 FOR DISK

LOC .BAS.+.MAX.+1

;;;
;;; Interrupt table for Unibus I.
;;;
UBAIIT:
.MIN.==45       ; Guess smallest interrupt vector on Unibus I
.MAX.==.MIN.-1
.BAS.==.-.MIN.
UBAIIB==:.BAS.

IFN TM03S,[
UBINT %TMVEC, JSR MGHBRK        ;RH11 FOR TAPE
]

IFN DZ11P,[
REPEAT DZ11NB,[
UBINT 340+<10*.RPCNT>, CONC JSR DZ,\.RPCNT,RB   ; DZ receive
UBINT 344+<10*.RPCNT>, CONC JSR DZ,\.RPCNT,XB   ; DZ transmit
]];DZ11P

IFN KSIMP,[
UBINT %LHVEC, JSR IMPIBK        ;IMP Input side break
UBINT %LHVEC+4, JSR IMPOBK      ;IMP output side break
]

IFN CH11P,[
UBINT 270, JSR CHXBKH           ; Usual Chaosnet vector
UBINT 230, JSR CHXBKH           ; Except some interrupt here instead
];CH11P

LOC .BAS.+.MAX.+1

;;; Assignment of pages in Unibus pager for DMA devices.
;;; Note that these pages are 2000 PDP-10 words long (ITS sized) rather
;;; than 1000 (DEC sized).  Each page here thus occupies -two- locations in
;;; the Unibus pager.  There are 32. such pages on each Unibus.
;;;
;;; Unibus Q:
QUBPG==:5                       ; Chosen at random.

;;; Unibus I:
IFN TM03S,[
IUTPG==:5                       ;Magtape IO page. well, 5 worked last time
]

IFN KSIMP,[
IUIMPG==:6                      ;IMP Data transfer page
]

] ;KS10P
\f
SUBTTL OVERHEAD METERING ROUTINE

IFN KL10P,[

EBLK
;TABLE OF OVERHEAD REGIONS.  ENTRY IS SIXBITNAME,,PC ? COUNT
        0       ;COUNTS STUFF BEFORE FIRST OVHMTR MACRO
OVHTBL: OVHTAB
        'USR,,-1
        0       ;COUNTS USER-MODE PC'S
LOVHTB==.-OVHTBL

;COME HERE ON PI CHANNEL 1 EVERY 39 MILLISECONDS
OVHSVA: 0
OVHSVB: 0
OVHBRK: 0
BBLK
        CONO TIM,060000+3900.   ;CLEAR DONE
        EXCH T,OVHBRK           ;GET PC INTERRUPTED OUT OF
        TLNE T,%PSUSR           ;ONLY METER IF EXEC MODE
         JRST OVHBRX
        MOVEM A,OVHSVA
        MOVEM B,OVHSVB
        MOVSI A,-LOVHTB
OVHBR1: HRRZ B,OVHTBL(A)
        AOBJN A,.+1             ;2-WORD ENTRIES
        CAIG B,(T)              ;SKIP IF PC LIES IN PREVIOUS REGION
         AOBJN A,OVHBR1
        SKIPGE A                ;IN CASE T = 777777
         AOS OVHTBL-2(A)        ;AOS PREVIOUS REGION'S COUNT
        MOVE B,OVHSVB
        SKIPA A,OVHSVA
OVHBRX:  AOS OVHTBL+LOVHTB-1    ;AOS COUNT OF USER-MODE PC's
        EXCH T,OVHBRK
        JRST 12,@OVHBRK
];KL10P
\f
IFN KS10P,[
RDPCST=DATAI 14,                ;INSTRUCTIONS FOR PC SAMPLING TABLE
WRPCST=DATAO 14,

;TABLE OF OVERHEAD REGIONS.  ENTRY IS PC,,SIXBITNAME
OVHTB1: 0,,'LOW                 ;LOWER FENCE
        OVHTAB
        377777,,'USR            ;UPPER FENCE
LOVHTB==.-OVHTB1
REPEAT <1_<36.-<.LZ <LOVHTB-1>>>>-LOVHTB, 377777,,-1  ;PAD TO POWER OF TWO SIZE

EBLK

OVHTB2: BLOCK LOVHTB            ;CORRESPONDING COUNTS (LAST IS FOR USER MODE)

OVHCNT: 28.                     ;COUNTER TO SLOW THINGS DOWN TO CUT OVERHEAD

LOVHPC==100                     ;64 SAMPLES SHOULD BE ENOUGH
OVHPCS: BLOCK LOVHPC

BBLK

;CALCULATE OVERHEAD USING PC SAMPLE TABLE
;CLOBBERS A,B,C
OVHCLK: SOSL OVHCNT             ;TIME TO DO IT YET?
         JRST OVHCL9            ;NO, IGNORE THESE SAMPLES
        MOVEI A,28.             ;SEE ONLY ONE SAMPLE OUT OF EVERY 29 ON AVERAGE
        MOVEM A,OVHCNT          ;SO TIME SPENT IN THIS ROUTINE IS NOT EXCESSIVE
        RDPCST C                ;SEE HOW FULL THE PC SAMPLING TABLE IS
        HRLOI C,-OVHPCS-1(C)
        EQVI C,OVHPCS           ;AOBJN POINTER TO SAMPLES ACTUALLY TAKEN
        JUMPGE C,OVHCL9         ;NONE
        CAMGE C,[-LOVHPC,,OVHPCS]
         JRST OVHCL9            ;BOGUS AOBJN POINTER, MAYBE PCST NOT TURNED ON
OVHCL1: MOVE A,(C)              ;NEXT SAMPLED PC
        TLNE A,%PSUSR           ;ONLY SEARCH TABLE IF EXEC MODE
         JRST OVHCL8            ;ALL USER MODE PC'S ARE COUNTED IN LAST BUCKET
        HRLO A,A                ;-1 IN RH IS GREATER THAN ANY SIXBIT
        MOVEI B,1_<35.-<.LZ <LOVHTB-1>>>        ;HALF THE SIZE OF THE TABLE
REPEAT <36.-<.LZ <LOVHTB-1>>>,[ ;LOG SEARCH
        CAMG A,OVHTB1(B)        ;NOT CAMGE BECAUSE OF PADDING AT END
         SUBI B,1_<35.-.RPCNT-<.LZ <LOVHTB-1>>>
        ADDI B,1_<34.-.RPCNT-<.LZ <LOVHTB-1>>>
]
        LOC .-1                 ;OPTIMIZE OUT ADDI B,0
        AOSA OVHTB2(B)
OVHCL8:  AOS OVHTB2+LOVHTB-1
        AOBJN C,OVHCL1
OVHCL9: WRPCST [-LOVHPC,,OVHPCS]        ;TURN ON / RESTART PC SAMPLING
        POPJ P,
];KS10P

;HERE IS A TABLE OF REGISTERED 3-LETTER OVERHEAD REGION CODES

;ALC - ALLOCATE CORE PAGE FRAME
;CHx - CHAOSNET STUFF (VARIOUS VALUES OF x)
;FLT - MISCELLANEOUS FAULTS
;IMP - ARPANET INTERRUPT (NOT STYNET)
;LOW - LOW CORE, BEFORE FIRST OVHMTR MACRO & PCS IN UPPER HALF OF EXEC SPACE
;NET - ALL NETWORKS, ALL PI LEVELS, NOT OTHERWISE ACCOUNTED FOR
;PGF - PAGE FAULT
;PPI - PPIUM
;QIN - DISK INTERRUPT LOW LEVEL
;QSC - DISK INTERRUPT HIGH LEVEL, DISK SCHEDULER
;SC1 - SCHEDULER 1 - ENTRY
;SC2 - SCHEDULER 2 - SEARCH
;SC3 - SCHEDULER 3 - EXIT
;SC4 - SCHEDULER 4 - UNSWAPBLOCK
;SLW - SLOW CLOCK
;SWF - SWAP FIND NEW USER (SWAPOUT SCHEDULER)
;SWP - SWAP PAGE
;SWS - SWAP SCHEDULER
;SWU - SWAP USER
;TTI - TTY INPUT INTERRUPT LEVEL
;TTO - TTY OUTPUT INTERRUPT LEVEL
;TTY - MISC TTY CODE
;USR - USER MODE
;UUO - UUO LEVEL, MISCELLANEOUS ROUTINES, AND TOTAL MISCELLANY
;WS - WORKING SET & SWAP-BLOCK ENTRY CODE
\f
SUBTTL PC LSR TEST FEATURE

;CALLED BY PCLT MACRO
;WHICH ASSEMBLES
;SKIPE PCLDBM
;PUSHJ P,PCLTST

PCLTST: PUSH P,U
        MOVE U,PCLIDX
        MOVEM U,PCLHT
        MOVE U,USER
        CAME U,PCLUSR
        JRST POPUJ
PCLX:   CAIA    ;PATCH IN OTHER CHECKS (SHOULD JRST POPUJ TO IGNORE)
        MOVE U,USER     ;PATCH ROUTINE MAY CLOBBER U
        AOSN PCLNXT
        JRST PCLT1      ;FOUND PLACE, CAUSE PCLSR
        HRRZ U,-1(P)
        CAME U,PCLL
        JRST POPUJ      ;NOT MARK (NOT AT RIGHT LOCN)
        HRRO U,USER     ;4.9 U FLAG 
PCLT1:  PUSH P,A        ;COMPUTE HASH ADR OF RETURNS ON PDL
        PUSH P,B
        PUSH P,C
        HRREI A,-USRSTG(P)
        JUMPL A,PCLT1A  ;SYS JOB'S PDL?
        IDIVI A,LUBLK
        IMULI A,LUBLK
        MOVEI A,USRPDL(A)       ;GET START OF USERS PDL IN A
PCLT3:  HRRZ B,(A)
        JUMPE B,PCLT2
        CAIL B,HSYSCD
        JRST PCLT2
        HLRZ C,-1(B)
        TRZ C,37
        CAIE C,(PUSHJ P,)
        JRST PCLT2
        XOR B,PCLHT
        ROT B,1
        MOVEM B,PCLHT
PCLT2:  CAIGE A,-2-3(P)
        AOJA A,PCLT3
        MOVE A,PCLHT    ;COMPUTED HASH
        JUMPGE U,PCLT4  ;GOING TO PCLSR HERE, STORE HASH AS MARK FOR NEXT TIME
        CAME A,PCLHSH
        JRST PCLT5
        SKIPGE PCLDBM
        JRST PCLT6      ;IN HOLD MODE, PCLSR HERE
        SETOM PCLNXT    ;FOUND MARK, PCLSR NEXT TIME
PCLT5:  POP P,C
        POP P,B
        POP P,A
        JRST POPUJ

PCLT4:  MOVEM A,PCLHSH  ;STORE HASH FOR NEXT TIME
        HRRZ A,-3-1(P)
        MOVEM A,PCLL
PCLT6:  CONO PI,CLKOFF
        MOVE B,PCLDBM
        MOVEI A,%PIC.Z
        CAIN B,1        ;DON'T ^Z.
        IORM A,PIRQC(U)
        POP P,C
        POP P,B
        POP P,A
        POP P,U
        JRST PCLME

        PUSHJ P,PCLME1
PCLME:  PUSHJ P,UFLS
        JRST 4,.

PCLME1: PUSHJ P,PCLSR
        JFCL
        JRST POPJ1

PCLT1A: TRNE U,-1
         JRST 4,.
        JRST 4,.        ;TEMP MODIFY END CHECK IF WANT TO WIN FOR SYS JOB
\f
SUBTTL ILLUO NON-RELEVANT SYSTEM CALLS
IFE E.SP,[
        ADSTEP==URET
        ADCONT==URET
        ADWORD==URET
]
IFE 340P\E.SP,[
        ADSTAR==URET
        ADCLOS==URET
        ADSTOP==URET
        ADSTL==URET
]
IFE 340P,[
        ALTPEN==URET
        ANDIS==URET
]
IFE VIDP,[
        AVSCAN==ILUUO
        AVSTST==ILUUO
]
IFE IMXP,[
        APOTSET==ILUUO
]
IFE PDP6P,[
        AIPDP==ILUUO
]
IFE NMTCS,[
        AMTAPE==ILUUO
]

IFE ARMP,[
        AARMOV==ILUUO
        AARMRS==ILUUO
        AARMOF==ILUUO
]
IFE PTRP,[
        AFEED==CPOPJ
]
IFE RBTCP,[
        ARBTC==ILUUO
]
IFE NETP,[
        ANETIM==OPNL1   ;NO SUCH DEVICE ERROR FOR SYMBOLIC SYSTEM CALLS.
        ANETBL==OPNL1
        ANETHS==OPNL1
];NETP
IFE NCPP,[
        ANETAC==CPOPJ   ;MAKE OLD UUOS FAIL
        ANETIN==CPOPJ
];NCPP

IFE NUNITS,[
        AUBLAT==URET
        AUTNAM==URET
        AUINIT==URET
        AUDISM==URET
        AASSIGN==URET
        ADESIGN==URET
]

;Here generate the table for the BUG macro.  Note that entries for
;bugs in the initialization code will appear here also!  That's
;why we have the kludgey add 10
BUGTAB: BLOCK LBUGTB+10
LBUGT2==.-BUGTAB
        0               ;Marks end of table

CONSTANTS
HSYSCD::        ;HIGHEST SYSTEM CODE
\f
SUBTTL RANDOM STORAGE
EBLK

SCHHP:  SCHHB           ;PNTR TO SCHED HIST BUFFER
SCHHB:  BLOCK SSCHDB    ;SCHED HIST BUFFER
                        ;4.9 =1 EXEC
                        ;4.8 =1 QUANT TERMINATED BY PG FAULT
                        ;4.7-3.8  LENGTH OF RUN TIME IN 512 USEC UNITS
                        ;    MUST ACCOMODATE 150 MILLISECOND QUANTA
                        ;3.7-3.1 USER ("NUMERIC INDEX)
                        ;RH PC QUANT STARTED AT
SWPHTP: SWPHTB
SWPHTL==200
SWPHTB: BLOCK SWPHTL    ;SWAPPING HISTORY TABLE
                        ;4.9-4.8 EVENT: 0=START LOADING, 1=FINISH LOADING, 
                        ;               2=SWAP OUT, 3=SWAP BLOCK
                        ;4.7-3.9 WORKING SET SIZE MINUS ONE (0=0)
                        ;3.8-3.1 USER NUMBER
                        ;2.9-1.1 RH(TIME)
        BLOCK SWPHTL    ;CORRESPONDING UTRNTM

PGIHTP: PGIHTB
PGIHTL==200
PGIHTB: BLOCK PGIHTL    ;PAGE-IN HISTORY TABLE
                        ;4.9 1 IF JOB WAS LOADING
                        ;4.7-3.9 USER VIRTUAL PAGE NUMBER
                        ;3.8-3.1 USER NUMBER
                        ;2.9-1.1 RH(TIME)
        BLOCK PGIHTL    ;CORRESPONDING UTRNTM

IFN SCHBLN,[
SCHMNY: 0               ;0 DO FULL SCHEDULE, -1 NEXT "SCHEDULE" SHOULD LOOK IN SCHBTB
SCHBNJ: 0               ;NUMBER OF VALID ENTRIES IN SCHBTB
SCHBTB: BLOCK SCHBLN    ;RUNNABLE JOB BUFFER
SCHBPR: BLOCK SCHBLN    ;PRIORITIES OF THOSE
NSCHOV: 0               ;COUNT OF BUFFER OVERFLOWS
]
;TRANSLATION ENTRY _ T
;TRANLK(T) IS  MODE,,NEXT ENTRY
;MODE IS 0 IF ENTRY ON FREE LIST, ELSE NOT 0, AND
 ;BITS 3.1 => INPUT, 3.2 => OUTPUT, 4.9 => ATOMIC TRANSLATION (DON'T RETRANSLATE)
;NEXT-ENTRY IS -1 FOR NIL, ELSE IDX REL TRAN!X
;TRANID(T) THRU TRANIS(T) - FROM-NAMES
;TRANOD(T) THRU TRANOS(T) - TO-NAMES

TRANLK: REPEAT SIOMT,,,.RPCNT-1 ;GENERATE 1ST WDS, LINKED TOGETHER.
TRANID: BLOCK SIOMT
TRANI1: BLOCK SIOMT
TRANI2: BLOCK SIOMT
TRANIS: BLOCK SIOMT
TRANOD: BLOCK SIOMT
TRANO1: BLOCK SIOMT
TRANO2: BLOCK SIOMT
TRANOS: BLOCK SIOMT

TRANFL: SIOMT-1         ;TRANSL ENTRY FREE LIST.
TRNCNT: 0               ;NUM ENTRIES IN USE.
TRNREF: 0               ;NUM. READ-ONLY ACCESSES TO TRANSL LISTS.
TRANSW: -1              ;SWITCH FOR WRITE REF.
        0

IFE SCHBLN,     U0P:    0       ;PRIORITY OF BEST USER SO FAR

USER:   -1      ;USER # OF CURRENT LOSER
SYSL:   SYSB*2000
LITM:   0       ;LAST TIME SYS INCREASED CORE

SLGIV:  BLOCK 3 ;LOGIN

SETSLC: 0       ;SETLOC VARIABLES
SETSLQ: 0
SETSU:  -1

SWUNAM: 0       ;SYS WRITE VARIABLES
SWJNAM: 0
SWFN1:  0
SWFN2:  0
SWFN3:  0
SWMOD:  0
\f
DMON:   SIXBIT /DRAGON/
        -1      ;USER INDEX OF DEMON JOB

NQMFWR: 0       ;COUNT OF FILES WRITTEN ON .MAIL. - FOR MAILER DEMON TO HANG ON.
IFN XGP,[
NXGPFW: 0       ;COUNT OF FILES WRITTEN ON .XGPR. - FOR XGPSPL
]

;DEAMON VARIABLES
;VARIABLES FOR DEAMON CODE HACK
IFN DEMON,[

IFN TTLPTP,TPLFLG: 1    ;FLAG FOR TPL

DMTLL==4        ;LEGNTH OF DEAMON TABLE SLOT
NODEAM==20.     ;NUMBER OF SLOTS
DMLNG==NODEAM*DMTLL

DEMSW:  0
        0       ;MAIN PROG SWITCH FOR DEMON
REQCNT: 1       ;COUNT OF REQUEST'S FOR SYS JOB
DMTPTR: 0       ;POINTER FOR DEMSIG TO DEM TBL, AN INDEX INTO IT, TAKEN MODULO DMLNG
DMLSEX: -DMLNG,,0       ;POINTER TO DEAMON TABLE AOBJN
DEMCNT: <NODEAM.-1>     ;AMOUNT OF SLOTS REMAINING IN THE TABLE

DMBLK:  0
        0       ;SLOT FOR NON DEAMON LOAD VIA NUJBST

DMOBLK: SIXBIT /   SYS/
        SIXBIT /ATSIGN/
        0       ;BLOCK USED BY SYSTEM JOB TO CHECK OPEN

;DEAMON TABLE--CONSISTS OF SLOTS OF FOUR WORDS FOR EACH DEMON
;WORD 1 CONTAINS ITS SIXIT NAME
;WORD 2 CONTAINS THE USER INDEX,-1 IF LOADING, 0 IF DOWN
;WORD 3 2 QUANTITIES IN 18 BIT 2'S COMPLEMENT--
;LH ALWAYS > = 0, IF 0 ONLY TAKES EXPLICIT REQUESTS IN > 0 A REQUEST
;RH CONTAINS THE NUMBER OF REQUESTS PENDING FOR THE DEAMON
;FOR THE DEAMON WILL BE GENERATED EVERY 2 MINUTES
;WORD 4 CONTAINS THE TIME TILL THE NEXT IMPLICIT REQUEST WILL BE GENERATED.


DMTTBL:  SIXBIT /DEMSTR/
        0
        1       ;STARTUP DEAMON
        0
        
BLOCK <NODEAM-1>*DMTLL  
]
TIMOFF: -1      ;TIME SINCE MIDNIGHT IN HALF SECONDS ("TIME IN DSK FORMAT").
QDATE:  -1      ;DISK FORMAT DATE: -1 => SYSTEM DOESN'T KNOW DATE, ELSE
                ;BITS 3.1-3.5 HAVE DAY OF MONTH, 3.6-3.9 HAVE MONTH OF YEAR,
                ;4.1-4.7 HAVE YEAR MOD 100. .
QDATEI: -1      ;-1 => SYSTEM DOESN'T KNOW DATE, ELSE
                ;DATE AND TIME THE DATE AND TIME WERE FIRST DETERMINED, IN DSK FORMAT.
PDYTIM: -1      ;TIME SINCE BEGINNING OF YEAR IN HALF-SECONDS (BACKUP TO PDCLK)
FYEAR:  0       ;YEAR (E.G. 1969.)
PDTIME: 0       ;NON-ZERO => OFFSET FOR PDCLK
                ;WHEN SUBTRACTED FROM PDCLK DATAI GIVES # PD-UNITS SINCE
                ; BEGINNING OF YEAR
                ;ONE SECOND = 60. PD-UNITS
                ; Also contains similar offset for KS-10 clock in 60ths.
LPDTIM: -1      ;LAST PD CLK TIME, -1 IF PD CLK NOT RUNNING OR JUST PDSET'ED

SUPCOR: 0       ;CONTROLS SYS JOB, SEE SYSDTB, SCOR, ETC
                ;EACH BIT REQUESTS ONE FUNCTION IF SET.
SUPCOP: SCLDAT+IFN DEMON,[SCLDMN],,SCRCKS
                ;THIS WORD OR'D INTO SUPCOR EVERY SECOND.
SCKPHS: 0       ;USED FOR COUNTING EVERY SECOND 1/2 SECOND CLOCK
                ;TO SET SUPCOP BITS EVERY SECOND
SYSITM: 0       ;TIME SYS JOB LAST STARTED WAITING ON SUPCOR
LNETIM: 0       ;TIME AT WHICH NETWORK WAS LAST BROUGHT UP
RSWTIM: 1       ;Time (in DSK format) when last checked system resources.
\f
MXPARS==10.     ;MAX # PAR ERRS TO PRINT OUT
PARPG:  BLOCK 8 ;STORAGE OF PAGE MAP WHILE HACKING PARITY ERROR CHECK
PARCNT: 0       ;# OF PAR ERROR ENTRIES IN TABLE
PARCON: BLOCK MXPARS    ;CONTENTS OF BAD PARITY LOCATIONS
PARADR: BLOCK MXPARS    ;ADDRESSES OF BAD PARITY LOCATIONS
PARAND: -1              ;QND OF ALL BAD WORDS
PARIOR: 0               ;IOR OF ALL BAD WORDS
PARAAN: -1              ;AND F ALL BAD ADDRS
PARAOR: 0               ;IOR OF ALL BAD ADDRS
IFE KA10P,[
PARPFW: 0               ;PAGE FAIL WORD
PARERA: 0               ;ADDRESS OF PAR ERR
PARWRD: 0               ;BAD DATA
] ;IFE KA10P
IFN KL10P,[
PARRSN: 0               ;0 => PAR ERR PAGE FAULT IN PROG
                        ;-1 => PAR ERR INTERRUPT; NEEDN'T STOP
                        ;THE RUNNING JOB.
] ;KL10P
PARDIE: 0       ;-1 => FATAL PARITY ERROR
TPLSWP: 0       ;-1 => USE OLP FOR TPL
IFN PDP6P,[
PDP6UP: 0       ;0 => PDP6 IS DOWN. (AS USUAL)
]
IFN ECCMEM,[
IFE MCOND AIKA,[
ECCADR: 1,,777760       ;ECC HISTORY STARTS HERE
ECCLEN==16.             ;16 LOCATIONS OF ECC HISTORY
ECCIDX: 0               ;LAST LOCATION ACCESSED
]]
IFN TEN11P,[
TEN11F: 0       ;0 -> NORMAL
                ;-1 -> COMPLETELY IGNORE 10-11 INTERFACE
                ; 1 -> RESET 10-11 INTERFACE, OTHERWISE IGNORE
T11ERC: 0       ;COUNT OF CONTROL PAGE RAM ERRORS
T11CCN: 0       ;CORRECT CONTENTS
T11WCN: 0       ;WRONG CONTENTS
T11PG:  0       ;PAGE # INVOLVED
]
IFN N11TYS,[
TVBLAD: 17742   ;VIDEO BUFFER TO FLASH WHEN JOB RUNNING (PDP10 VIDEO BUFFER ADDR)
]
IFN DL10P,[
DL10F:  -1      ;-1 NORMAL, 0 => 11 DOWN
DL10HC: 0       .SEE TTDLBRK ;NUMBER OF LOOPS WHEN HUNG UP WAITING FOR 11 TO GOBBLE BUFFER
]
\f
DLSRCH: 0       ;-1 => DON'T RUN ANY USER BUT THE ONE ALREADY RUNNING
                ;(UNLESS WE TAKE A PAGE FAULT).
CPDLP:  -CPDLL,,LCPDL-1 ;CLOCK PDL POINTER
LCPDL:  BLOCK CPDLL     ;CLOCK INT LEVEL PDL

CLKBSW: 0               ;READ SWITCHES INTO HERE TO DECIDE WHETHER TO GO TO DDT.

CLROOT: SSLCKB          ;CLOCK QUEUE ROOT

SSLCKB: SCLKI           ;SLOW CLOCK RQ BLOCK
        .+2             .SEE CHA5CK ;OR 15SCLB
        JRST SSLCK

IFN CHAOSP,[
CHA5CK: 5*60.-SCLKI     ;5-SECOND CLOCK FOR CHAOS NET
        15SCLB          ;NOTE INITIAL TRIGGERING OF CLOCKS BELOW DELAYED AN EXTRA 5 SECONDS
        JRST CHA5CL
];CHAOSP

15SCLB: 15.*60.-SCLKI
        .+2             .SEE PRVCLB ;OR VSLCKB
        JRST 15SCLK

IFE SWPWSP,[
PRVCLB: NPVSEC*60.-15.*60.-SCLKI        ;PRIVILEDGED USER VARIABLE CHECK
        VSLCKB
        JRST PRVCLK
];SWPWSP

VSLCKB: 0       ;VERY SLOW CLOCK BLOCK
        CLINFB                  ;CAUSE SLOW CLOCK TICK SOON AFTER SYS COMES UP
        JRST VSSLCK

CLINFB: 377777,,-1      ;ABOUT 15 YEARS
        0
        BUG             ;?

IFN CCLKP,[
CCLKB:  0       ;FOR CHESS CLOCK HACK
        -1
        JRST RCCLK
CCLK1:  0
CCLK2:  0
]

IINTIC==60.     ;# TWO-MINUTE TICKS PER VERY VERY SLOW CLOCK TICK (2 HOURS)
IINCNT: 0       ;# TWO-MINUTE TICKS REMAINING UNTIL NEXT VERY VERY SLOW CLOCK TICK
.SEE VSCLK

IFN N11TYS,[
WHOCLB: 0       ;WHO LINE TIMER
        -1
        JRST WHOSET
]

UTTYS:  BLOCK MXCZS     ;RING BUFFER FOR JOBS TO BE STARTED
UTTYI:  UTTYS
UTTYO:  UTTYS
UTTYCT: 0

PCLDBM: 0       ;.NE. 0 ACTIVATE PC LSR DEBUG MODE
                        ;1 => ADVANCE PLACE WHERE PCLSR
                        ;2 => ADVANCE BUT DON'T ^Z.
                        ;- HOLD
PCLUSR: -1      ;USER PCLSR MODE ACTIVE FOR
PCLL:   0       ;PLACE WHERE LAST PCLSR TESTED
PCLHSH: 0       ;HASH OF RETURNS ON PDL AT LAST PLACE TRAPPED OUT OF
PCLNXT: -1      ;-1 => FROB NEXT TIME IN ADVANCE MODE
PCLHT:  0       ;TEMP
PCLIDX: 0       ;INITIALIZE PCLT TO THIS (SET TO LOOP COUNT IF NECESSARY)
\f
CORRNR: 0       ;LAST USER TO RUN CORE
SJSPG:  0       ;-1 => LAST FREE PG RESERVED FOR SYS JOB; DON'T GIVE IT TO ANYONE ELSE.
UTBFLF: 0       ;-1 SIGNAL TO TRY TO FLUSH I/O BLOCKS
UFDFLF: 0       ;-1 SIGNAL TO TRY TO FLUSH 2311 UFDS
CORCNT: 0
UFLSF:  0       ;FLAG FROM UFLS TO CLKBRK
CLKFL1: 0       ;FLAG COUNTER TO CONTROL CLOCK LEVEL 
SCHFLG: 0       ;SCHEDULE TIMER (DIVIDES 60 CPS)
27FCLK: 0       ;-1 IF FAST CLOCK SHOULD CALL TYP27S
SCITM:  0       ;SEE SYSEX, SYSDEC
LCLK1:  0
SYSCKP: -LTSTB,,TSTB    ;SYSTEM CHECKSUMS CHECKER POINTER
SYSPDP: -LSYSP,,SYSPDL-1        ;PDL POINTER FOR SYSTEM JOB
SYSPDL: BLOCK LSYSP     ;PDL FOR SYS JOB
IFN TPLP,TPLBUF:        BLOCK TPLBSZ    ;PSEUDO LPT BUFFER - MUST BE ABOVE SUACS
IFN TPLP\DEMON,TPLFNO:  SIXBIT /!/      ;UNIQUE TPL FIRST FILE NAME
SJCFF:  0       ;-1 WHEN SYS JOB IN PROCESS OF FLUSHING CORE
                        ;AVOIDS TIMING ERROR DUE TO HUSRAD NOT REALLY REFLECTING WHAT ITS GOING TO BE
SLSWPR: 0       ;STORE SYS JOB'S LSWPR WHILE HACKING UUOS

BBLK

IFN TPLP,       TPLFN:  2,,(SIXBIT /TPL/)
IFN KL10P,[
KLEBCC: 0 ? <1_23.>/<4*25./2>   ;EBOX COUNTER CONVERSION TO 4 USEC CONSTANT (FOR 25 MHZ)
                ;RESULT IS IN AC+2 AFTER DMUL AC,KLEBCC
KLMBCC:; 1 ? 110000,,           ;FOR CONVERTING AN MBOX COUNT TO THE TIME (IN EBOX UNITS)
                                ;IT SUPPOSEDLY AMOUNTS TO.
                                ;WE ASSUME 102.5 NANOSEC OD WAITING TIME PER MBOX CYCLE
                                ;THIS NUMBER IS 102.5/80.
                                ;DMUL AC,KLMBCC PUTS ANSWER IN AC+1, AC+2
                                ;WITH BINARY POINT BETWEEN THE WORDS.
        0 ? 0           ;M8538 MODIFIED SO EBOX COUNTER CONTINUES TO COUNT
                        ;DURING MBOX WAIT TIME, SO SET KLMBCC = ZERO.
EBLK

MTRUSR: -1              ;USER TO WHOM PERF CTR IS ASSIGNED
MTRJOB: -2              ;USER BEING MEASURED BY PERF CTR,
                        ;OR -1 => NULL JOB, OR -2 => ALL JOBS.

PAEON:  0               ;SELECTED PERF CTR ENABLE WORD
PAEOFF: 0               ;DISABLE THE PERF CTR (WHEN WRONG JOB IS RUNNING)
STPERF: 0 ? 0           ;VALUE OF PERF COUNTER AT START OF QUANTUM
STEBOX: 0 ? 0           ;VALUE OF EBOX COUNTER AT START OF QUANTUM
STMBOX: 0 ? 0           ;VALUE OF MBOX COUNTER AT START OF QUANTUM
] ;KL10P
IFE KL10P, EBLK
IFN TPLP,[
TPLFN1: 0
TPLFN2: 0
TPLFN3: 0
]
IFN NLPTP, NTNLPL: 0    ;NUMBER OF TIMES NLPT LOST PIA
VARIABLES


TSTB:   REPEAT CKNUM,CONC CK,\.RPCNT,
LTSTB==.-TSTB

CKSUMS: BLOCK CKNUM
CKXORS: BLOCK 36.       ;XOR OF ALL ADRS IN PURE AREAS IN SYS WITH CORRESP
                ;BIT SET (RH)
TCKXOR: BLOCK 36.       ;TEST XORS

SSYSCL==SSYS
SYSCLB==SSYSCL_-10.+IFN 1777&SSYSCL,1

IFE KA10P,[
AC1PTR: UUOACS  ;-> WHERE AC BLOCK 1 IS CURRENTLY LOADED FROM
] ;IFE KA10P

USRHI:  0       ;HIGHEST LOC USED FOR USER STORAGE
\f
SUBTTL LOCATIONS TO PATCH WHEN DEBUGGING

SYSDBG: 0       ;0 NORMAL TIMESHARING
                ;+ GIVE "ITS BEING DEBUGGED" MESSAGE
                ;-N ALSO ALLOW ONLY CONSOLE #N AND T00 TO CTRL/Z.
                ;-512.*N => ALLOW ONLY HOST N TO TELNET IN.
                ;-512.*N+M => ALLOW HOST N AND TTY M.
DMLLDF: -1      ;-1 => START DAEMONS AUTOMATICALLY, 0 DON'T.
IFN DEMON,DMNFLG: 1  ;1 => START DM-STYLE DAEMONS, 0 DON'T.

IFN NETP,NETUSW: 0 ;-1 => DON'T START UP A JOB IN ANSWER TO A CONNECT REQUEST
                ;FROM A HOST OTHER THAN OURSELVES

SYSCN:  SYSCON  ;NUMBER OF TTY TO RECEIVE SYSTEM CONSOLE OUTPUT.
                ;-1 TO THROW IT AWAY.  YOU CAN CHANGE THIS ANY TIME.

SUPPLG: 0       ;-1 => SUPPRESS LOGIN/LOGOUT MESSAGES ON SYSTEM CONSOLE.

IFE KS10P,[     ; KS has no lights.
MIPGDS: 0       ;-1 => DON'T LIGHT LIGHTS (KA HAS HARDWARE SWITCH, KL NEEDS
                ; THIS)
] ;IFE KS10P

IFN RH10P+RH11P,[
USFHLT: 0       ;-1 => HALT ON DISK UNSAFES AND OTHER BAD ERRORS
                ;0 => RETRY.  NOTE SET POSITIVE FOR 1/2 SECOND AFTER
                ; A RETRY TO AVOID LOOPING, DETECT SOLID ERRORS.
] ;RH10P+RH11P

.SEE USEHM      ;NONZERO => USE HIGH MOBY, ELSE ONLY 256K

.SEE USEMDM     ;NONZERO => USE MEDIUM MEMORY AS ADDITIONAL "LOW HALF" PAGES

IFN N11TYS,[
TT11P:  1       ;0 => PDP11-TTYS ARE NOT IN USE
                ;1 => SYSTEM SHOULD INITIALIZE THEM
                ;-1 => INITIALIZED AND IN USE
                ;TO BRING THE TV'S DOWN, ZEROING TT11P ISN'T ENOUGH
                ;EITHER DO WHAT TT11LS DOES, OR JUST SET SCR11D IN SUPCOR
                ;(THE LATTER MAY NOT TAKE EFFECT INSTANTLY, HOWEVER)
                ;TO BRING THE TV'S UP, JUST SET TT11P TO 1 AND WAIT 2 SECONDS
]

.SEE IMPUP      ;0 UP, -1 DOWN, 1 DOWN AND DON'T TRY TO BRING BACK UP

.SEE TEN11F     ;0 UP, -1 TOTALLY DOWN, 1 RESET PLEASE

.SEE DL10F      ;0 PDP11 DOWN, -1 UP

.SEE PDP6UP     ;0 PDP6 DOWN, -1 UP

.SEE LASTGC     ;NAME OF LAST DISK DIRECTORY GARBAGE COLLECTED


SUBTTL SWAPPING ALGORITHM CONTROL SWITCHES

IFE SWPWSP,[    ;THESE AREN'T LOOKED AT IN SWPWSP SYSTEM
ENSWSC: SWBLK   ;ENABLE CALLING OF SWSCD FROM 15 SEC CLOCK
ENUPC:  1-SWBLK ;ENABLE USER-PC PAGE OF RUNNING USER NOT BE SWAPPED OUT
ENPZRO: SWBLK   ;ENABLE PAGE-ZERO OF RUNNING USER NOT BE SWAPPED OUT
ENSWBK: SWBLK   ;ENABLE SWPNX1 TO SWAP BLOCK A USER
ENPVCL: 1-SWBLK ;ENABLE PRVCLK ROUTINE
ENPREE: 1-SWBLK ;ENABLE PREEMPTION ON PAGE SWAP IN (SEE QSWI1)
ENAGE:  1-SWBLK ;ENABLE AGE BITS TO ABORT SWAP OUT IF PAGE IS USED
];SWPWSP
AGERTE: 8       ;NUMBER OF PAGES TO AGE EACH 1/2 SECOND.
                ;IN A 512K SYSTEM, LAP TIME IS ABOUT 200/AGERTE SECONDS.
\f
SUBTTL SYSTEM LOCKS

CIRPSW: -1      ;CIRCULAR POINTER SWITCH
        0

MEMFRZ: -1      ;MEMORY FROZE
        0

CASW:   -1      ;CORE ALLOCATE INTERLOCK SWITCH (REQUESTS TO CORE JOB)
        0

SHUTLK: -1      ;LOCK VAR FOR SHUTDN
        0       ;USED TO TELL WHO CAUSED SYS DOWN

TREESW: -1      ;LOCK MANIPULATION OF JOB TREE STRUCTURE
        0       ;ATTACH, DETACH, DISOWN, REOWN ALL LOCK.

CUSER:  -1      ;CORE ALLOCATOR USER
        0       ;DUMMY CORE ALOC USE VAR

ARDFSW: -1      ;LOCK VAR FOR .REDEF
        0

IFN 340P\E.SP,[
DISUSR: -1      ;340 USER
        0       ;DUMMY 340 USE VAR
]

IFN CODP,[
CODUSR: -1      ;CODE SENDER
CODUSE: -1
]

IFN PLTP,[
PLTUSR: -1      ;PLOTTER USER
PLTUSE: -1
]

IFN LPTP\TTLPTP,[
LPTUSR: -1      ;LINE PRINTER USER
LPTUSE: -1
]
IFG LPTP-1,[
OLPUSR: -1
OLPUSE: -1
]
IFN LPTP,[
  IFE LPTP-1,[
    IFN NLPTP,[
        NLUSR==LPTUSR
        NLUSE==LPTUSE
    ]
    IFN OLPTP,[
        OLUSR==LPTUSR
        OLUSE==LPTUSE
    ]
  ]
  IFG LPTP-1,[
    OLUSR==OLPUSR
    OLUSE==OLPUSE
    NLUSR==LPTUSR
    NLUSE==LPTUSE
  ]
]

IFN PTRP,[
PTPUSR: -1
PTPUSE: -1

PTRUSR: -1
PTRUSE: -1
]

IFN VIDP,[
NVDUSR: -1
NVDUSE: -1
]

IFN PDP6P,[
PDPUSR: -1      ;PDP-6 USER
PDPUSE: -1
PDPISR: -1      ;PDP6 AS INFERIOR (INTS ON IO CHANNEL)
PDPISE: -1      ;PDP6 USE VAR
]

IFN TABP,[
TABUSR: -1      ;TABLET USER
TABUSE: -1
]

IFN STKP,[
        STKUSR: -1
        STKUSE: -1
]
\f
TIME:   0       ;TIME SINCE SYSTEM START IN 1/30'THS
SUSRS:  0       ;NUMBER USERS ON SYS
RVVTIM: 0       ;VALUE OF TIME WHEN SYSTEM WAS LAST REVIVED FROM A CRASH
USRRCE: BLOCK NCT+1     ;USER RESOURCE +1 FOR DISOWNED JOBS
SYSRCE: 0       ;SYS JOB RESOURCE
SLOADU: 0       ;100. * <EFFECTIVE # OF COMPETING USERS>, IN FIXED POINT.
RNABLU: 0       ;RUNNABLE USERS
NPGWTU: 0       ;NUMBER OF JOBS CURRENTLY WAITING FOR A PAGE
LOUTIM: 0       ;TOTAL TIME USED BY LOGGED OUT USERS
UMASTER:        -1      ;INDEX OF MASTER USER
SWRCE:  BLOCK NCT+2     ;SWAP SCHED RESOURCE
SWIPRQ: 0       ;TOTAL # SWAP IN REQUESTS
SHUTDN: 0       ;"TIME" SYS WILL DIE, 0 IF NOT DYING, -1 IF DEAD
DEDTIM: 0       ;TIME TILL DEATH AFTER NEXT CLK QUEUE INT
                ; < 0 => SYSTEM ACTUALLY DOWN (CHECKED BY ^Z, NUJBST, %OPLIV JOBS)
DTHTIM: 0       ;TIME SYSTEM DIED
DEDBLK: 0
        -1
        JRST DEATHZ

ATRNJN: 0       ;JNAME OF LAST JOB TO DO A .TRANAD OR .TRANDL
                ;(SO I CAN SEE IF THEY'RE USED AT ALL).

IFN DZ11P,[
DZXSPR: 0       ;Count of spurious DZ-11 transmitter interrupts.
DZRSPR: 0       ;Count of spurious DZ-11 receiver interrupts.
];DZ11P

NCORRQ: 0       ;NUMBER CORE RQS HERE SO TRANSFERRED TO PEEK
NCBCOM: 0       ;NUMBER CORE BLOCKS COMMITTED TO CORGP

NQDE:   BLOCK NQS       ;NUMBER OF 2314 DATA ERRORS
NQHE:   BLOCK NQS       ;NUMBER OF 2314 HARDWARE ERRORS
        BLOCK 1         ;NQSE-1 COUNTS SPUR INTS WHILE NO XFER (QSDU -1)
NQSE:   BLOCK NQS       ;NUMBER OF SPURIOUS 2314 ERROR INTERRUPTS
NQCMPE: BLOCK NQS       ;NUMBER OF 2314 READ/COMPARE ERRORS
NQWDE:  BLOCK NQS       ;# DATA ERRS ON WRITE
NQRDE:  BLOCK NQS       ;# DATA ERRS ON READS
NIRSWE: 0       ;# IRRCV ERRS ON SWAPPING XFERS
QIRRCV: 0       ;IRRECOVERABLE DISK ERRORS
QIRCBK: 0       ;BLOCK # W/ IRRCV ERROR
QIRUNT: 0       ;UNIT OF ABOVE
NQWRE:  0       ;# WRITE ERRS RCC OK
NQWIRE: 0       ;# WRITE ERRS RCC LOST
NWXFR:  0       ;NUMBER WRITE TRANSFERS (FILE, DIR, ETC.)
NRXFR:  0       ;NUMBER READ
NSWXFR: 0       ;NUMBER WRITE SWAPS
NSRXFR: 0       ;NUMBER READ SWAPS

;DON'T CHANGE ORDER .SEE MEMTYP
PARERR: 0                       ;COUNT OF CORE PARITY ERRORS
NXMERR: 0                       ;COUNT OF NXMS
IFE KA10P,      BPFERR: 0       ;COUNT OF BAD PAGE FAILS
PARPC:  0                       ;PC ON CORE PARITY INTERRUPT
NXMPC:  0                       ;PC ON NXM
IFE KA10P,      BPFPC:  0       ;PC ON BAD PAGE FAIL
PARUSR: -1                      ;USER ON PAR ERR
NXMUSR: -1                      ;USER ON NXM
IFE KA10P,      BPFUSR: -1      ;USER ON BAD PAGE FAIL
IFE KA10P,      BPFPFW: 0       ;PFW ON BAD PAGE FAIL

IFN KS10P,[
ECCERR: 0       ;COUNT OF ECC CORRECTED ERRORS LOGGED
ECCERA: 0       ;MEMORY STATUS AND ADDRESS OF MOST RECENT
ECCAND: -1      ;AND OF ALL ERRORS
ECCIOR: 0       ;IOR OF ALL ERRORS
] ;IFN KS10P

IFN DPKPP,      NDPKPE: 0       ;# PARITY ERRS FROM DATAPOINT KLUDGE

SNMPGS: 0       ;SYSTEM, NUMBER OF VIRTUAL USER PAGES
SNSWPG: 0       ;SYS, NUM OF SWAPPED OUT VIR. PGS

USRTM1: 0       ;4USEC TICKS USED BY USERS SINCE LAST (1/2 SEC) UPDATE TO USRTIM
USRTIM: 0       ;TIME USED BY ALL USERS 1 SEC UNITS
NULTM1: 0       ;4USEC TICKS USED BY NULJOB SINCE LAST (1/2 SEC) UPDATE TO NULTM3
NULTM3: 0       ;NUMBER OF SECONDS USED BY NULJOB
NULTIM: 0       ;TIME USED BY NULL JOB (60'THS) - OBSOLETE BUT STILL MAINTAINED
IFN KL10P,[
NULEBC: 0 ? 0   ;EBOX COUNT WHEN NULL JOB ENTERED
NULMBC: 0 ? 0   ;MBOX COUNT WHEN NULL JOB ENTERED
NULPRF: 0 ? 0   ;PERF COUNT WHEN NULL JOB ENTERED
] ;KL10P
IFE KA10P,[
PFAILF: 0       ; KL: -1 => ENTRY TO CLOCK LEVEL WAS VIA PFAIL
                ;     -2 => VIA INTPFL
                ; KS: -1 => BOTH CASES
] ;IFE KA10P
LOSTM1: 0       ;4USEC TICKS LOST SINCE LAST (1/2 SEC) UPDATE TO LOSTIM
LOSTIM: 0       ;SECONDS OF LOST TIME (ALL OTHERWISE RUNNABLE JOBS WAITING FOR PAGES)
IDLTM1: 0       ;4 USEC TICKS IDLE SINCE LAST (1/2 SEC) UPDATE TO IDLTIM
IDLTIM: 0       ;SECONDS OF IDLE TIME (NO JOBS WANT TO RUN)
LOSRCE: 0       ;USRRCE WORD FOR LOST TIME
IDLRCE: 0       ;USRRCE WORD FOR IDLE TIME

UREALT: -1      ;RH=INDEX OF THE REAL TIME USER
                ;LH=0=> THIS USER HAS HIGHEST PRIORITY
                ;LH>0=> USER NOT IN HIGH PRIORITY PHASE
                ;LH<0=> FACILITY IDLE
INFORM [HIGHEST USED]\<.-1>
\fSUBTTL USER VARIABLES

;ONE COPY FOR EACH PROCEDURE
;FOR KL AND KS, THIS IS THE UPT

IFN KL10P,[
DEFINE KLUPT N,NAME/            ;CHECKS "HARD-WIRED" UPT LOCATIONS
IFN .-USRSTG-<N>,[
.ERR "NAME" LOST IN UPT
LOC USRSTG+<N>
]
TERMIN
] ;KL10P

IFE KL10P,[
DEFINE KLUPT N,NAME/
TERMIN
] ;IFE KL10P

IFN KL10P, LOC <.+777>&-1000    ;KL UPT MUST START AT HARDWARE PAGE BOUNDARY

IFN KS10P, LOC <.+7>&-10        ; KS UPT must be 0 mod 8 (see UUOPCW)

USRSTG:: KLUPT 0,;USER PAGE MAP

UPGMP:  BLOCK NUVPG/2   ;PAGE MAP STORAGE (PROGRAMS UP TO NUVPG LONG)
;               2.9-2.8 ACCESS RIGHTS
;                       00      NO ACCESS (BY SOFTWARE CONVENTION, 1.2-1.1
;                               HAVE THE "REAL" ACCESS BITS, WHICH MAY BE 00,
;                               BUT MAY NOT, E.G. FOR A SWAPPED OUT PAGE).
;                       01      READ ONLY
;                       10      READ/WRITE/FIRST
;                       11      READ/WRITE
.SEE PMCSHM     ;CACHE BIT
.SEE PMAGEM     ;AGE BITS
.SEE PMRCM      ;LOW N BITS ARE PHYSICAL CORE PAGE NUMBER (IN 1K PAGES)
UPGCP:  BLOCK NUVPG/2   ;CIRCULAR POINTERS (CORRESPONDS 1-1 WITH UPGMP)
;               IF -1, ABSOLUTE PAGE, NOT LINKED.  OTHERWISE:
;               2.9     IF 0:
;                       2.8-1.9 USER INDEX
;                       1.8-1.1 PAGE NUMBER IN THAT USER'S UPGCP
;                       IF 1:
;                       2.8     IF 0:
;                               2.7-1.1 LINK TO MMP TABLE
;                               IF 1:
;                               2.7-1.1 LINK TO MEM PNT TABLE
UMAPS:  0       ;USER MAP STATUS
        .SEE %UM
UDBR1A==UPGMP   ;ADDRESS TO PUT IN DBR1
UDBR2A==UPGMP+<NUVPG/4> ;ADDR FOR DBR2
UPGCPH==UPGCP+<NUVPG/4> ;ADDR OF HIGH HALF OF CIRC PNTRS

TTYTBL: 0       ;TTY ASSIGNED THIS USER OR INDICATION THAT THERE IS NONE
%TBNOT==400000  ;4.9 DOES NOT HAVE TTY NOW
%TBNVR==200000  ;4.8 IF JOB DOESN'T HAVE TTY, OPENS SHOULD FAIL.
%TBINT==100000  ;4.7 IF JOB DOESN'T HAVE TTY, ATTEMPT TO USE TTY SHOULD INTERRUPT.
                ;JOB CAN SET BITS 4.8 AND 4.7.
%TBWAT==40000   ;4.6 IF 1, %TBINT AND %TBNVR ARE OVERRIDDEN AND TTY USE ATTEMPTS
                ;    ALWAYS HANG. SET BY DDT FOR $P, CLEARED BY ^P. ONLY SUPERIOR CAN SET.
%TBDTY==010000  ;4.4 TTY TAKEN FROM --ME--.  WHEN GIVEN BACK,
                 ;DON'T PASS IT ON TO MY INFERIOR.
%TBOUT==004000  ;4.3 ALLOW THIS JOB TO OUTPUT WHETHER OWNS TTY OR NOT
%TBINF==002000  ;4.2 ALLOW MY INFERIORS TO OUTPUT IF THEY HAVE %TBOUT.
%TBOIG==001000  ;4.1 IGNORE MY OUTPUT
%TBIIN==000400  ;3.9 INTERRUPT IF I TRY TO DO INPUT
$TBECL==220600  ;3-6-3.1 # ECHO LINES IF I DONT HAVE DISPLAY
                ;RH USER NUM GAVE TTY AWAY TO OR TTY NUM IF HAS IT
%TBCLR==410077  ;CLEAR THESE BITS IN TTYTBL OF A JOB RECEIVING THE TTY

TTSTSV: BLOCK 3 ;JOB'S SAVED TTYST1,TTYST2,TTYSTS, WHEN JOB DOESN'T HAVE THE TTY.

NMPGS:  0       ;NUMBER OF NON-ABSOLUTE PAGES (INCLUDES PURE)
NSWPGS: 0       ;NUMBER SWAPPED OUT PAGES (AOSED FOR EACH USER OF SHARED PAGE SWAPPED OUT)
HUSRAD: 0       ;MEM ADR OF PAGE ABOVE HIGHEST THAT EXISTS (MAX 1,,0)
UPC:    0       ;USER PC STORAGE
LUBTM:  0       ;TIME LAST UNBLOCKED (FOR IDENTIFYING INACTIVE JOBS)
JBI:    -1      ;JOB DEVICE INDEX. IF NOT -1, THIS JOB IS A JOB-DEVICE,
                ;AND JBI HAS INDEX INTO JOB DEVICE TABLES.
\f
UPGML:          ;USER PAGE MAP LOAD (EIGHT WORDS FOR LPM AND SPM INSTRUCTIONS)
IFE KS10P,[     ; KS10 version given below.
                UPJPC:  0       ;JPC.  KA HAS FAULT ADDRESS IN LH.
IFE KL10P,      UPOPC:  0       ;OLD PC FLAGS,,OPC (UNUSED ON KL-10)
                UPMAR:  0,,0    ;MAR ADDRESS AND CONDITION
                                ;FOR KA-10:
                                ;       3.3     0=EXEC, 1=USER
                                ;       3.2-3.1 MAR CONDITION:
                                ;               0       NEVER
                                ;               1       INSTR FETCH
                                ;               2       WRITE
                                ;               3       ALWAYS
                                ;       2.9-1.1 VIRTUAL ADDRESS
                                ;FOR KL-10:
                                ;       3.9-3.7 ADDRESS BREAK CONDITIONS:
                                ;               3.9     FETCH
                                ;               3.8     READ
                                ;               3.7     WRITE
                                ;       3.6     0=EXEC, 1=USER
                                ;       3.5-1.1 VIRTUAL ADDRESS
IFE KL10P,      UPQUAN: EXPGNG+1,,0             ;F.S. QUAN AND FAULT BITS
IFN KL10P,      UPFW:   0                       ;PAGE FAIL WORD
IFE KL10P,DBL==100_1
IFN KL10P,DBL==0
                UPDBR1: DBL,,UPGMP              ;DBR1
                UPDBR2: DBL,,UPGMP+100          ;DBR2
IFE KL10P,      UPDBR3: DBL,,EXEUMP             ;DBR3
IFE KL10P,      UPACP:  1040,,UUOACS            ;B KEY,C KEY,,AC POINTER
] ;IFE KS10P

IFN KS10P,[
UPDBR1: UPGMP           ; DBR1
UPDBR2: UPGMP+100       ; DBR2
UPQUAN: 0               ; Runtime counter
UPJPC:  0               ; User mode JPC if microcode supports
UPEJPC: 0               ; Exec mode JPC if microcode supports
] ;KS10P

UPGMLE::                                ;END OF PAGE MAP (+1)

IFN KL10P,[
        KLUPT 420,      ;RESERVED UPT 420
UPT420: 0
        KLUPT 421,      ;TRAP 1 INSN    ;ARITHMETIC OVERFLOW
TR1INS: JSR ILLTRP       ;FOR ITS-STYLE INTERRUPT, CONTAINS 0,,%PIARO
        KLUPT 422,      ;TRAP 2 INSN    ;PDL OVERFLOW
TR2INS: JSR ILLTRP       ;SYS JOB SHOULDN'T OVERFLOW    ;FOR ITS-STYLE, 0,,%PIPDL
        KLUPT 423,      ;TRAP 3 INSN    ;USED FOR ONE-PROCEED
TR3INS: JSR ILLTRP       ;SYS JOB SHOULDN'T ONE-PROCEED ;FOR ITS-STYLE, 0,,%PI1PR
        KLUPT 424,      ;MUUO DEPOSIT LOCATION
SV40::
MUUODP: 0       .SEE FORTY
        KLUPT 425,      ;MUUO OLD PC STORAGE
SUUOH::
XUUOH:  0
        KLUPT 426,      ;MUUO PAGING AND CONTEXT WORD
MUUOCX: 0
        KLUPT 427,      ;RESERVED UPT 427
UPT427: 0
        KLUPT 430,      ;MUUO NEW PC WORDS
MUUOKN: %PSPCU,,UUOH0           ;FOR OTHER JOBS, MUUOEX (A JRST 4,).
MUUOKT: %PSPCU,,MUUOEX          ;NO JOB SHOULD EVER TRAP IN EXEC MODE.
MUUOSN: %PSPCU,,MUUOEX          ;NO JOB SHOULD EVER RUN IN SUPERV. STATE.
MUUOST: %PSPCU,,MUUOEX          ;..
MUUOCN: %PSPCU,,UUOH0           ;NORMAL UUOS
MUUOCT: %PSPCU,,MUUOTR          ;UUOS AS TRAP INSN
MUUOPN: %PSPCU,,UUOH0           ;PUBLIC MODE IDENTICAL TO CONCEALED MODE,
MUUOPT: %PSPCU,,MUUOTR          ; ALTHOUGH IT'S A SCREW FOR A LOSER TO BECOME PUBLIC
]               ;END OF IFN KL10P
\f
IFN KS10P,[
DEFINE KSUPT UPTNAM
IFN .-USRSTG-<UPTNAM>,[
.ERR UPTNAM lost in UPT
LOC USRSTG+<UPTNAM>
]
TERMIN

UPFW:   0       ; Saved page fail word from last fault.  Copied from EPTPFW
                ; at time of fault usually.

KSUPT UPTTR1
TR1INS: JSR ILLTRP

KSUPT UPTTR2
TR2INS: JSR ILLTRP

KSUPT UPTTR3
TR3INS: JSR ILLTRP

KSUPT UPTUUO
SV40::
MUUODP: 0

KSUPT UPTUPC
SUUOH::
XUUOH:  0

KSUPT UPTUCX
MUUOCX: 0

KSUPT 427
UPT427: 0

KSUPT UPTUEN
MUUOKN: %PSPCU,,UUOH0   ;UUO in Exec mode new PC
                        ;For other jobs: %PSPCU,,MUUOEX
KSUPT UPTUET
MUUOKT: %PSPCU,,MUUOEX  ;UUO as trap instruction in Exec mode new PC

KSUPT UPT1PO            ;PC saved here after one-proceed
1PROPC: 0

KSUPT UPT1PN            ;One-proceed sets PC to this
1PRNPC: %PSPCU,,ONEPRO

KSUPT UPTUUN
MUUOCN: %PSPCU,,UUOH0   ;Normal UUO new PC

KSUPT UPTUUT
MUUOCT: %PSPCU,,MUUOTR  ;UUO as trap instruction new PC

EXPUNGE KSUPT

] ;KS10P
\f
UUOACS: BLOCK 20
AC0S:   BLOCK 15        ;SWAP OUT AC S
AC15S:  0
AC16S:  0
AC17S:  0

IFN KL10P,[
;KLUPT 500,     ;PAGE FAIL WORD STORAGE         ;MICROCODE MOD PUTS
;KLUPT 501,     ;PAGE FAIL OLD PC STORAGE       ; THESE LOCATIONS IN
;KLUPT 502,     ;PAGE FAIL NEW PC               ; THE EPT FOR ITS
]               ;END OF IFN KL10P

UUO::   ;THE FOLLOWING LOCATIONS (UP TO SUEXND) ARE SWAPPED IN & OUT OF
        ;UEXIT ETC. WITH THE USER 
SUEXIT: JRST 2,@XUUOH   ;USER UUO EXIT INS
SCLUSV: MOVEM U,AC17S   ;CLOCK U SAVE

IFN KA10P,[
SUUOH:  0       ;C(@41) (ABSOLUTE)
SUEXND::

SV40:   0       ;C(40) WHEN USER OUT (SEE SWITCH)
] ;KA10P

IFE KA10P,[
SCLCXS: DATAI PAG,CLCX  ;CLOCK SAVE OF CONTEXT
SUEXND::
] ;IFE KA10P

IFN <SUEXND-UUO>-<UEXND-UEXIT>, .ERR SUEXIT BLOCK LOST

IFE KA10P,[
CLCX:   0       ;SAVED CONTEXT (DATAI PAG,) AT CLKBRK AND PFAIL
] ;IFE KA10P

IFN KL10P,[
KLUPT 504,      ;EBOX COUNT
EBOXCT: 0 ? 0   ;NUMBER OF EBOX TICKS (25 MHZ) OVER 2 LEFT 12. THAT EBOX
                ;RAN FOR THIS USER
KLUPT 506,      ;CACHE COUNT
MBOXCT: 0 ? 0   ;NUMBER OF MBOX CYCLES REQUESTED BY EBOX FOR THIS USER LEFT 12.

EXPUNGE KLUPT
] ;KL10P

UTIME:  0       ;RH=CLOCK INTERVAL IN 60'THS, LH=COUNT OF TICKS SINCE READ
UTRNTM: 0       ;TOTAL RUN TIME IN 4 MICROSEC UNITS
USIPRQ: 0       ;# SWAPIN REQUESTS
\f
USWST:  0       ;SWAPPING STATUS BITS.
%SW==525252(1)  ;IN THE LEFT HALF
%SWDSO==400000  ;4.9 => DESIRED TO BE SWAPPED OUT (MUST BE SIGN BIT).
%SWPGW==200000  ;4.8 => FLSINS IS WAITING FOR A PAGE
%SWBEM==100000  ;4.7 => BEST EFFORT MADE TO SWAP OUT, DON'T LOOK AT JOB AGAIN
%SWRUN==040000  ;4.6 => SWAPPED OUT WHILE RUNNABLE, SO CONSIDER MEM STATUS BEFORE REACTIVATION
                ; THIS BIT IS NEVER LOOKED AT.
%SWPCL==020000  ;4.5 => PAGE SWAPPED OUT WHILE BLOCKED IN EXEC MODE
                ; SO WHEN FLSINS SKIPS DON'T CLEAR IT BUT PCLSR INSTEAD.
%SWINT==010000  ;4.4 => IF WAITING FOR PAGE, NEED IT TO INTERRUPT
%SWPRV==004000  ;4.3 => "PRIVELEGED USER"
IFN SWPWSP,[
EXPUNGE %SWPRV
%SWOUT==000400  ;3.9 => JOB IS SWAPPED OUT OR SWAP BLOCKED
%SWSB== 000200  ;3.8 => JOB IS SWAP BLOCKED
%SWLOD==000100  ;3.7 => JOB IS LOADING
 ;VALID STATES OF ABOVE 3 BITS: 0=SWAPPED IN, 1=LOADING, 4=SWAPPED OUT, 6=SWAP BLOCKED

UWRKST: 0       ;WORKING SET.  2**18 TIMES SUM(ALL THIS JOB'S PAGES) 1 OVER # SHARERS
                ;INCREMENTALLY MAINTAINED WHILE JOB IS LOADING OR SWAPPED IN.
                ;NOTE # SHARERS IS IN RH(MMSWP)
USVWRK: 0       ;SAVES UWRKST AS OF LAST TIME SWAPPED IN
USWTIM: 0       ;TIME ENTERED LOADING, SWAPPED OUT, OR SWAP BLOCKED STATE.
                ;WHILE SWAPPED IN, HAS THE TIME AT WHICH IT CEASES TO BE PROTECTED
                ;AGAINST MEMORY PREEMPTION.
];SWPWSP
USWPRI: 0       ;JOB SWAP PRIORITY.  LOWER NUMBER MEANS MORE LIKELY TO STAY IN
                ; AND MORE LIKELY TO COME IN.  SEE ALSO SWRCE, WHICH IS SIMILAR.
IFE SWPWSP,     ;THIS IS THE AVERAGE (DECAYS BY 1/2 IN 30 SECONDS) OF THE PRODUCT
                ;OF THE WORKING SET TIMES THE FRACTION OF CPU USED
                ;WHICH IS A MEASURE OF MEMORY USE WITH INTERACTIVE JOBS GIVEN AN ADVANTAGE.
IFN SWPWSP,     ;THIS IS THE AVERAGE (DECAYS BY 1/2 IN 30 SECONDS) OF THE "ADJUSTED
                ;MEMORY USAGE", WHICH IS THE (LOGARITHM OF THE WORKING SET SIZE)
                ;MULTIPLIED BY THE SUM OF CPU TIME AND I/O WAIT TIME.  ALSO, WHEN
                ;A DISOWNED JOB IS SWAPPED OUT, USWPRI IS MULTIPLIED BY 4 TO PREVENT
                ;IT FROM COMING BACK IN FOR A WHILE UNLESS THERE IS REALLY NO 
                ;COMPETITION FOR MEMORY.  ALSO, WHEN A SWAPPED-OUT JOB WAKES UP FROM
                ;AN I/O WAIT, USWPRI IS DIVIDED BY 2 TO GIVE INTERACTIVE JOBS AN
                ;ADVANTAGE.  THE SWPWSP SYSTEM DOES NOT CURRENTLY LOOK AT SWRCE.
IFE SWPWSP,[
USWSCD: 0       ;SWAP SCHEDULING WORD 4.9=1 SWAPIN INHIBITED THIS JOB (SWAP BLOCKED)
LTRNTM: 0       ;SAVED RUN TIME FOR PRIV USR
LSIPRQ: 0       ;SAVED SWAP IN REQ FOR PRIV USER
UPGSEC: 0       ;NUMBER OF PAGE FAULTS PER <NPVSEC> RUN TIME SECONDS
LPRVTM: 0       ;LAST TIME PRIV USER
];SWPWSP
PAGRAN: 0       ;.PAGRANGE.  1ST PG #,,LAST PG # INCLUSIVE RANGE OF PAGES TO BE PAGED AHEAD.
PAGAHD: 0       ;.PAGAHEAD.  0, OR PAGE-AHEAD-DISTANCE,,PAGE-BEHIND-DISTANCE

TRUNTM: 0       ;IF NOT TOP LEVEL, MINUS RUNTIME (4.069 US) ALREADY SENT TO SUPERIOR
                ;IF TOP LEVEL, RUNTIME USED BY SUBTREE MINUS TIME SENT TO DEMON ALREADY
TSIPRQ: 0       ;DITTO FOR SWAPIN REQUESTS
UTMPTR: SYSRCE  ;POINTER TO RESOURCE WORD FOR THIS LOSER (JTMU FOR TREE)
JTMU:   0       ;REDUCED BY 1/16 EVERY 1/2 SEC
                        ;INCREMENTED BY TIME RUN IN 4 USEC
                        ;MAX EQV VAL 1000000/8-1/16X=0
                        ;EQV VAL=2X10^6
                        ;AMONG JOBS WITH EQUAL RESOURSE
                        ;LOWEST JTMU HAS HIGHEST PRIORITY

IOCHNM: REPEAT NIOCHN,0 ;IO CHANNEL ASSIGNMENT
                        ;RH INDEX INTO IOTTB AND CLSTB
                        ;LH DEV CHNL AND/OR OTHER
SIOCHN: BLOCK LUIOP     ;MUST FOLLOW IOCHNM
                        ;I/O CHANNEL PDL
SIOCP:  SIOCHN-1        ;POINTER INTO I/O CHANNEL PDL
IOCHST: BLOCK NIOCHN    ;I/O CHANNEL STATUS FOR CH'S AT IOCHNM
                        ;3.1-4.9 IO STATUS
                        ;1.1-2.9 .ACCESS POINTER
\f
CORRQ:  -1      ;RQ TO CORE JOB
                ;4.9=1=>NO REQUEST
                ;4.8=0 OLD TYPE RQ,1.1-1.9 # BLKS,3.1-3.8=USR NUMBER RQ'ED FOR
                ;4.8=1 NEW TYPE
                ;4.3 ADD FRESH BLOCK (IGNORE 4.2,4.1)
                ;4.1=1=> ADDING ABSOLUTE BLOCK
                ;3.9=1=>REQUEST WRITE ABILITY
                ;2.9=1 INSERT, =0 DELETE ONLY IGNORE 4.1-4.3
                ;2.1-2.8 VIRTUAL PAGE AFFECTED
                ;1.1-1.9 USER RQ IS FOR

APRC:   APRCHN  ;R.H. CONO TO APR WHEN USER STARTS (HAS AR OV ENABLE, ETC.)
                ;4.9=1=> PROCEDURE IS IN A DISOWNED TREE
BUMRTL==100000  ;4.7 => GUN TREE IF HASN'T RUN FOR AN HOUR
                ;(MEANINGFUL ONLY IN TOP LEVEL JOB).
                ;CLEARED BY REOWNING OR ATTACHING.
BUSRCR==40000   ;4.6 CORE RQ PENDING ON THIS JOB
BULGO==20000    .SEE SYSGUN ;USER IS DISABLED, WAITING TO BE FLUSHED BY SYS JOB.
BCHPTR==330400,,APRC(U) ;4.1-4.4 LAST CH ON WHICH AN ERR OCCURED (SEE ERR DEV)
BULGOS==400     ;AN ATTEMPT IS BEING MADE TO DELETE OR LOG OUT THIS JOB
                ;SO NO-ONE ELSE SHOULD START TO. THIS BIT ALSO LOCKS OUT
                ;MOST WAYS OF HACKING THE JOB (INCL. THOSE THAT SET DIELOK).
                ;3.1-3.5 MUST BE ZERO

DIELOK: 0       ;NUMBER OF JOBS LOOKING AT OR HACKING THIS JOB.
                ;BEFORE KILLING A JOB, WAIT FOR ITS DIELOK TO BECOME 0.

USTP:   0       ;0 RUNNABLE, (IS SET NON ZERO FOR IDLE SETS OF VARS TO SPEED SEARCH)
%UST==1,,537777
%USTCM==400000  ;CORE BEING SHUFFLED (SHOULD ACTUALLY BE OBSOLETE).
%USTCJ==200000  ;CORE BEING GIVEN BY CORE JOB.
%USTSP==100000  ;STOPPED BY SUPERIOR
%USTCG==40000   ;STOPPED BY SUPERIOR TO GIVE IT CORE (CORBLK, OR .USET OF .MEMT).

BCSTOP==400000  ;BIT IN USTP FOR CORE MOVAGE
BUCSTP==200000  ;CORE STOPPING LOSER TO GIVE MORE CORE RQSTED BY ANOTHER LOSER
BUSRC==100000   ;USER CONTROL BIT, SET & CLEARED BY SUPERIOR PROCEDURE
BSSTP==40000    ;SET BY SUPERIOR WHEN HACKING MEM BOUND AT URMEMT OR UMEMEX
;1.1-2.9        ;USED BY UBO AND FRIENDS INHIBITS RELOCATION BY CORE ALLOCATOR
                ;MUST BE MODIFIED WITH CLKOFF  MUST NOT BE SET IF CSTOP IS SET
                ;IS A COUNTER OF TRANSIENT REASONS FOR PROCEDURE BEING STOPPED

PIRQC:  0       ;INT REQ AWAITING SERVICE (SOFTWARE INTS EFFECTED BY SEARCH)
MSKST:  0       ;INT MASK REGISTER FOR BITS IN PIRQC
IFPIR:  0       ;SECOND WORD OF INTERRUPT REQUESTS
                ;3.8-3.1 INF PROC INT
                ;2.7-1.1 IO CHANNEL INT
                ;1.1= CHANNEL 0
MSKST2: 0       ;INT MASK FOR IFPIR
IDF1:   0       ;DEFER BITS FOR 1ST WD INTERRUPTS.
IDF2:   0       ;FOR 2ND WORD INTERRUPTS.
                ;IF AN INTERRUPT IS DEFERRED, IT IS TREATED AS
                ;IF THE JOB'S PICLR VAR HELD 0.
PICLR:  0       ;INT IN PROGRESS FLAG, -1=>ENABLED, 0=>IN PROGRESS

SUPPRO: 0       ;-1 => TOP LEVEL PROCEDURE
                ;OTHERWISE: INT BIT,,PNTR TO SUPERIOR PROCEDURE

FLSINS: 0       ;USER BLOCKING INSTRUCTION;  STATE:
                ; 0 => RUNABLE (UNLESS USTP .NE. 0) 
                ; OTHERWISE HUNG,  IF NO SKIP SAFE TO RESTART AT UUO (UNLESS UFINAL .NE. 0)
RPCL:   0       ;0,,N  RPCLSR'ING N
                ;-1,,N  BEING RPCLSR'ED BY N
\f
UNAME:  0       ;USER NAME
                ;THIS WORD FOR EACH PROCEDURE IS COPIED FROM THE UNAME OF THE PROCEDURE
                ;THAT CREATES IT (SEE USR DEV).  FOR AN INITIAL TOP LEVEL PROCEDURE IT
                ;IS INITIALLY -1 BUT IS MODIFIED BY ALOGIN.  IT IS THE SAME FOR ALL
                ;PROCEDURES IN A TREE.
JNAME:  0       ;JOB NAME
                ;EACH LOGGED IN PROCEDURE HAS A UNIQUE UNAME, JNAME PAIR.  THE JNAME
                ;OF AN INITIAL TOP LEVEL JOB IS "HACTRN".  FOR OTHER JOBS IT IS THE SECOND
                ;FILE NAME SPECIFIED IN THE .OPEN ON THE USR DEVICE THAT CREATES THEM.
USYSNM: 0       ;USER SYSTEM NAME
                ;THIS VARIABLE IS INITIALLY SET TO THE SAME VALUE AS UNAME FOR
                ;A PROCEDURE.  IT CAN BE READ OR WRITTEN BY THE PROCEDURE (ASUSET)
                ;OR BY ITS SUPERIOR (AUSET).  ITS ONLY USE IS AS THE DEFAULT THIRD FILE NAME ON
                ;USER SHARED DEVICES (2311'S (SEE QSKO),  AND CORE
                ;LINK (SEE CLOO)).
USYSN1: 0       ;3RD NAME FOR QSKO, CLOO (AFTER DEFAULTING AND TRANSLATION)
HSNAME: 0       ;HOME SNAME

IOTLSR: 0       ;4.9 IOT USER MOD (=1 ENABLES USER TO DO DIRECT I/O
                ; INSTRUCTIONS) 
                ;RH VIRTUAL PAGE # OF LAST MPV, WIRO OR NXI (SHIFTED TO
                ; ADDRESS SIZE) 
UMARPC: 0       ;PC AT MAR INTERRUPT
LSWPR:  0       ;LOCKED SWITCH POINTER
UCLBLK: 0       ;CLOCK QUEUE BLOCK
        -1
        JRST UREALB
URTIME: 0       ;LH=0=>LOW PRIORITY PHASE 1=> LOW PRIORITY WITH BLOCKING
                ;LH=-1=>HIGH PRIORITY PHASE 2=> HIGH PRIORITY WITH BLOCKING
                ;RH=LENGTH OF HIGH PRIOITY IN 60'THS
RTIMER: -1      ;POSITIVE => MICROSEC RUNTIME TILL RUNTIME INT

LSPCL:  0       ;UPC AT LAST PCLSR,,DIFFERENT UPC AT PREVIOUS PCLSR
LEXFDR: 0       ;DEBUGGING INFO FOR PAGE FAULTS WHICH SIGNAL AN INTERRUPT
                ; TO THE LOSER
                ;LH FAULT BITS OF LAST SUCH FAULT
                ;RH PC OF LAST SUCH FAULT THAT WAS FROM EXEC MODE (WENT TO
                ; IOADCR)
                ;PAGE FAULTS WHICH JUST SWAP IN A PAGE DON'T SET THIS.
LSUUO:  0       ;LAST SYS UUO (FOR DEBUGGING PURPOSE)
LSCALL: 0       ;SIXBIT NAME OF LAST .CALL 0, (FOR PEEK)
CTLBTS: 0       ;CTL BITS TO .CALL 0, XORED TOGETHER IN HERE (RIGHT HALF)
SYSCVL: 0       ;CONTROLS OUTPUT ARGS FROM SYSTEM .CALL
 %SCV==1,,525252
 %SCVOT==400000 ;4.9 CALL HAS OUTPUT ARGS FLAG (TO SAVE TIME)
 %SCVER==200000 ;4.8 CALL HAS ERROR CODE ARG FLAG
                ;3.6-4.7 UNUSED 3.1-3.5 MUST BE ZERO
                ;1.1-2.9 ADDRESS OF ERROR CODE ARG
IOTBTS: 0       ;DEVICE-INDEPENDENT IOT CONTROL BITS GO HERE, IN IOT AND SIOT
USTYN:  0       ;TTY NO OF THE STY WHICH THIS JOB KNOWS AS "STY:" (WITHOUT
                ; NUMBER). 
UUAC:   0       ;AC FLD OF LAST UUO OR DESIRED CHANNEL IN CASE OF NOPEN ETC
                ;SELECTS CHNL FOR ALL IOTS, OPENS ETC
                ;LH -1 IF STORED BY CHNDCD, ELSE ZERO (SEE WHO LINE ROUTINES)
TRMNAM: 0       ;TERMINAL IDENTIFICATION
TRNLST: 0       ;TRANSL LIST FOR THIS JOB. -1 => NIL, OR IDX INTO TRAN!X
TRNLS1: 0       ;TRANSL LIST FOR THIS JOB & INFERS.
UTRAPM::        ;SIGN BIT OF OPTIONS IS UUO-TRAP-TO-SUPERIOR MODE
OPTION: 0       ;OPTIONS WORD, SETTABLE BY USER
                ;EACH BIT CONTROLS SOME SYSTEM ACTION FOR THIS JOB
        .SEE %OP
XUNAME: 0       ;"WHO I REALLY AM" AS OPPOSED TO "WHO I AM LOGGED IN AS"
XJNAME: 0       ;JOB NAME USER SPEC'ED AS OPPOSED TO UNIQUIZED VERSION
\f
40ADDR: 20,,40  ;RH=ADDRESS OF USER'S 6-WORD BLOCK FOR UUO'S, INTS, SWITCHES, LOCKING.
                ;LH=ADDRESS OF USER'S 20-WORD BLOCK FOR SUPERIOR'S USE.  0=20.
IFN N11TYS,[
TVCREG: -1      ;TV CONSOLE REG FOR THIS USER OF -1 NONE
TVVBN:  -1      ;-1 OR CONSOLE REG FOR RUN BLINKING
NVDBA:  0       ;# VIDEO BUFFERS ASSIGNED (WITH NVDBA SYSTEM CALL).
];N11TYS
UWHO1:  0       ;WHOLINE FLAGS
UWHO2:  0       ;TWO HALFWORDS, PRINTING CONTROLLED BY UWHO1 4.9-3.3
UWHO3:  0       ;TWO MORE HALF WORDS, CONTROLLED BY UWHO1 3.2-1.5
IFN KL10P,[
ULSPBR: 0       ;STBR,,GCSTBR FOR SPECIAL LISP INSTRUCTIONS
]
SERVER: -1      ;User index of server job who is allowed write access to
                ; this job to implement some oddball protocol.  -1 if none.
;INSERT NEW USER VARIABLES HERE^

USRPDL: -LUPDL,,UPDL-1  ;USER PDL
UPDL:   BLOCK LUPDL-1
EPDL2:  0       ;SAVES C(T) FOR FLSINS
QLD:    0       ;LINK DEPTH
VALUE::         ;PROCEDURE "VALUE" RETURN
SRN3:   0       ;SAVED N3, N4 FOR RENAMES AT AOPEN ALSO USER INDEX AT NLOAD
                ;SRN3, SRN4 USED BY CORBLK .CALL
.SEE IODCS2     ;SRN3 contains saved user mode PC for unlocking own locks.
.SEE ALOGO4     ;NO CLOSE ROUTINE MAY USE SRN4 OR SRN5
SRN4:   0       ;ALSO DEVICE CHNL IOCHNM POINTER AT NLOAD
SRN5:   0       ;SAVED N5 FOR LINK ALSO VIRTUAL PAGE NUMBER AT NLOAD
EPDL3:  0       ;USED BY 2311 ROUTINES (QFNG) ALSO QSMDN ADDR AT NLOAD ALSO BY TYOW2
.SEE ALOGO4     ;NO CLOSE ROUTINE MAY USE EPDL
                ;FOR BP-STYLE RENAME, RENMWO AND MLINK,
                ;HOLDS BP (OR BP BLK PTR) TO NAMES TO RENAME OR LINK TO.
EPDL:   0       ;USED BY 2311 ROUTINES.
                ;FOR SOPEN AND BP-STYLE RENAME, DELETE, HOLDS BP OR BP BLOCK PTR.
EPDLT1: 0       ;FN1 BEFORE LAST TRANSLATION, USED BY NLOAD
EPDLT2: 0       ;FN2   "     "      "       , USED BY NLOAD
EPDLT3: 0       ;SYS NAME "  "      "
EPDLT4: 0       ;LEFT ADJ DEVICE NAME " " "

STTYOP: 0       ;IN THE TOP OF A DETACHED TREE, THIS CONTAINS THE SAVED USER TTY
                ; OPTIONS.  2.9=1 IF IT IS VALID, 2.7-2.8 ARE QUERY AND REFUSE MODE,
                ; THE REST ARE TTYOPT BITS.

IFN 0,[ ;FAKE OUT @
LSWB0:
]
REPEAT NULBLK,[
CONC LSWB,\.RPCNT,:     BLOCK 2
]               ;SWITCH BLOCK FORMAT
                ;WD1 ASSOCIATED ADDRESS OR QUANTITY
                ;3.6-3.1 USER NUMBER OF SWITCH HOLDER
                ;2.9-1.1 PNTR TO NEXT SWITCH ON LIST OR 0 IF NONE
                ;FOR REMAINDER OF FORMAT SEE LSWDIS

IFN KL10P,[
IFGE USRSTG+1000-., INFORM SPACE LEFT IN UPT,\1000-<.-USRSTG>
IFL USRSTG+1000-., .ERR USER VARS TOO BIG FOR UPT!
.ELSE LOC USRSTG+1000
] ;IFN KL10P

IFN KS10P, LOC <.+7>&-10        ; KS UPT must be 0 mod 8 (see UUOPCW)

LUBLK==.-USRSTG
L==LUBLK
INFORM [STORAGE PER LOSER]\LUBLK
        BLOCK LUBLK     ;USER VARIABLES FOR CORE JOB
SYSB==<1777+.>_-10.
MXC==SYSUSB-SYSB        ;AVAIL BLOCKS AFTER SYS+DDT

\fSUBTTL TSS INITIALIZATION
;NEXT LINE COMMENTED OUT BECAUSE IT CAUSES MORE TROUBLE THAN IT SAVES
;.HKALL==1      ;(THE FOLLOWING CODE IS WIPED OUT AT ICLR)
EXEUMP=UPGMP+100        ;EXEC UPPER MAP LIVES IN SYSTEM JOB'S PAGE TABLE
                        ;SYMBOL IS DEFINED HERE SINCE UPGMP WAS JUST DEFINED 6 PGS AGO

BEG:    SKIPN SALV      ;SEE IF LOSER FORGOT TO LOAD SALV WHEN BUILDING SYSTEM,
                        ;OR SALV MEM IS NXM.  EVIL!  EVIL!
         BUG AWFUL,[HEY!  WHERE'S THE SALVAGER?]
        JSR SALV+1      ;CALL NO-QUESTIONS-ASKED SALVAGER
GO:     JFCL 17,.+1
        JRST .+1
        JFCL 1,[JRST 4,.]       ;SYSTEM WONT RUN ON 6
IFN KL10P,[
        CONSO PAG,600000
         SWPIA                  ;IF CACHE OFF, FLUSH CRUFT THAT MAY BE IN IT
        CONSZ PAG,600000
         SWPUA                  ;IF CACHE ON, UPDATE CORE SO DDT IS GOOD
        CONSZ 200000
         JRST .-1
        SPCCTX 0,1,USRSTG,DISABLE       ;SET UP UPT ADDR, BUT NO ACCTING TILL
        MOVEI T,0                       ;MORE INIT IS DONE.
        XCTR XBW,[BLT T,17]             ;CLEAR BLK 1 TO AVOID RANDOM PARITY
                                        ; ERRORS
] ;KL10P
IFN KS10P,[
        CONO 20700+APRCHN       ; Clear memory related APR flags
                                ; (ECC, Bad, NXM)
        MOVSI TT,%KEHLD+%KEREF+%KEPWR
        IOWR TT,[KSECCS]        ; Reset memory status register.
        MOVEI TT,%UBTIM+%UBBAD+%UBPAR+%UBNXD+%UBINI
        IOWRQ TT,UBASTA         ; Reset both Unibus's and both adaptors.
        IOWRI TT,UBASTA
        MOVEI TT,DSKCHN_3       ; Set PI level for RH11.  (No, you can't do
        IOWRQ TT,UBASTA         ; this at the same time you reset the Unibus.)
        MOVEI TT,MTCCHN_3+TTYCHN        ; PI for Tape, for Chaos and TTYs.
        IOWRI TT,UBASTA
        WRHSB [HSB]             ; Set halt status block location.
        CLRCSH                  ; Reset cache once for good measure.
        SPCCTX 0,1,USRSTG       ; Set up UPT and AC blocks.
] ;KS10P
IFN TEN11P,[
        MOVEI TT,600000+<T11CPA_-10.>
        SKIPGE TEN11F
         MOVEI TT,0
        DPB TT,[.T11CP+EXEUMP]
        SETOM T11MP+<T11CPA&777777>_-10.        ;DONT USE MAP PAGE AS 10-11 PAGE
;IFN PDP6P,[            ;THESE ARE IN SEPARATE MOBIES NOW
;       MOVE TT,[-LPDP6M,,<PDP6BM&777777>_-10.]
;       SETOM T11MP(TT) ;CONFLICTS WITH PDP-6 MEM
;       AOBJN TT,.-1
;]
;IFG TSYSM-256.,[
;       MOVSI TT,-TSYSM+256.
;       SETOM T11MP(TT) ;CONFLICT PAGES
;       AOBJN TT,.-1
;]
]
        MOVE P,SYSPDP

;INIT THE EXEC PAGE MAP'S DDT PAGES.
        HRRZ A,DDT-2    ;LOWEST ADDR IN SYMBOL TABLE
        SUBI A,100      ;LEAVE ROOM FOR EXTRA SYMS, 340 ROUTINES' LOSSAGE, ETC.
        LSH A,-10.      ;GET PAGE SYMTAB STARTS IN
        MOVEM A,FDDTPG
        MOVEI Q,NQS-1   ;PUT THE TUTS JUST BELOW THE DDT PAGES
BEGTT1: SKIPE QACT(Q)
         JRST BEGTT3    ;UNIT NOT IN USE
        MOVE T,NTBL(Q)  ;NUMBER OF PAGES IN THIS TUT
BEGTT2: SUBI A,1
        MOVE B,[MU23TT_<.TZ .BM <MUR>>]
        MOVEM B,MEMBLT(A)
        DPB Q,[MNUMB,,MEMBLT(A)]
        SOJG T,BEGTT2
        MOVE B,A
        LSH B,10.
        HRLI B,640000
        MOVEM B,QTUTO(Q)
BEGTT3: SOJGE Q,BEGTT1
        MOVEM A,FTUTPG
        ;NOW MAKE SURE ALL THOSE PAGES ARE MAPPED
        MOVEI B,-200(A)         ;ASSUMING TSYSM AT LEAST 128K
        LSH B,-1                ;GET A B.P. TO IDPB MAP HWD OF 1ST DDT PAGE
        ADD B,[442200,,EXEUMP]
        TRNE A,1
         IBP B
        MOVEI C,600000+PMCSHM(A) ;COMPUTE CONTENTS OF THAT MAP WORD.
        MOVE D,[MUDDT_<.TZ .BM <MUR>>]
BEG3:   CAML A,FDDTPG
         MOVEM D,MEMBLT(A)
IFG TSYSM-128., IDPB C,B
        AOS C
IFG TSYSM-400,  CAIE A,400
.ELSE           CAIE A,TSYSM    ;STORE THAT MAP WORD AND ALL REST THERE ARE.
         AOJA A,BEG3

;INITIALIZE REST OF EXEC PAGE MAP
IFN DIRMAP,[
        MOVE Q,[222200,,EXEUMP]
        SETZB A,B
        SKIPE USEMDM            ;MAKE MEDIUM MEM NXM IF DIRMAP NOT TURNED ON
         MOVEI B,600200+PMCSHM  ;THIS MAY BE USEFUL FOR DEBUGGING
        MOVE T,FTUTPG
        SUBI T,201              ;STOP AT 1ST TUT PAGE.
BEG2:   CAIL A,NEXPGS
         DPB B,Q
        IBP Q
        ADDI B,1
        CAMGE A,T
         AOJA A,BEG2
];END IFN DIRMAP
;DROPS THROUGH
\f;DROPS IN

;SET UP EXEC LOWER MAP (EVEN ON KA, WILL BE LOOKED AT BY .CALL CORBLK)
        MOVE A,[600000,,600001+PMCSHM]  ;PAGE 0 IS NOT CACHED   
        MOVSI B,-100
         MOVEM A,EXELMP(B)
         TLO A,PMCSHM
         ADD A,[2,,2]
         AOBJN B,.-3

;SET UP SYS JOB'S CIRCULAR POINTERS SO ALL THE PAGES IT HAS ARE ABSOLUTE

        MOVE A,[442200,,UPGMP]
        MOVE B,[442200,,UPGCP]
        MOVEI D,0
BEG6:   ILDB T,A
        MOVEI E,-1
        JUMPN T,BEG7
        CAIL D,200+MMP0 ;ALLOW USERS TO COPY MMP EXEC PGS
         CAILE D,200+NEXPGS
          MOVEI E,0     ;PG IT DOESN'T HAVE, AND NOT COPYABLE EXEC PG
BEG7:   IDPB E,B
        CAIGE D,377
         AOJA D,BEG6

;EXEC MAP PREPARED, NOW TURN ON PAGING

IFN KA10P,[
        LPMR UPGML
        CONO 633550
] ;KA10P
IFN KS10P,[
        CONO 67760      ; Disable and Clear all flags
        CONO 127660     ; Enable and Clear all flags except memory ECC
        APRID A
        TLNN A,%UCITS
         BUG AWFUL,[ITS WON'T RUN WITH THE DEC MICROCODE]
        LDBR3 EXEUMP            ; Load exec DBRs.
        LDBR4 EXELMP
        LPMR UPGML
        SPCCTX 1,1,USRSTG       ; Select AC blocks and set UBR.
        WREBR 020000+<EPT/1000> ; Paging on and set EBR.
] ;KS10P
IFN KL10P,[
        CONO 327740     ;ENABLE AND CLEAR ALL FLAGS EXCEPT SWEEP DONE
        APRID A
        TLNN A,%UCITS
         BUG AWFUL,[ITS WON'T RUN WITH THE DEC MICROCODE]
        SPCCTX 6,6      ;LOAD MICROCODE CONSTANTS NEEDED BY PAGEING INTO
                        ; BLOCK 6.
        MOVEI 3,EXEUMP  ;DBR3
        MOVEI 4,EXELMP  ;DBR4
        MOVSI 5,PMAGEM  ;LH.AGE
        MOVEI 6,PMAGEM  ;RH.AGE
        MOVEI 7,1000    ;CN1000
        MOVEI 10,100    ;CN100
        CONO PAG,660000+<EPT/1000>      ;CACHE ON, ITS PAGER, TRAP ENB, EPT ADDR
        SPCCTX 1,1,USRSTG,DISABLE
        LPMR UPGML
]               ;END IFN KL10P
        MOVE P,SYSPDP

;INITIALIZE FREE LISTS IN MEMBLT

        MOVEI A,1       ;A PG NO - NOTE: DON'T DO PAGE ZERO
BEGF0:  CAML A,FTUTPG   ;IF THIS ISN'T A DDT OR TUT PAGE, THEN
        CAIL A,400
         PUSHJ P,CIMEMR ;PUT THIS PAGE ON THE RIGHT FREE LIST
        CAIGE A,TSYSM-1
         AOJA A,BEGF0
IFN TEN11P,[
        SKIPGE TEN11F
         JRST BEG4
        MOVSI A,-256.   ;CLEAR THE INTERFACE'S "VALID" BITS.
        SETZM 400000+T11CP*2000(A)
        AOBJN A,.-1
BEG4:]
IFN XGP,[
        SKIPE TEN11F
         JRST BEGX1
        MOVE A,[600000+<XGP11_8>,,1777]
        PUSHJ P,T11AD
         BUG            ;NO 10-11 PAGES AVAILABLE?
        MOVEI TT,600000+<<T11CPA_-18.>_8>(B)    ;GET CORRESP EXEC MAP PG SETUP
        DPB TT,[.XGPC+EXEUMP]
        MOVEI TT,600000+<<T11CPA_-18.>_8>+XGPTP
        DPB TT,[.XGPB+EXEUMP]   ;SETUP PAGE FOR PDP-11 BUFFER
BEGX1:]
\f
;CHECK AVAIL MEM FOR EXISTANCE

IFN ECCMEM,[
        LDB TT,[121200,,ECCADR] ;GET PAGE THAT ECC HISTORY IS ON
        IORI TT,200000          ;GRANT READ ACCESS
        DPB TT,[.ECCPG+EXEUMP]
        LPMR UPGML
        MOVE A,400000+ECCPG*2000+1760   ;GET CURRENT HISTORY POINTER
        LSH A,-32.
        MOVEM A,ECCIDX
];ECCMEM
        MOVEI A,TSYSM-1
CKML:   MOVEI TT,600000(A)
        DPB TT,[.PAREP+EXEUMP]
        LPMR UPGML
IFN ECCMEM,[
        LDB TT,[121200,,ECCADR] ;GET PAGE THAT ECC HISTORY IS ON
        CAMN A,TT               ;THIS PAGE?
         JRST CKML1A            ;YES, TREAT AS IF OFFLINE, THOUGH WILL ACCESS IT
                                ; DIRECTLY FROM TIME TO TIME
]
        MOVE TT,A
        LSH TT,10.
        MOVSI T,-8
        CAML TT,MEMLZL(T)
         CAML TT,MEMLZH(T)
          AOBJN T,.-2
        JUMPL T,CKML1A          ;THIS BLOCK KNOWN TO BE LOSING
        SKIPL USEHM
         CAIGE A,256.
          JRST .+2
           JRST CKML1A          ;HIGH MOBY NOT TO BE USED
IFN KL10P,[
        MOVEI TT,CKML1          ;KL10 CAN GET PARITY FAULT ON REFERENCE TO NXM
        MOVEM TT,PFNPC
        HRRM TT,MUUOKN          ;IT CAN ALSO GET A UUO
] ;KL10P
IFN KS10P,[
        MOVEI TT,CKML1
        MOVEM TT,EPTPFN
] ;KS10P
        CAIL A,256.             ;IF NOT IN BOTTOM 256K, DON'T ASSUME GOOD DATA
         SETZM 400000+PAREP*2000+20     ;STORE ZERO SO DON'T GET PARITY ERROR
        MOVE 0,400000+PAREP*2000+20     ;IF THIS NXMS, MEM THE SYS THINKS
                                        ; IT HAS IS NON EXISTANT
IFN KA10P,[
        CONSZ 10000
         JRST CKML1             ;THAT MEM NXM
] ;KA10P
IFN KL10P,[
        MOVEI TT,PFAIL
        MOVEM TT,PFNPC
        MOVEI TT,UUOH0
        HRRM TT,MUUOKN
        CONSZ 2000
         JRST CKML1             ;THAT MEM NXM
] ;KL10P
IFN KS10P,[
        MOVEI TT,PFAIL
        MOVEM TT,EPTPFN
        CONSZ 400
         JRST 4,.       ; This can't happen, right?  (If we got a NXM, we
                        ; would have trapped to CKML1 already.)
] ;KS10P
        SKIPL CKMBLK    ;WINS
         JRST CKML6     ;THUS ENDING BLOCK OF LOSERS
CKML2:  SOJGE A,CKML
        AOSN CKMFLG     ;ANY MEM OFF UNEXPECTEDLY?
         JRST CKML5     ;NO
        MOVEI TT,[ASCIZ/
IS THIS OK? /]          ;YES, MAKE SURE SOMEBODY KNOWS ABOUT IT.  MAY BE SERIOUS SCREW.
        PUSHJ P,T00ASZ
        PUSHJ P,T00TYI
        ANDI A,137
        CAIE A,"Y
         JRST DDT
        MOVEI TT,[ASCIZ/
/]
        PUSHJ P,T00ASZ  ;CRLF
CKML5:
IFN KL10P,[
        CONO 26400      ;CLEAR ANY NXM AND PARITY INTERRUPTS
        CONI MTS,TT
        TLNN TT,400
         BUG PAUSE,[TAPE DF-10 IS IN KA MODE, PLEASE FLIP THE SWITCH]
        CONI DSK,TT
        TLNN TT,4000
         BUG PAUSE,[DISK DF-10 IS IN KA MODE, PLEASE FLIP THE SWITCH]
] ;KL10P
IFN KS10P, CONO 20400           ; Clear NXM flag
;DROPS THROUGH
\f;DROPS IN

IFN RP10P,[
        DATAI DPC,A
        TLNN A,NOWRIH           ;CHECK FOR FORMAT SWITCH ON RP10
         BUG PAUSE,[RP-10 WRITE HEADERS ENABLED, PLEASE FLIP THE SWITCH]
];RP10P

IFE <MCOND MLKA,>&<MCOND DM,>,[ ;CHECK FOR LOSING SWITCHES ON MEMORY ON ML-KA AND DM

        MOVSI D,(DWRITC)        ;MAKE COMMAND FOR VERY LAST BLOCK ON DISK
        MOVEI A,NCYLS+XCYLS-1
        DATAO DPC,[DNOOPC]      ;DETERMINE TYPE OF DRIVE 0
        DATAI DPC,B
        TRNE B,RP03BT
         MOVEI A,MCYLS+XCYLS-1  ;RP03
        DPB A,[DCYL D]
        LSH A,-8
        DPB A,[DCYLXB D]
        MOVEI A,NHEDS-1
        DPB A,[DSURF D]
        ADDI D,QICWA
        MOVEM D,CKMSWC
        SUB D,[DWRITC-DREADC]
        MOVEM D,CKMSRC
        SUB D,[DREADC-DSEEKC]
        MOVEM D,CKMSSC
        MOVEI A,0
CKMS1:  LDB TT,[MUR,,MEMBLT(A)] ;MEM EXIST?
        CAIE TT,MUFR            ;AND NOT DDT?
         JRST CKMS2
        MOVEI B,600000(A)
        DPB B,[.PAREP+EXEUMP]
        LPMR UPGML
        CAIGE A,CKMSZZ          ;MEM LOADED?
         JRST CKMS3             ;YES
        MOVSI B,'FOO            ;NO, LOAD IT
        MOVEM B,CKMSBF
        MOVE B,[CKMSBF,,CKMSBF+1]
        BLT B,CKMSBF+177
        MOVEI B,'BAR
        HRRM B,CKMSBF+69.
        HRRM A,CKMSBF+6         ;MAKE DIFF FROM OTHER SUCH PAGES
        MOVEI C,1
        MOVE B,A
        LSH B,-4                ;16K BLOCK # IN B
        LSH C,(B)               ;GET UNIQUE BIT SO PARITY ERR IF TWO AT SAME ADDR
        MOVEM C,CKMSBF+35
        MOVE B,[CKMSBF,,400000+PAREP*2000]
        BLT B,400000+PAREP*2000+177
CKMS3:  MOVE B,A                ;MAKE IOWD
        LSH B,10.
        SOS B
        HRLI B,-200
        LDB C,[100300,,A]       ;MA 15-17
        TRC C,7
        DPB C,[410300,,B]
        MOVEM B,QICWA
        SETZM QICWA+1
        CONO DPC,175700
        DATAO DPC,CKMSSC        ;POSITION HEADS
        CONSO DPC,10
         JRST .-1
        DATAO DPC,CKMSWC        ;WRITE OUT SECTOR
        CONSZ DPC,20
         JRST .-1
        CONI DPC,B
        TLNE B,17
         JRST CKMS4             ;CHANNEL ERROR MEM LOSING
        TRNE B,177700
         JRST CKMS2             ;FOO, DISK LOSING
        MOVE B,[-200,,CKMSBF-1] ;READ IT BACK   
        MOVEM B,QICWA
        SETZM QICWA+1
        SETZM CKMSBF+69.
        CONO DPC,175700
        DATAO DPC,CKMSRC
        CONSZ DPC,20
         JRST .-1
        CONI DPC,B
        TLNE B,17
         JRST CKMS2             ;MEM LOSS IN CKMSBF?
        TRNE B,177700
         JRST CKMS2             ;FOO, DISK LOSING
        MOVSI B,-200            ;COMPARE
        MOVE C,CKMSBF(B)
        CAME C,400000+PAREP*2000(B)
         JRST CKMS4             ;NOT SAME SWITCHES LOSING
        AOBJN B,.-3
CKMS2:
IFE MCOND DM,   ADDI A,16.      ;MA10'S !!
IFE MCOND MLKA, ADDI A,32.      ;ML-KA MEM IS IN 32K MODULES
        CAIGE A,TSYSM
         JRST CKMS1
        CONO DPC,175700         ;RESET THE DISK CONTROL
        DATAO DPC,[DEASEC+776]  ;AT EASE!
        CONO PI,20000           ;TURN OFF IOB PI REQ LIGHT
        JRST CKMSX              ;DONE WITH THIS, CONTINUE INITIALIZATION

CKMSBF: BLOCK 200

CKMS4:  MOVEI TT,[ASCIZ/MEM ADDR SWITCHES DISAGREE CPU VS DSK AT LOC /]
        PUSHJ P,T00ASZ
        PUSHJ P,T00BKO
        MOVEI TT,[ASCIZ/0000/]
        PUSHJ P,T00ASZ
        JRST DDT

CKMSZZ==./2000+2                ;ABOVE HIGHEST CODE

CKMSX:
]               ;END IFE MCOND MLKA & DM
\f;DROPS IN
        MOVEI TT,0
        DPB TT,[.PAREP+EXEUMP]
        LPMR UPGML
IFN KA10P,      CONO PI,240000+11577+IFN C1MXP,20000
IFE KA10P,      CONO PI,11577
IFN NOTYS,      CONO TTY,TTYCHN
IFN NETYS,[
                SETOM DTEODN            ;CAN GET SET ON WHILE LOADING, BUT INTR GETS LOST
IFE PDCLKP,     CONO DTE,1170+APRCHN    ;CLEAR ALL FLAGS AND ASSIGN PI CHANNEL
IFN PDCLKP,     CONO DTE,1170+TTYCHN    ;CLEAR ALL FLAGS AND ASSIGN PI CHANNEL
]               ;END OF IFN NETYS
IFN E.SP,[
        CONO DIS,515330 ;RESET E&S
        MOVEI TT,E.SPM
        MOVEM TT,34     ;SET PAGER LOC (USED BY DSKDUMP)
]
IFN TM10B,[
        MOVEI TT,MIOWD
        MOVEM TT,MICWA  ;SETUP LOC FOR MEM CHAN TAPE
]
IFN RP10P+RH10P,[
        MOVEI TT,QIOWD
        MOVEM TT,QICWA  ;SETUP FOR DEC DISK CHANNEL
]
IFN ARMP,       DATAO 760,[0]   ;RESET LITE ON ARM
IFN DSDP,       CONO DSDEV,10   ;RESET INT RQ FROM PDP10
IFN RBTCP,      CONO RBTCON,0   ;RESET TABLET

        MOVE A,DDT-2    ;PUT GLOBAL BLOCK HEADER AT BEGINNING
        MOVE B,[SQUOZE 0,GLOBAL]
        CAME B,(A)      ;SEARCH FOR GLOBAL BLOCKS
        AOBJN A,[       AOBJN A,.-1
                        JRST BEGS1]
        MOVE C,DDT-2
        MOVEI D,(C)
        SUBI D,(A)      ;GET ,,-#WDS  BEFORE GLOBAL BLOCK
        MOVSI D,(D)
        ADDM D,1(A)     ;GLOBAL BLOCK NOW LARGER
        EXCH B,(C)      ;EXCHANGE IT WITH FIRST SYM
        MOVEM B,(A)
        MOVE B,1(A)
        EXCH B,1(C)
        MOVEM B,1(A)
BEGS1:  PUSHJ P,SBUBL
        JUMPL J,BEGS1   ;KEEP SORTING UNTIL SYMS IN ORDER
        MOVSI A,400000
        IORM A,DDT-1

; SORT THE UUO/SUSET/BIT SYMBOL TABLE BY VALUE

        MOVE E,[SYSYMB-SYSYME-1,,SYSYMB]
        PUSHJ P,SBUBL0
        JUMPL J,.-2

        MOVE A,[-LTSTB,,TSTB]
BEG1:   MOVE B,(A)
        MOVEI C,(B)
        EQV C,(B)
        AOBJN B,.-1
        MOVEM C,CKSUMS-TSTB(A)
        MOVE B,(A)
CKXC2:  MOVE C,(B)
REPEAT 36.,[
        IFL .RPCNT-18., TLNE C,400000_<-.RPCNT>
        .ELSE           TRNE C,400000_<18.-.RPCNT>
        XORM B,CKXORS+.RPCNT
]
        AOBJN B,CKXC2
        AOBJN A,BEG1
        HRRZS 37                ;MAKE SURE SYS DOESNT IMMEDIATELY COME DOWN
;DROPS THROUGH
\f;DROPS IN
        MOVEI A,0
        CLEARM QACTB
QSETUP: MOVE B,DCHBT(A)
        SKIPN QACT(A)
        IORM B,QACTB
        CAIGE A,NQS-1
        AOJA A,QSETUP
IFN DC10P,      CONO DC0,DCCSET+DCDENB+DSKCHN   ;RESET 2314 AND SET DATA ERROR ENABL
IFN 340P,       CONO DIS,100
IFN TK10P,      CONO NTY,TTYCHN
IFN MTYP,       CONO MTY,TTYCHN
        CLEARM USRHI
        CLEARB U,USER
        MOVE P,SYSPDP
IFN DPKPP,[
        CONO DPK,400070+TTYCHN  ;INITIALIZE DP KLUDGE
        DATAO DPK,[4,,DPKBAS]
        MOVE T,[-NDPTYS,,NFDPTY]
        MOVEI B,0       ;LINE #
DPIL:   LDB A,[$TTOSP,,TTYTYP(T)]       ;OUTPUT SPEED
        MOVE A,DPSP(A)          ;MAP TO DPK SPEED CODE
        DPB B,[140400,,A]       ;LINE #
        CONO DPK,500+TTYCHN(A)  ;LOAD OUT SPEED
        LDB A,[$TTISP,,TTYTYP(T)]       ;INPUT SPEED
        MOVE A,DPSP(A)          ;MAP TO DPK SPEED CODE
        DPB B,[140400,,A]
        CONO DPK,700+TTYCHN(A)  ;LOAD IN SPEED
        AOS B
        AOBJN T,DPIL
]
IFN DZ11P,[
        PUSHJ P,DZINIT
];DZ11P
IFN N11TYS,[
        SKIPE TEN11F
         JRST BEG5
        MOVSI R,-NTTPG-NTVBP+1
        MOVE T,[.TTPG0+EXEUMP]
BEG9:   MOVEI A,(R)     ;SET UP 1 MORE TEN-11 MAP ENTRY
        LSH A,20.
        IORI A,1777     ;A FULL PAGE
        TLO A,600000+TT11NM*400
        PUSHJ P,T11AD
         BUG
        ADDI B,600000+<<T11CPA_-18.>_8>         ;READ-WRITE, IN HIGH MOBY.
        DPB B,T
        IBP T
        AOBJN R,BEG9
        MOVE A,[(600000+TT11NM*400)TT11CR_8]    ;POINTER TO CONSOLE REG
        PUSHJ P,T11AD
         BUG
        ADDI B,600000+<<T11CPA_-18.>_8>
        DPB B,T
        LPMR UPGML
        SKIPE TT11P     ;IF WE'RE SUPPOSED TO USE THE TV 11,
         SETZM TT11UP   ;REQUEST IT TO RE-INIT.
                ;IF TT11UP BECOMES NONZERO, THE 11 IS UP.
BEG5:   ];END IFN N11TYS
IFN CH11P,[
        XCTRI [IORDI A,CAIMYN]
         CAIA
          BUG HALT,[CHAOSNET INTERFACE NOT RESPONDING (CHECK THE BREAKER ON THE UNIBUS)]
] ;CH11P
IFN CHAOSP,[ IFN T11CHP,[
        SKIPE TEN11F    ;SET UP TEN-11 CHAOS NET INTERFACE PAGE
         JRST BEG8
        MOVE A,[(600000+CH11NM*400)1004_8+1777]
        PUSHJ P,T11AD
         BUG
        ADDI B,600000+<<T11CPA_-18.>_8>
        DPB B,[.CHSPG+EXEUMP]
BEG8:   ]] ;CHAOSP, T11CHP
IFN DL10P,[             ;INITIALIZE DL10
        CONO DLC,400000 ;MR CLR
        CONO DLB,1      ;TURN OFF EXCESS LIGHTS
        CONO DLB,2      ;..
        CONO DLB,3      ;..
        CONO DLB,DL10AR ;64 WORDS FOR PDP11 #0 AT DL10AR
        DATAO DLC,[200001,,]    ;KA INTERRUPT MODE
        SKIPE DL10F
         CONO DLC,100020+TTYCHN ;ENB PDP11 PORT #0 AND ENB INTR
        MOVSI T,1
        SKIPN DL10UP
         SOJG T,.-1
        SKIPGE T        ;IF THE 11 DIDN'T SAY IT WAS UP,
         SETZM DL10F    ;MARK IT NON-FUNCTIONAL.
]
IFN KL10P,[
        CONO TIM,460000+3900.   ;SET INTERVAL TIMER TO 39 MILLISECONDS FOR OVHMTR
        CONO MTR,433001 ;TIME BASE ON, ACCOUNT FOR USER + EXEC NO PI, INTERVAL PIA=1
        PUSHJ P,PRFOFF  ;INIT PERFORMANCE COUNTER
] ;KL10P
\f
;DROPS IN
        MOVSI T,%TBNOT+%TBDTY+%TBNVR    ;SYS JOB HAS NO CONSOLE ALL TO ITSELF
        MOVEI U,LUBLK
        PUSHJ P,USSINI  ;INITIALIZE SYS JOB VARIABLES BLOCK
         JRST .-1
        AOS NMPGS
IFE KA10P,[
        MOVEI T,UUOH0   ;CLOBBERED BY USSINI
        HRRM T,MUUOKN
] ;IFE KA10P
        MOVSI T,600000
        HLLM T,UPGMP    ;GIVE PG 0 TO SYS JOB
        MOVSI T,-1
        HLLM T,UPGCP
        MOVEI T,2000
        MOVEM T,HUSRAD
        MOVEI T,SYSRCE  ;SET SYS JOB RESOURCE POINTER
        MOVEM T,UTMPTR
        MOVSI A,(SIXBIT /SYS/)  ;""" NAMES
        MOVEM A,USYSNM(U)
        MOVEM A,UNAME(U)
        MOVEM A,XUNAME(U)
        MOVEM A,JNAME(U)
        MOVEM A,XJNAME(U)
        SETZM USTP(U)
        MOVSI T,%TBNOT+%TBDTY+%TBNVR    ;CORE JOB HAS NO CONSOLE
        MOVEI U,2*LUBLK
        PUSHJ P,USSINI  ;SET UP CORE JOB VARIABLES BLOCK
         JRST .-1
        MOVE A,[SIXBIT /CORE/]
        MOVEM A,USYSNM(U)
        MOVEM A,UNAME(U)
        MOVEM A,XUNAME(U)
        MOVSI A,(SIXBIT /JOB/)
        MOVEM A,JNAME(U)
        MOVEM A,XJNAME(U)
        MOVEI T,SYSRCE
        MOVEM T,UTMPTR+LUBLK
        SETZM USTP(U)
        MOVEI A,CORJI
IFE KA10P, HRLI A,%PSPCU        ;DOES CORE JOB XCTR?
        MOVEM A,UPC(U)
IFE KA10P,[
        MOVE T,[JSR ILLTRP]     ;SYS AND CORE JOBS SHOULDN'T TRAP
        MOVEM T,TR1INS          ;THESE WON'T BE USED ANYWAY UNLESS
        MOVEM T,TR2INS          ;SOMEDAY THEY SHOULD RUN IN USED MODE
        MOVEM T,TR3INS
        MOVEM T,TR1INS+L
        MOVEM T,TR2INS+L
        MOVEM T,TR3INS+L
] ;IFE KA10P
        MOVEI A,SYSB+2          ;GIVE SYSTEM CORE TO SYS JOB, WITH A COUPLE
        MOVEM A,CORRQ           ; SPARE JOB SLOTS
        AOS NCORRQ
        SOS A
        ADDM A,NCBCOM
;       DATAI CLK1,LCLK1
        CONO PI,100+UTCON-1     ;ALL EXCEPT 7
IFN KA10P, CONO 3000+APRCHN
IFN KL10P,[
IFN PDCLKP, CONO CLK,APRCHN
.ELSE [ MOVEI A,%DTCLN  ;TURN ON 60-CYCLE CLOCK
        MOVEM A,DTECMD
        SETZM DTEFLG
        CONO DTE,%DBL11
        SKIPN DTEFLG
         JRST .-1
]
        CONO APRCHN     ;ENABLE APR FAULT INTERRUPTS
        SWPUA           ;UPDATE MEMORY AGAIN TO MAKE SURE DDT + SYMBOL
                        ; TABLE OUT OF CACHE
        CONSZ 200000
         JRST .-1
] ;KL10P
IFN KS10P,[
        WRINT [KSFREQ]          ; 60 cycle clock.
        CONO APRCHN             ; Enable APR faults and clock ints.
        CLRCSH                  ; Is this necessary?  What the heck...
] ;KS10P
IFN CH10P,[
        CONI CHX,T              ;CHECK CHAOS ADDRESS SWITCHES
        LDB T,[$CHXAD,,T]
        CAIE T,MYCHAD
         JRST [ MOVEI TT,[ASCIZ/CHAOSNET ADDRESS SWITCHES ARE SET WRONG/]
                PUSHJ P,T00ASZ
                JRST DDT ]
        CONO CHX,@CHXCNO        ;ENABLE INTERRUPTS
];CH10P
        JRST ICLR
\f
CKML1:                  ;MEM NON-EXISTANT PATCH OUT
IFN KA10P, CONO 10000   ;TURN OFF NXM FLAG
IFN KL10P,[
        CONO 22000
        MOVEI TT,PFAIL
        MOVEM TT,PFNPC
        MOVEI TT,UUOH0
        HRRM TT,MUUOKN
] ;KL10P
IFN KS10P,[
        CONO 20400
        MOVEI TT,PFAIL
        MOVEM TT,EPTPFN
] ;KS10P
        SKIPGE CKMBLK
         MOVEM A,CKMBLK ;HIGHEST IN BLOCK OF LOSERS
CKML1A: LDB TT,[MUR,,MEMBLT(A)]
        CAIE TT,MUFR
         BUG            ;?
        CAIG A,SYSB+1
         JRST 4,.       ;SYS MEM NON EX? (BUG PROBABLY WON'T WORK)
        PUSHJ P,MPOUT2  ;FLUSH THAT BLOCK
        MOVEI TT,MUHOLE
        DPB TT,[MUR,,MEMBLT(A)]
        CAIL A,400      ;IF NXM IN LOW MOBY
         JRST CKML2
        MOVEI U,0
        PUSHJ P,UPLC
        LDB TT,T
        ANDI TT,PMRCM
        CAIE TT,(A)
         JRST CKML2
        DPB U,T         ;PATCH THIS BLOCK OUT OF EXEC MAP
        DPB U,Q
        JRST CKML2

; REPORT A BLOCK OF LOSING MEMORY

CKML6:  PUSH P,A
        MOVEI TT,[ASCIZ/MEM OFF /]
        AOSN CKMFLG
         PUSHJ P,T00ASZ
        ADDI A,1        ;LOWEST LOSER = HIGHEST WINNER + 1 PAGE
        PUSHJ P,T00BKO
        MOVEI A,"-
        PUSHJ P,T00TYO
        MOVE A,CKMBLK
        PUSHJ P,T00BKO
        MOVEI A,40
        PUSHJ P,T00TYO
        SETOM CKMBLK
        POP P,A
        JRST CKML2

USEHM:  -1      ;-1 => USE MEM IN HIGH MOBY (IF PRESET)

CKMBLK: -1      ;IF + HIGHEST LOSING BLOCK IN CONTIG RANGE
CKMFLG: -1      ;IF + PRINTED MESSAGE ALREADY
CKMSWC: 0       ;WRITE CMD
CKMSRC: 0       ;READ CMD.
CKMSSC: 0       ;SEEK CMD.
;UP TO 8 RANGES OF ADDRESSES THAT SHOULD NOT BE USED BECAUSE THEY
;DON'T WORK BUT AREN'T NXM.
MEMLZL: BLOCK 8 ;LOWEST LOC
MEMLZH: BLOCK 8 ;HIGHEST LOC+1
FTUTPG: 0       ;FIRST PAGE USED FOR TUTS
\f
;INPUT CHAR FROM CONSOLE TTY AND ECHO

T00TYI:
IFN KA10P,[
        CONSO TTY,40
         JRST .-1
        DATAI TTY,A
        ANDI A,177
] ;KA10P
IFN KL10P,[
        SETZM DTEFLG
        MOVEI A,%DTTYI
        MOVEM A,DTECMD
        CONO DTE,%DBL11
        SKIPN DTEFLG
         JRST .-1
        SKIPN A,DTEF11
         JRST T00TYI
] ;KL10P
IFN KS10P,[
        SKIPN A,8CTYIN
         JRST .-1
        ANDI A,177
] ;KS10P

; TYPE CHAR IN A ON CONSOLE TTY

T00TYO:
IFN KA10P,[
        CONSZ TTY,20
         JRST .-1
        DATAO TTY,A
] ;KA10P
IFN KL10P,[
        SETZM DTEFLG
        MOVEM A,DTECMD
        CONO DTE,%DBL11
        SKIPN DTEFLG
         JRST .-1
] ;KL10P
IFN KS10P,[
        PUSH P,A
        ANDI A,177
        IORI A,400
        MOVEM A,8CTYOT
        CONI A
        IORI A,80INT
        CONO (A)
        SKIPE 8CTYOT
         JRST .-1
        POP P,A
] ;KS10P
        POPJ P,

; TYPE BLOCK NO IN A AS HIGH 3 OCTAL DIGITS OF ADDR
; (ALL MEMORIES MULTIPLE OF 4K.  MAX MEMORY 2M WORDS.)

T00BKO: PUSH P,A
        PUSH P,B
        LSHC A,-8
REPEAT 3,[
        ADDI A,"0
        PUSHJ P,T00TYO
        MOVEI A,0
        LSHC A,3
]
        JRST POPBAJ

; TYPE ASCIZ IN TT ON T00

T00ASZ: PUSH P,A
        HRLI TT,440700
T00AZ1: ILDB A,TT
        JUMPE A,POPAJ
        PUSHJ P,T00TYO
        JRST T00AZ1
\f
IFN DPKPP,[     ;MAP SYSTEM SPEED CODES TO DATAPOINT KLUDGE CODES
DPSP:   0_9     ;134
        1_9     ;600
        2_9     ;110
        3_9     ;150
        4_9     ;300
        5_9     ;1200
        5_9     ;1800 *
        6_9     ;2400
        7_9     ;4800
REPEAT 20-<.-DPSP>, 7_9 ;FAST *
];DPKPP

CONSTANTS
VARIABLES

IEND:
.HKALL==0

; Define location known as start of SALV disk salvager.  If system overruns
; this address, must either reduce system size or increase the SALV start
; address.  If SALV is changed, the SALV program must also be changed to
; start at the right place.  There is a limit to how high it can go,
; however.
IFN KL10P, SALV==:105*2000      ; MC-KL is getting huge
.ELSE SALV==:100*2000
IFG IEND-SALV,.FATAL System overruns SALV start addr!

IFGE TSYSM-256.,DDT=774000
.ELSE DDT=TSYSM*2000-4000
DSKDMP==DDT+3700

IFG LBUGTB-LBUGT2,[
.ERR MAKE THE BUGTAB BIGGER
INFORM LBUGTB-LBUGT2,\LBUGTB-LBUGT2
.FATAL FATAL ERROR, RUNNING THIS WOULD CAUSE TOTALLY WEIRD BUGS
]

IF2 EXPUNGE FOO,ZZZQ,FNM,ZCHR,ZZ,ZZZ,BUGB,BUGF,BUGN,BUGNN

END BEG         ;START AT BEG TO SALVAGE AND RUN ITS, START AT GO TO JUST ITS