system/disk.1224

   1 ; I T S DISK SERVICE ROUTINES AND FILE SYSTEM  -*-MIDAS-*-
   2 ;;; Copyright (c) 1999 Massachusetts Institute of Technology
   3 ;;;
   4 ;;; This program is free software; you can redistribute it and/or
   5 ;;; modify it under the terms of the GNU General Public License as
   6 ;;; published by the Free Software Foundation; either version 3 of the
   7 ;;; License, or (at your option) any later version.
   8 ;;;
   9 ;;; This program is distributed in the hope that it will be useful,
  10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 ;;; General Public License for more details.
  13 ;;;
  14 ;;; You should have received a copy of the GNU General Public License
  15 ;;; along with this program; if not, write to the Free Software
  16 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17
  18
  19 DSKVRS==.IFNM2
  20 IFN DC10P+RP10P+RH10P+RH11P-1, .ERR WRONG NUMBER OF DISK CONTROLLERS
  21
  22 ;GET DISK PHYSICAL PARAMETERS BY .INSRT'ING APPROPRIATE FILE
  23
  24 IFN DC10P,[
  25 $INSRT DC10
  26 ]
  27
  28 IFN RP10P,[
  29 $INSRT RP10
  30 ]
  31
  32 IFN RH10P,[
  33 $INSRT RH10
  34 ]
  35
  36 IFN RH11P,[
  37 $INSRT RH11
  38 IFE KS10P, .ERR RH11 on something other than a KS10?
  39 IFN RP06P+RP07P+RM03P+RM80P-1, .ERR WRONG NUMBER OF KINDS OF DISK DRIVE
  40 IFN RP06P,[
  41 $INSRT RP06
  42 ]
  43 IFN RP07P,[
  44 $INSRT RP07
  45 ]
  46 IFN RM03P,[
  47 $INSRT RM03
  48 ]
  49 IFN RM80P,[
  50 $INSRT RM80
  51 ]
  52 ]
  53
  54 ;GET FILE SYSTEM DEFINITIONS:
  55 ;       MFD     MASTER FILE DIRECTORY
  56 ;       TUT     TRACK (BLOCK) UTILIZATION TABLE
  57 ;       UFD     USER FILE DIRECTORY
  58
  59 $INSRT FSDEFS
  60
  61 IFN T300P,[
  62 $INSRT T300
  63 ]
  64 \f
  65 SUBTTL MISC FILE SYSTEM CALLS
  66
  67 ADMPCH: UMOVE A,(J)     ;SET OR READ STATUS OF DUMP BIT OF FILE OPEN ON
  68                         ; CHNL IN AC(RH)
  69         MOVEI T,POPJ1   ;MAKE CHNDCD SKIP RETURN IF ALL OK.
  70         PUSHJ P,CHNDCD  ;DECODE RH(A) AS CHNL NUM.
  71          JRST ILUUO     ;NO SKIP IMPLIES BAD CHNL NUM.
  72         TLNN R,%CLSQ
  73          JRST ILUUO     ;NOT DISK CHANNEL.
  74         PUSHJ P,QCHNLT  ;DECODE THE CHNL FURTHER.
  75         MOVSI B,400000
  76         TLNE A,400000
  77          IORM B,UNRNDM(C)
  78         TLNE A,200000
  79          ANDCAM B,UNRNDM(C)
  80         MOVE D,QACTB
  81         TLNE A,600000
  82          IORM D,QSNLCN(H)
  83         LDB A,[430100,,UNRNDM(C)]
  84         PUSHJ P,QUDULK
  85         JRST APTUAJ
  86
  87 NRFDATE:        PUSHJ P,QCHNLT  ;READ FILE CREATION DATE WORD
  88         MOVE A,UNDATE(C)
  89 NRDM1:  PUSHJ P,QUDULK
  90         JRST POPJ1      ;STORE BACK IN USER MEM
  91
  92 NSRDATE:        PUSHJ P,QCHNLT  ; SET REFERENCE DATE
  93         HLRS B
  94         DPB B,[UNREFD+UNREF(C)]
  95         JRST NSDM1
  96
  97 NRESRDT:        PUSHJ P,QCHNLT  ; RESTORE REFERENCE DATE
  98         HLRZ A,OLDRDT(R)        ; WHOEVER CHOSE R IN QCHNLC SHOULD BE SHOT
  99         DPB A,[UNREFD+UNREF(C)]
 100         JRST NSDM1
 101
 102 NSFDATE:        PUSHJ P,QCHNLT  ;SET FILE CREATION DATE WORD
 103         MOVEM B,UNDATE(C)
 104 NSDM1:  MOVE TT,QACTB
 105         IORM TT,QSNLCN(H)
 106 QUDUL1: AOS (P)
 107         JRST QUDULK
 108
 109
 110 NRDMPBT:        PUSHJ P,QCHNLT  ;READ FILE DUMPED BIT
 111         LDB A,[430100,,UNRNDM(C)]
 112         JRST NRDM1
 113
 114 NSDMPBT:        PUSHJ P,QCHNLT  ;SET FILE DUMPED BIT
 115         DPB B,[430100,,UNRNDM(C)]
 116         JRST NSDM1
 117
 118 NLNKEDP:
 119         PUSHJ P,QCHNLT          ;RETURN NONZERO IF WE TRACED LINKS TO GET THIS FILE.
 120         MOVE T,QSRAC(R)
 121         LDB A,[.BP (%QALOP),T]
 122         JRST NRDM1
 123
 124 NFILBLK:PUSHJ P,QCHNLT  ;READ ALL 5 PARAMETERS OF NAME AREA
 125         MOVE A,(C)
 126         MOVE B,1(C)
 127         MOVE D,3(C)
 128         MOVE E,4(C)
 129         MOVE C,2(C)
 130         JRST NRDM1      ; UNLOCK DIR AND STORE ARGUMENTS
 131
 132 QCHNLT: TLNN R,%CLSQ    ;IS CHNL A DISK CHNL?
 133          JRST [SUB P,[1,,1] ? JRST OPNL34]
 134         HLRZ R,H
 135         MOVE H,QUDPR(R)
 136         PUSHJ P,QUDLK
 137         MOVE C,QSNLCN(H)
 138         ADD C,QUDFPR(R)
 139         POPJ P,
 140 \f
 141 IFN QAUTHP,[
 142 ASAUTH: PUSHJ P,QCHNLT  ;SET AUTHOR OF FILE
 143         PUSH P,C
 144         JUMPE B,ASAUT4  ;SETTING AUTHOR TO 0
 145         MOVE J,QSNMI(H)
 146         CAMN B,QSNUD(H)
 147          JRST ASAUT1
 148         MOVE C,B
 149         PUSHJ P,QFL
 150          SKIPA
 151           JRST ASAUT1
 152         SETZM C
 153         MOVEI J,5
 154         MOVE TT,[440600,,B]
 155         MOVE I,[440600,,C]
 156         ILDB D,TT
 157         IDPB D,I
 158 ASAUT2: ILDB D,TT
 159         CAIG D,'Z
 160         CAIGE D,'A
 161          JRST ASAUT3
 162         IDPB D,I
 163         SOJG J,ASAUT2
 164         JRST ASAUT4
 165
 166 ASAUT3: PUSHJ P,QFL
 167 ASAUT4:  SETOM J
 168 ASAUT1: POP P,C
 169         DPB J,[UNAUTH+UNREF(C)]
 170         JRST NSDM1
 171
 172 ARAUTH: PUSHJ P,QCHNLT  ;READ CREATOR OF FILE
 173         LDB B,[UNAUTH+UNREF(C)]
 174         MOVEI A,0       ;RETURN VALUE IS 0 IF UNKNOWN OR ILLEGAL AUTHOR
 175         CAIL B,NUDSL
 176          JRST NRDM1
 177         LSH B,1
 178         MOVEI B,2000-<NUDSL*2>(B)
 179         ADD B,QMDRO
 180         MOVE A,(B)
 181         JRST NRDM1
 182 ];QAUTHP
 183
 184 ASREAP: PUSHJ P,QCHNLT          ;SET NO REAP BIT
 185         DPB B,[.BP (UNREAP),UNRNDM(C)]
 186         JRST NSDM1
 187
 188 ARQDAT: CONO PI,CLKOFF  ;GET DSK TIME AND DATE
 189         SKIPL A,QDATE
 190         HRR A,TIMOFF
 191         MOVE B,QDATEI   ;2ND VALUE = DATE & TIME SYS CAME UP, IN DISK FORMAT.
 192         CONO PI,CLKON
 193         JRST POPJ1
 194
 195 ADSKUP: PUSHJ P,QCHNLT  ;SET CREATION DATE, REF DATE AND CLEAR DUMP BIT
 196         CONO PI,CLKOFF
 197         SKIPL TT,QDATE
 198          HRR TT,TIMOFF
 199         CONO PI,CLKON
 200         MOVEM TT,UNDATE(C)
 201         HLRS TT
 202         DPB TT,[UNREFD+UNREF(C)]
 203         MOVSI TT,UNDUMP
 204         ANDCAM TT,UNRNDM(C)
 205         JRST NSDM1
 206
 207 DELEWO: TLNN R,%CLSQ    ;DELETE WHILE OPEN
 208          JRST OPNL34    ;WRONG TYPE DEVICE
 209         PUSHJ P,QCHNLT
 210         PUSH P,W
 211         PUSH P,C
 212         MOVEI W,4
 213         MOVE A,UNFN1(C) ;Get names of file being hacked.
 214         MOVE B,UNFN2(C)
 215         MOVE C,QSNUD(H)
 216         PUSHJ P,MNGDIR  ;If this is a sanctified dir
 217          PUSHJ P,SYSDSK ; get SYS job to tattle about it.
 218         POP P,C
 219         POP P,W
 220         MOVSI T,%QADEL  ;SET DELETE BIT IN QSK CHNL
 221         IORM T,QSRAC(R)
 222         MOVSI T,UNCDEL  ;AND IN FILE
 223         IORM T,UNRNDM(C)
 224         JRST NSDM1
 225 \f
 226 ;.CALL FILLEN
 227 ;RETURNS (1) FILE LENGTH IN BYTES (BYTE SIZE CURRENTLY OPEN IN)
 228 ;        (2) BITS PER BYTE (BYTE SIZE CURRENTLY OPEN IN)
 229 ;        (3) FILE LENGTH IN BYTES (BYTE SIZE WRITTEN IN)
 230 ;        (4) BITS PER BYTE (BYTE SIZE WRITTEN IN)
 231
 232 NFILLEN:PUSHJ P,QCHNLT
 233         MOVE A,QSRAC(R)
 234         TLNE A,%QALNK
 235          JRST OPNL34    ;NOT A FILE
 236         SKIPGE QSCRW(R)
 237          TLNE A,%QAMWO
 238           JRST NFILL1   ;READ CHANNEL OR WRITE-OVER, GET FILE'S STORED LENGTH.
 239         MOVE A,QFBLNO(R);NORMAL WRITE, GET ACCESS POINTER.
 240         SKIPGE QSMDN(R)
 241          JRST NFILL2    ;NO BUFFER ACTIVE
 242         ADD A,QMPBSZ(R) ;END OF CURRENT BUFFER
 243         SUB A,QSMPRC(R) ;BACK UP TO CURRENT LOC
 244 NFILL2: PUSHJ P,QUDULK
 245         LDB B,[QSBSIZ(R)]       ;CURRENT BYTE SIZE
 246         MOVE D,B        ;WRITTEN BYTE SIZE SAME AS CURRENT
 247         MOVE C,A        ;WRITTEN LENGTH SAME AS CURRENT
 248         JRST POPJ1
 249
 250 NFILL1: LDB TT,[UNDSCP+UNRNDM(C)]
 251         IDIVI TT,UFDBPW
 252         HLL TT,QBTBLI(I)        ;GET DESCRIPTOR POINTER
 253         LDB E,[UNWRDC+UNRNDM(C)]
 254         SKIPN E
 255          MOVEI E,2000           ;E GETS NUMBER OF WORDS IN LAST BLOCK
 256         LDB D,[UNBYTE+UNREF(C)] ;D GETS BYTE INFO
 257         ANDI C,-2000            ;C GETS BASE ADDR OF DIR
 258         ADDI TT,UDDESC(C)       ;TT GETS DESC PNTR
 259         SETOM A                 ;INITIALIZE NUMBER OF BLOCKS IN FILE
 260         PUSHJ P,NFLLN1          ;A GETS NUMBER OF BLOCKS IN FILE MINUS ONE
 261         PUSHJ P,QUDULK
 262         IMULI A,2000            ;NUMBER OF WORDS IN COMPLETE BLOCKS
 263         ADD A,E                 ;ADD WORDS IN LAST BLOCK
 264         PUSHJ P,QBDCD           ;D GETS BYTE SIZE, E NUMBER OF RESIDUE BYTES
 265         MOVEI Q,36.
 266         IDIV Q,D                ;Q GETS BYTES PER WORD
 267         MOVE C,A                ;C WRITTEN LENGTH, A CURRENT (B.S. DIFFERENT)
 268         IMUL C,Q                ;CONVERT WORD LENGTH TO BYTES
 269         SUB C,E                 ;C NOW HAS CORRECT WRITTEN LENGTH
 270         IMUL E,D                ;E GETS NUMBER OF RESIDUE BITS
 271         LDB B,[QSBSIZ(R)]       ;B GETS BYTE SIZE OPENED IN
 272         IMULI A,@QSBYTE(R)      ;A GETS LENGTH IN THOSE SIZE BYTES
 273         IDIV E,B                ;NUMBER OF RESIDUE BYTES, -ROUNDING DOWN-
 274         SUB A,E                 ;ADJUST THE LENGTH
 275         JRST POPJ1              ;RETURN VALUES IN A,B,C,D
 276
 277 NFLLN2: ADD A,B         ; NEXT N BLOCKS
 278 NFLLN1: ILDB B,TT       ; GET NEXT DESC BYTE
 279         JUMPE B,CPOPJ   ; NO MORE
 280         CAIG B,UDTKMX
 281          JRST NFLLN2    ; TAKE-N
 282         CAIGE B,UDWPH
 283          AOJA A,NFLLN1  ; SKIP-N, TAKE-1
 284         CAIN B,UDWPH
 285          JRST NFLLN1    ; IGNORE WRITE-PLACEHOLDER
 286 REPEAT NXLBYT, IBP TT   ; LOAD-ADDRESS, TAKE-1
 287         AOJA A,NFLLN1
 288 \f
 289 ;DIRSIZ - READ OR SET DISK QUOTAS, READ # BLOCKS IN ALL FILES IN DIRECTORY.
 290 ;1ST VALUE IS GRIM REAP QUOTA,,DIR SIZE
 291 ;2ND VALUE IS 0 OR PACK#,,ALLOCATION FOR DIR ALLOCATED TO SPECIFIC PACK
 292 ;LH OF 2ND ARG SETS GRIM REAP QUOTA; 3RD ARG SETS PACK#,,ALLOCATION
 293 NDIRSI: MOVE D,C
 294         PUSHJ P,QCHNLT
 295         MOVE C,QSNLCN(H)
 296         MOVE A,UDBLKS(C)
 297         JUMPL B,NDIRS1
 298         CAIE W,1
 299          HLLM B,UDBLKS(C)
 300 NDIRS1: MOVE B,UDALLO(C)
 301         CAILE W,2
 302          MOVEM D,UDALLO(C)
 303 IFN QRSRVP,[
 304         HLRZS D                 ;PACK ALLOCATED TO
 305         SETO E,
 306         JUMPE D,NDIRS2
 307         MOVEI E,NQS-1           ;UPDATE ALLOC DRIVE NUM
 308         CAME D,QPKID(E)
 309          SOJGE E,.-1
 310 NDIRS2: MOVEM E,QSALLO(H)
 311 ];QRSRVP
 312         JRST NSDM1
 313 \f
 314 SUBTTL DISK OPEN ROUTINES
 315
 316 %DO==1,,525252  ;Special mode bits for disk opens.
 317 %DOWOV==100000  ;Write over mode
 318 %DONRF==10      ;Don't set ref-date
 319 %DONLK==20      ;Don't chase links; actually open the link itself.
 320 %DORWT==40      ;Make readers wait (used on opens for write or write-over).
 321
 322 IFN TPLP+UNSPLP,[
 323 TPLO:   MOVE C,[SIXBIT /.LPTR./] ;PSEUDO LINE PRINTER (DISC)
 324         JUMPGE D,TPLO2
 325         MOVE B,UNAME(U)
 326         AOS A,TPLFNO    ;GENERATE RANDOM FILE NAME
 327         JRST TPLO2
 328 ]
 329
 330 COMO:   SKIPA C,[SIXBIT /COMMON/]       ;.OPEN ENTRY FOR "COM" DEVICE
 331 SYSO:    MOVSI C,(SIXBIT /SYS/)         ; " FOR "SYS" DEVICE
 332 TPLO2:  MOVEM C,USYSN1(U)
 333         MOVNI I,1
 334         JRST QSKO
 335
 336 QSKPO:  MOVSI TT,-NQS   ;PACK # OPEN
 337         CAME I,QPKID(TT)
 338          AOBJN TT,.-1   ;I <= PHYSICAL UNIT WITH SPECIFIED PACK
 339         JUMPL TT,QSKPO1
 340         PUSHJ P,QPKNFP
 341          JRST QSKPO
 342         CAIE W,4        ;IF RENAME/DELETE, OK, DOESN'T TOUCH FILE ANYWAY
 343          JRST OPNL16    ;OTHERWISE COMPLAIN PACK NOT MOUNTED
 344 QSKPO1: HRRZ I,TT
 345 QSKUO:  CAIGE I,NQS     ;DISK UNIT # OPEN
 346          SKIPE QACT(I)  ;I <= UNIT #
 347           JRST OPNL10   ;BAD UNIT # OR NOT ENGAGED
 348 IFE MCOND DM,[  ;; Security check in reserved pack feature only on DM.
 349 IFN QRSRVP,[
 350         JUMPN W,QSKOB   ;WRITE-OVER OR RENAME OK.
 351         JUMPGE D,QSKOB  ;READ OK.
 352         SKIPE QRESRV(I) ;WRITE: IS PACK ON THIS DRIVE RESERVED?
 353          JRST OPNL10    ;YES, CAN'T WRITE ON IT.
 354 ];QRSRVP
 355 ];DM
 356         JRST QSKOB
 357
 358 ;DNRF: DEVICE IS LIKE DSK: BUT DOESN'T SET REFERENCE DATE
 359 DNRFO:  TRO D,%DONRF/2  ;SET MODE BIT AND DROP INTO QSKO
 360
 361 ; Regular DSK: device
 362 ;
 363 ; RH(D) has open mode, rotated 1 bit right.
 364 ; W has operation code (0=r/w, 2=link, 4=del/rnm, 1=wov)
 365
 366 QSKO:   MOVNI I,1       ;DSK OPEN, I <= # DETERMINED BY SYS
 367 QSKOB:  MOVEM I,EPDL(U) ;SAVE DISK #
 368         MOVE C,USYSN1(U)
 369         CAIN W,4
 370          JUMPE A,QSKOB2 ;IF RENAME OF OPEN FILE TRAP OUT
 371 QSKOA:  MOVE I,MDSK     ;IS MFD IN?
 372         PUSHJ P,QMCH1   ;READ IN MFD OF MASTER DISK
 373         CLEARM QLD(U)   ;LINK DEPTH
 374 QSKOL:  PUSHJ P,MFDCK
 375          JRST SYSDS2
 376         JUMPN W,OPNL11
 377         JUMPL D,OPNL11  ;MUST BE NORMAL READ
 378         JRST QMLSTF     ;USER WANT TO READ THE MASTER DIRECTORY
 379
 380 MFDCK:  CAMN A,[SIXBIT /M.F.D./]
 381         CAME B,[SIXBIT /(FILE)/]
 382          POPJ P,
 383         JRST POPJ1
 384 \f
 385 SYSDS2: PUSHJ P,QFLD    ;H <= PTR TO USER DIR TABLE
 386          PUSHJ P,QSKO1  ;LOSER DIR NOT IN CORE
 387         SKIPG QSNNR(H)
 388          BUG
 389         PUSHJ P,QUDLK   ;RETURN WITH SOS OF QSNNR ON LSWPR
 390         MOVSI TT,40000
 391         TDNE TT,QSNLCN(H)
 392          JRST QSKDP1    ;PAW OVER USER DIRECTORY
 393 QSKDP2: PUSHJ P,QUDULK
 394         PUSHJ P,FLDRCK
 395          JRST QSKDP9    ;NOT SPECIAL DIRECTORY FILE
 396         JUMPN W,QPNL11
 397         JUMPL D,QPNL11
 398         JRST QLISTF     ;USER WANTS TO READ HIS USER DIRECTORY
 399
 400 QSKDP9: JUMPN W,QSKDPY  ;If doing IO?
 401          SKIPL D        ; and reading
 402           JRST QSKDPZ   ;  then don't bother with "security".
 403 QSKDPY: PUSHJ P,MNGDIR  ;Else if this is a sanctified dir
 404          PUSHJ P,SYSDSK ; get SYS job to tattle about it.
 405 QSKDPZ: JUMPL D,QWRO    ;WRITE
 406         CAIN W,4
 407          JRST QRNAM     ;RENAME/DEL
 408         CAIN W,2
 409          JRST QALINK    ;MAKE LINK
 410         JUMPN W,QPNL22
 411 QWROR:  JUMPE A,QPNL11  ;ALSO ENTER FOR VARIOUS WRITE OVER, COPY OVER MODES
 412         JUMPE B,QPNL11
 413         PUSHJ P,QCHNF   ;GET CHANNEL FOR READ
 414         PUSHJ P,LOSSET
 415             QCHNRT
 416         PUSHJ P,QUDLK   ;LOCK USER DIR
 417         PUSHJ P,QLOOK   ;LOOK UP FILE
 418          JRST [ PUSHJ P,QROR1C  ;Not found => decide whethe error or wait.
 419                  POPJ P,        ;Error (error code already set up).
 420                 PUSHJ P,QUDULK  ;If retrying, first unlock directory,
 421                 PUSHJ P,LSWPOP  ;Return the channel,
 422                 PUSHJ P,UDELAY  ;Wait a little while,
 423                 JRST QWROR]     ;Try again.
 424         TRNE D,3        ;SKIP IF UNIT ASCII MODE
 425          JRST QSKO2
 426         MOVE J,[440700,,5] ;BYTE SIZE IS 7 BITS
 427         MOVEM J,QSBYTE(E)
 428 QSKO2:  HLLZ J,QSBYTE(E) ;GET PROPER BYTE POINTER LH
 429         MOVEM J,QSMPRP(E)
 430         TRNN D,%DONRF/2 ;3.4 BIT IN OPEN IMPLIES DONT SET REFERENCE DATE
 431          PUSHJ P,QFREF  ;"REFERENCE" FILE
 432         MOVE C,Q
 433         SUB C,QSNLCN(H)
 434         HRRZM C,QUDFPR(E)       ;SET UP PTR FROM CHNL TO FILE NAME AREA
 435         LDB TT,[UNDSCP+UNRNDM(Q)]       ;FOUND FILE SET UP CHNL
 436         MOVEM TT,QDIRP(E)       ;SET UP CHAR PTR TO DESC AREA
 437         MOVE C,UNRNDM(Q)
 438         TLNE C,UNLINK
 439          JRST QLINK     ;FILE IS A LINK
 440         MOVSI C,%QALOP
 441         SKIPE QLD(U)    ;IF WE TRACED A LINK TO OPEN THE FILE, REMEMBER THAT.
 442          IORM C,QSRAC(E)
 443         MOVSI C,%QARWT
 444         TRNE D,%DORWT/2
 445          IORM C,QSRAC(E)
 446         LDB J,[UNPKN+UNRNDM(Q)] ;GET PACK NUMBER FILE IS ON
 447         MOVSI I,-NQS
 448         CAME J,QPKID(I)
 449          AOBJN I,.-1    ;TRANSLATE LOGICAL TO PHYSICAL DISK UNIT
 450         JUMPGE I,QPKNF  ;PACK NOT ON *
 451         HRRZM I,QDSKN(E)        ;SET CHNL DISK NUMBER
 452         JUMPL D,QWROR1  ;REALLY WANT TO WRITE OVER, ETC
 453         MOVEI TT,%QMRD  ;PUT CHANNEL IN NORMAL READ MODE
 454         HRRM TT,QSRAC(E)
 455 QOEX1:  PUSHJ P,QUDULK  ;UNLOCK USER DIR
 456         PUSHJ P,LSWDEL  ;QUSR ENTRY
 457         PUSHJ P,LSWDEL  ;QSNNR ENTRY
 458         SKIPG QSNNR(H)
 459          BUG
 460         PUSHJ P,QSTRTR
 461         MOVE C,D
 462         ROT C,1
 463         HRL A,E
 464         JSP Q,OPSLC7    ;SET UP IOCHNM AND DEPART
 465             DQUAI,,DQUAO
 466             DQBI,,DQBO
 467             DQUII,,DQUIO
 468             DQBI,,DQBO
 469 \f
 470 QWROR1: SOJN W,OPNL12   ;NORMAL WRITE OVER MODE
 471         HRRZS H         ;CLEAR GARBAGE IN USER DIR NUM
 472         HRRZS E         ;CLEAR GARBAGE IN CHNL NUM
 473         HRRZ J,QUDFPR(E) ;PICK UP LOCN OF FILE WITH U.F.D
 474         MOVSI I,-NQCHN  ;MAKE SURE THIS FILE NOT OPEN FOR READING
 475 QROR1A: CAIE E,(I)      ;DONT GET FAKED OUT BY OWN CHNL
 476          SKIPGE QUSR(I)
 477           JRST QROR1B
 478         CAMN H,QUDPR(I)
 479          CAME J,QUDFPR(I)
 480           JRST QROR1B
 481         JRST  OPNL23
 482
 483 QROR1B: AOBJN I,QROR1A
 484         PUSHJ P,QAUTH
 485         MOVSI TT,UNWRIT
 486         IORM TT,UNRNDM(Q)       ;SET WRITE BIT
 487         MOVSI TT,UNDUMP
 488         ANDCAM TT,UNRNDM(Q)
 489         PUSH P,D
 490         PUSH P,Q
 491         PUSH P,R
 492         PUSH P,E        ;CONVERT FROM ORIGINAL BYTE SIZE TO ONE OPENED IN NOW
 493         LDB D,[UNBYTE+UNREF(Q)]
 494         PUSHJ P,QBDCD   ;GET INFO FROM ORIGINAL WRITE OF FILE
 495         MOVEI Q,36.
 496         IDIV Q,D        ;BYTES PER WORD
 497         SUB Q,E         ;# VALID BYTES
 498         IMUL Q,D        ;VALID BITS IN LAST WORD
 499         POP P,E         ;RESTORE QSK CHNL #
 500         HRRZ R,QSBYTE(E);BYTES PER WORD IN NEW BYTE SIZE
 501         LDB J,[QSBSIZ(E)] ;BITS PER BYTE IN NEW BYTE SIZE
 502         IDIV Q,J        ;NUMBER OF NEW-SIZE BYTES IN LAST WORD
 503         SUB R,Q         ;RESIDUE IN NEW-SIZE BYTES
 504         LDB Q,[QSBSIZ(E)] ;NEW BYTE SIZE
 505         PUSHJ P,QBENC   ;RH(Q) GETS NEW BYTE INFO
 506         MOVE R,-1(P)
 507         DPB Q,[UNBYTE+UNREF(R)] ;CLOBBER FILE'S BYTE SIZE
 508         POP P,R
 509         POP P,Q
 510         POP P,D
 511         CONO PI,CLKOFF
 512         SKIPL TT,QDATE
 513          HRR TT,TIMOFF
 514         CONO PI,CLKON
 515         MOVEM TT,UNDATE(Q)
 516         HLRS TT
 517         DPB TT,[UNREFD+UNREF(Q)]
 518         HLLM TT,OLDRDT(E)
 519         MOVE TT,QACTB
 520         IORM TT,QSNLCN(H)
 521         MOVSI TT,%QAMWO         ;WRITE OVER MODE
 522         IORM TT,QSRAC(E)        ;LEAVE %QMIDL UNTIL FIRST .IOT SINCE
 523         JRST QOEX1              ; THE USER WILL PROBABLY DO A .ACCESS
 524
 525 ;Call here if lookup fails on open.
 526 ;Either signal some error and return,
 527 ;or skip-return if caller should wait and retry the lookup.
 528 ;Assumes H has dir slot, Q has address of filename block,
 529 ;E has channel number allocated for this open.
 530 ;Clobbers C, J.
 531 QROR1C: HRRZ C,QSNLCN(H)
 532         SUBI Q,-LUNBLK(C)
 533         SKIPL Q         ;SEE IF STILL POINTED INSIDE DIR
 534         CAILE Q,2000-LUNBLK
 535          JRST QROR1D    ;NO - REALLY FNF
 536         ADDI Q,(C)
 537         CAMN A,UNFN1(Q) ;DO NAMES MATCH?
 538         CAME B,UNFN2(Q)
 539          JRST QROR1D    ;NO - REALLY FNF
 540         HRRZ J,Q        ;Find channel that has this file open.
 541         SUB J,QSNLCN(H)
 542         ANDI J,-1
 543         HRRZS H         ;Clear garbage in user dir num
 544         HRRZS E         ;Clear garbage in chnl num
 545         MOVSI I,-NQCHN
 546 QROR1E: CAIE E,(I)      ;Dont get faked out by our own chnl.
 547          SKIPGE QUSR(I)
 548           JRST QROR1F
 549         CAMN H,QUDPR(I)
 550          CAME J,QUDFPR(I)
 551           JRST QROR1F
 552 ;Found the channel.  Does it want us to wait?
 553         MOVE I,QSRAC(I)
 554         TLNN I,%QARWT
 555          JRST OPNL23    ;He didn't say so => get "file locked".
 556         JRST POPJ1
 557
 558 QROR1F: AOBJN I,QROR1E
 559         JRST POPJ1      ;Cannot find channel => maybe was closed.  Retry.
 560
 561 QROR1D: SKIPN QLD(U)
 562          JRST OPNL4     ;FILE NOT FOUND
 563         JRST OPNL47     ;LINK WAS FOUND, BUT NOT THE FILE IT POINTED TO
 564 \f
 565 ;COME HERE FOR RENAME-WHILE-OPEN
 566 QSKOB2: HRRZ A,B        ;DO RENAME WHILE OPEN HERE TO AVOID
 567         CAIL A,20       ;IN CASE SYS NAME HAS CHANGED
 568          JRST OPNL14
 569         SKIPE SRN3(U)
 570          SKIPN SRN4(U)
 571           JRST OPNL11
 572         ADD A,U
 573         HLRZ E,IOCHNM(A)
 574         MOVE H,QUDPR(E)
 575         MOVE A,SRN3(U)
 576         MOVE B,SRN4(U)
 577         PUSHJ P,MFDCK
 578          JRST .+2
 579           JRST QPNL11
 580         PUSHJ P,FLDRCK
 581          JRST .+2
 582           JRST QPNL11
 583         PUSHJ P,QUDLK
 584         MOVE Q,QUDFPR(E)
 585         ADD Q,QSNLCN(H)
 586         PUSHJ P,QGRLSC  ;EITHER NAME > OR <?
 587          JRST OPNL11    ;BOTH-BARF
 588           PUSHJ P,QFNG  ;ONE- COMPUTE EFFECTIVE FILE NAME
 589         MOVE C,QSNUD(H)
 590         PUSHJ P,MNGDIR  ;If RENMWOing in sanctified directory
 591          PUSHJ P,SYSDSK ; Tattle.
 592         MOVE I,Q        ;IN CASE GO TO QRNAM4
 593         LDB TT,[$QAMOD,,QSRAC(E)]
 594         SKIPL QSCRW(E)  ;SKIP IF WRITE BLOCK (WRITE FILE) MAYBE 0 FOR WRITEOVER
 595          JUMPE TT,QRNAM4        ;JUMP IF READ FILE
 596         PUSHJ P,QRELOC
 597         MOVE TT,QACTB
 598         IORM TT,QSNLCN(H)
 599         PUSHJ P,QUDULK
 600         JRST POPJ1
 601 \f
 602 SUBTTL PAW OVER USER DIRECTORY
 603
 604 QSKDP1: ANDCAB TT,QSNLCN(H)
 605         PUSH P,A
 606         PUSH P,B
 607         PUSH P,C
 608         PUSH P,D
 609         PUSH P,I
 610         PUSH P,W
 611         MOVE C,UDNAMP(TT)
 612         ADDI C,(TT)     ;ADDR OF BEGINNING OF NAME AREA
 613         MOVEI D,2000(TT)        ;D => FROM POINTER
 614         MOVE I,D        ;I => TO POINTER
 615         HRLOI E,377777  ;PREVIOUS FN1 (BIT 4.9 COMPLEMENTED)
 616         MOVE W,E        ;FN2
 617         MOVEI J,0       ;J NEGATIVE => NEED SORT, NON-ZERO => DIR MODIFIED
 618 QSKDP4: SUBI I,LUNBLK
 619 QSKDP5: SUBI D,LUNBLK
 620         CAMLE C,D
 621          JRST QSKDP8    ;THROUGH
 622         SKIPN A,UNFN1(D)
 623          SKIPE UNFN2(D)
 624           JRST QSKDP3
 625         HLLOS J
 626         JRST QSKDP5     ;NAME BLOCK FREE
 627
 628 QSKDP3: MOVE Q,UNRNDM(D)
 629         TLNN Q,UNIGFL
 630          JRST QSKDPR    ;NOT OPEN FOR WRITE OR BEING DELETED
 631         HLLOS J         ;NEED TO WRITE OUT DIR
 632         SKIPN A,UNFN1(D)
 633          MOVSI A,(SETZ)
 634         SKIPN B,UNFN2(D)
 635          MOVSI B,(SETZ)
 636 QSKDP7: PUSHJ P,QGRLSC  ;DON'T CREATE ANY FILE WITH NAME OF < OR >
 637          AOJA A,QSKDPA  ;CHANGE BOTH JUST TO BE SURE
 638           AOJA A,QSKDPA
 639         MOVE Q,QSNLCN(H)        ;SEE IF THAT NAME EXISTS
 640         MOVEI Q,2000-LUNBLK(Q)  ;THERE MAY BE DUPLICATE ENTRIES
 641 QSKDPU: CAMN A,UNFN1(Q) ;DURING THIS SEARCH BUT IT DOESN'T
 642          CAME B,UNFN2(Q)        ;MATTER
 643           JRST QSKDPT
 644         CAIE Q,(D)      ;DON'T CHANGE NAME IF NOT DUPLICATE
 645 QSKDPA:  AOJA B,QSKDP7  ;FOUND IT.  CHANGE SECOND NAME
 646 QSKDPT: SUBI Q,LUNBLK
 647         CAMG C,Q
 648          JRST QSKDPU
 649         MOVEM A,UNFN1(D)
 650         MOVEM B,UNFN2(D)
 651         MOVSI Q,UNIGFL
 652         ANDCAM Q,UNRNDM(D)
 653 QSKDPR: CAMN D,I
 654          JRST QSKDP6
 655         HRLZ Q,D        ;RELOCATE FILE BLOCK
 656         HRR Q,I
 657         BLT Q,LUNBLK-1(I)
 658 QSKDP6: JUMPL J,QSKDP4  ;ALREADY NEEDS SORT
 659         MOVE B,UNFN2(D) ;MAY NOT HAVE YET IF GOT HERE FASTEST WAY
 660         TLC A,(SETZ)
 661         TLC B,(SETZ)
 662         EXCH A,E
 663         EXCH B,W
 664         CAMLE A,E
 665          JRST QSKDP4    ;ORDER OK
 666         CAMN A,E
 667          CAMGE B,W
 668           MOVNI J,1     ;NEED SORT
 669         JRST QSKDP4
 670 \f
 671 QSKDP8: ADDI I,LUNBLK   ;I POINTED TO EMPTY SLOT
 672         MOVE D,I
 673         SUBI D,(TT)
 674         EXCH D,UDNAMP(TT)
 675         ADDI D,(TT)
 676         CAML D,I
 677          JRST QSKDPV
 678         SETZM (D)       ;CLEAR VACATED AREA
 679         HRLS D
 680         ADDI D,1
 681         BLT D,-1(I)
 682 QSKDPV: JUMPL J,QSKDPS  ;SORT
 683         TRNN J,-1
 684          JRST QSKDPK
 685 QSKDPX: MOVE I,QACTB
 686         IORM I,QSNLCN(H)
 687 QSKDPK: MOVE W,QSNLCN(H)
 688 IFN QRSRVP,[
 689         HLRZ A,UDALLO(W)        ;IF THIS DIR HAS ALLOCATION
 690         JUMPE A,QSKBK0
 691         MOVEI B,NQS-1           ;CONVERT PACK # TO DRIVE #
 692         CAME A,QPKID(B)
 693          SOJGE B,.-1
 694         SKIPGE A,B
 695 QSKBK0:  SETO A,                ;ALLOCATED PACK NOT MOUNTED, USE ANY
 696         MOVEM A,QSALLO(H)       ;SAVE DRIVE # (-1 IF NONE)
 697 ];QRSRVP
 698         HLLZS UDBLKS(W)
 699         MOVE A,UDNAMP(W)
 700         ADDI A,(W)
 701 QSKBK1: CAIL A,2000(W)  ;COUNT BLOCKS USED
 702          JRST QSKBK2
 703         MOVE B,UNRNDM(A)
 704         TLNE B,UNLINK
 705          JRST QSKBK3
 706         LDB B,[UNDSCP+UNRNDM(A)]
 707         IDIVI B,UFDBPW
 708         HLL B,QBTBLI(C)
 709         ADDI B,UDDESC(W)        ;B GETS BYTE PNTR TO DESC
 710 QSKBK4: ILDB C,B
 711         JUMPE C,QSKBK3
 712         CAIN C,UDWPH
 713          JRST QSKBK4
 714         CAIG C,UDTKMX
 715          JRST [ADDM C,UDBLKS(W) ? JRST QSKBK4]
 716         CAIG C,UDWPH
 717          JRST [AOS UDBLKS(W) ? JRST QSKBK4]
 718         REPEAT NXLBYT, IBP B
 719         AOS UDBLKS(W)
 720         JRST QSKBK4
 721
 722 QSKBK3: ADDI A,LUNBLK
 723         JRST QSKBK1
 724
 725 QSKBK2: POP P,W
 726         POP P,I
 727         POP P,D
 728         POP P,C
 729         POP P,B
 730         POP P,A
 731         JRST QSKDP2
 732 \f
 733 QSKDPS: MOVEI T,LUNBLK
 734         ADD P,[3,,3]
 735 QSKDPB: MOVEI Q,(I)     ;BEGINNING OF NAME AREA
 736         SKIPGE T
 737          MOVEI Q,2000-LUNBLK(TT)        ;START AT END
 738         MOVEI W,2000(TT)
 739         SKIPGE T
 740          MOVEI W,-LUNBLK(I)
 741         SETZM (P)
 742         TDZA J,J        ;0 => SORTED  -1 => MAKE ANOTHER PASS
 743 QSKDPE:  ADD Q,T
 744         CAIE Q,(W)
 745          JRST QSKDPC
 746         JUMPE J,QSKDPW
 747         MOVNS T
 748         JRST QSKDPB
 749
 750 QSKDPW: SUB P,[3,,3]
 751         JRST QSKDPX
 752
 753 QSKDPC: SKIPN A,UNFN1(Q)
 754          SKIPE UNFN2(Q)
 755           JRST QSKDPD
 756         BUG
 757
 758 QSKDPD: MOVE B,UNFN2(Q)
 759         TLC A,(SETZ)
 760         TLC B,(SETZ)
 761         SKIPE E,(P)     ;FIRST ENTRY
 762          JRST QSKDPF
 763 QSKDPG: MOVEM A,-2(P)
 764         MOVEM B,-1(P)
 765 QSKDPI: MOVEM Q,(P)
 766         JRST QSKDPE
 767
 768 QSKDPF: JUMPL T,QSKDPJ
 769         CAMLE A,-2(P)
 770          JRST QSKDPG
 771         CAME A,-2(P)
 772          JRST QSKDPH
 773         CAML B,-1(P)
 774          JRST QSKDPG
 775 QSKDPH: REPEAT LUNBLK,[
 776         EXCH A,.RPCNT(E)
 777         EXCH A,.RPCNT(Q)
 778         EXCH A,.RPCNT(E)
 779 ]
 780         MOVNI J,1
 781         JRST QSKDPI
 782
 783 QSKDPJ: CAMGE A,-2(P)
 784          JRST QSKDPG
 785         CAME A,-2(P)
 786          JRST QSKDPH
 787         CAMG B,-1(P)
 788          JRST QSKDPG
 789         JRST QSKDPH
 790 \f
 791 SUBTTL OPEN FOR WRITE
 792
 793 ;RETURNS WITH QUSR(E) AND QSNLCN(E) ON LSWPR
 794 QWRO2:  JUMPE A,QPNL11
 795         JUMPE B,QPNL11
 796         SKIPGE I,EPDL(U)        ;PICK UP DESIRED DISK UNIT
 797          JRST QWRO2A    ;SYSTEMS CHOICE
 798 QWRO2B: CAIGE I,NQS
 799          SKIPE QACT(I)
 800           BUG           ;WE LOST SOMEHOW...
 801         MOVE TT,QTUTO(I)
 802         SKIPL QDPWF(I)  ;TUT IN BUT NOT PAWED OVER
 803          TLNE TT,40000  ;TUT NOT IN
 804           PUSHJ P,QTCH1 ;READ IN TUT OF DISK INVOLVED
 805         PUSHJ P,QCHNF   ;GET CHANNEL
 806         PUSHJ P,LOSSET
 807             QCHNRT
 808         MOVE TT,[440700,,5]
 809         TRNN D,3
 810          MOVEM TT,QSBYTE(E) ;UNIT ASCII MODE, BYTE SIZE=7
 811         PUSHJ P,QUDLK   ;LOCK USER DIRECTORY
 812         PUSHJ P,QGRLSC  ;CHECK < AND >
 813          JRST QPNLBN    ;LOSE
 814           PUSHJ P,QFNG  ;REPLACE WITH COMPUTED EFFECTIVE NAME
 815         PUSHJ P,QFREEF  ;FIND FREE FILE NAME AREA AND STORE IN QDIRP(E)
 816          JRST QFDF      ;FILE DIR FULL
 817         MOVSI TT,UNWRIT ;SET WRITE IN PROGRESS
 818         IORM TT,UNRNDM(Q)
 819         MOVE TT,QPKID(I)
 820         DPB TT,[UNPKN+UNRNDM(Q)]
 821         PUSHJ P,QAUTH   ;SET FILE AUTHOR, MAY NOT PCLSR
 822         MOVE TT,QACTB
 823         IORM TT,QSNLCN(H)
 824         SETOM QSCRW(E)  ;SET CHNL WRITE SWITCH
 825         POPJ P,
 826
 827 QWRO2A:
 828 IFN QRSRVP,[
 829         SKIPL I,QSALLO(H)
 830          JRST QWRO2B    ;THIS DIR GOES ON A PARTICULAR UNIT
 831 ]
 832         SKIPGE I,QWRU   ;GET CURRENT WRITING UNIT
 833          JRST QWRO2E    ;NO CURRENT UNIT, GO FIND ONE
 834         MOVE TT,QSFT(I)
 835         CAML TT,QFTTHR
 836          JRST QWRO2B    ;ENOUGH ROOM ON PREFERRED UNIT
 837 QWRO2E: SETOB T,I       ;NOT MUCH SPACE LEFT TRY OTHER UNITS
 838         MOVSI E,-NQS
 839 QWRO2C: SKIPGE QACT(E)  ;SKIP ON UNIT ACTIVE
 840          JRST QWRO2D
 841 IFN QRSRVP,SKIPN QRESRV(E)      ;DONT CHOOSE THIS PACK IF RESERVED
 842          CAML T,QSFT(E) ;NOTE QSFT IS -1 IF TUT NEVER BEEN READ IN
 843           JRST QWRO2D   ;OTHERWISE CONTAINS VALID BLOCK COUNT
 844         MOVE T,QSFT(E)
 845         HRRZ I,E
 846 QWRO2D: AOBJN E,QWRO2C
 847         SKIPGE I
 848          BUG            ;NO ACTIVE UNRESERVED UNITS
 849         CAMN I,QWRU
 850          JRST QWRO2B    ;DON'T WRITE MFD IF UNCHANGED
 851         MOVEM I,QWRU
 852         MOVE E,QACTB
 853         IORB E,QMDRO
 854         MOVEM I,MPDWDK(E)
 855         JRST QWRO2B
 856
 857 QWRO:   JUMPN W,QWROR   ;REALLY WANT TO MODIFY OR OTHERWISE HACK AN EXISTING FILE
 858         PUSHJ P,QWRO2   ;MAKING NEW FILE, DECIDE WHICH UNIT TO PUT IT ON
 859         SETOM QMFTP(E)  ;TRACK TO SCAN IN TUT
 860         SETOM QMTTR(E)
 861         CLEARM QMPTN(E)
 862         CLEARM QMPTC(E)
 863         MOVEI TT,%QMWRT ;ENTER NORMAL WRITE MODE
 864         HRRM TT,QSRAC(E)
 865         MOVSI TT,%QARWT
 866         TRNE D,%DORWT/2
 867          IORM TT,QSRAC(E)
 868         JRST QOEX1      ;EXIT
 869
 870 \f
 871 SUBTTL  File hacking tracking
 872
 873 ; MNGDIR checks the file name (sname in C)
 874 ; Fails to skip if the file is an important system file.
 875 ; Skips if the file is of the everyday sort.
 876
 877 MNGDIR: HLRZ TT,C
 878 IFN KL10P, CAME C,[SIXBIT /.KLFE./]
 879         CAIN TT,'SYS    ;A sys directory?
 880          POPJ P,
 881         CAME C,[SIXBIT /ACOUNT/]
 882          CAMN C,[SIXBIT /./]
 883           POPJ P,
 884         CAME C,[SIXBIT /DEVICE/]
 885          CAMN C,[SIXBIT /CHANNA/]
 886           POPJ P,
 887         AOS (P)         ;Not a system directory. skip return.
 888         POPJ P,
 889
 890 ; SYSDSK notifies the SYS job to print a message on the
 891 ; console about the file being hacked.
 892 ; File names in C;A B, the opcode in W (or zero) specifies the hacking.
 893
 894 SYSDSK: JUMPE U,CPOPJ           ;Avoid deadly embrace!
 895         MOVSI T,SCLWRT          ;Writing on SYS directory.
 896         PUSHJ P,CWAIT           ;Take turns like nice little lusers.
 897             TDNE T,SUPCOR       ;Wait for previous req to finish.
 898         MOVE TT,W               ;Check file operation code.
 899         CAILE TT,4              ;If impossible opcode
 900          SETZ TT,               ; probably supposed to be R/W.
 901         MOVEM TT,SWMOD          ;Store opcode.
 902         MOVE TT,UNAME(U)
 903         MOVEM TT,SWUNAM         ;Luser.
 904         MOVE TT,JNAME(U)
 905         MOVEM TT,SWJNAM
 906         MOVEM A,SWFN1
 907         MOVEM B,SWFN2
 908         MOVEM C,SWFN3           ;Sname.
 909         IORM T,SUPCOR           ;Notify the SYS job.
 910         JRST CLKONJ             ;Turn on the clock and return.
 911
 912 \f
 913 SUBTTL DIRECTORY ROUTINES
 914
 915 QFREEF: PUSH P,A        ;Q_PTR TO USER DIR FREE FILE  QDIRP(E)_PTR TO FREE DESC AREA
 916         PUSH P,B        ;GET FREE FILE AREA
 917         PUSH P,I
 918         MOVEI I,0       ;SIGNAL NO GC YET
 919 QFREFA: SETZM QUDFPR(E) ;CLEAR SO WILL NOT POINT TO RANDOMNESS IN CASE OF G C
 920         MOVE TT,QSNLCN(H)
 921         SKIPL Q,UDESCP(TT)
 922          CAIL Q,2000*UFDBPW
 923           BUG           ;FREE DESC POINTER OUT OF RANGE
 924         IDIVI Q,UFDBPW
 925         MOVE C,UDNAMP(TT)
 926         CAIL Q,-UDDESC-7-LUNBLK(C)
 927          JRST QAGARB    ;NOT ENOUGH ROOM BETWEEN DESC AND NAME AREAS
 928         PUSHJ P,QLGLK   ;FIND WHERE FILE OUGHT TO GO
 929          JRST QFREFF    ;DIR WAS EMPTY
 930         TRNN J,1777
 931          JRST QFREFE    ;GOES AT END OF DIR
 932 QFREFC: CAMN A,UNFN1(J)
 933          CAME B,UNFN2(J)
 934           JRST QFREFE
 935         MOVE C,UNRNDM(J)
 936         TLNE C,UNIGFL   ;* FILES MUST COME AFTER NON * FILES
 937          JRST QFREFE    ;OF SAME NAME
 938         ADDI J,LUNBLK
 939         CAIGE J,2000(TT)
 940          JRST QFREFC
 941 QFREFE: CAMN Q,J
 942          JRST QFREFF    ;GOES AT BEGINNING
 943         PUSHJ P,QINSRT
 944         JRST QFREFD
 945
 946 QFREFF: SUBI Q,LUNBLK           ;Q -> NAME BLOCK FILE WILL GO IN
 947 QFREFD: MOVNI T,LUNBLK          ;ALLOCATE MORE SPACE FOR NAME AREA
 948         ADDM T,UDNAMP(TT)
 949         HRRZ A,UDESCP(TT)       ;FIRST FREE DESCRIPTOR LOC
 950         DPB A,[UNDSCP+UNRNDM(Q)];STORE IN FILE AREA
 951         MOVEM A,QDIRP(E)        ;STORE IN CHANNEL
 952         MOVEI B,6*UFDBPW+1      ;ENOUGH FOR A LINK WITH EVERY CHAR QUOTED PLUS ONE ZERO
 953         ADDM B,UDESCP(TT)       ;ALLOCATE MORE SPACE FOR DESC AREA
 954         MOVE B,Q
 955         SUB B,QSNLCN(H)
 956         HRRZM B,QUDFPR(E)       ;ASSOCIATE CHANNEL WITH FILE
 957         CONO PI,CLKOFF
 958         SKIPL B,QDATE           ;GET TIME AND DATE
 959          HRR B,TIMOFF
 960         CONO PI,CLKON
 961         MOVEM B,UNDATE(Q)       ;SET CREATION DATE
 962         HLLM B,OLDRDT(E)
 963         HLRS B
 964         DPB B,[UNREFD+UNREF(Q)] ;SET REFERENCE DATE
 965         IDIVI A,UFDBPW          ;GET WRD AND CHAR ADRS
 966         HLLZ B,QBTBLI(B)
 967         ADDI B,UDDESC(A)
 968         HRRZ A,QSNLCN(H)
 969         ADD B,A
 970         ILDB A,B
 971         SKIPE A
 972          BUG                    ;DESCRIPTOR AREA ALREADY OCCUPIED
 973         MOVEI A,UDWPH
 974         DPB A,B
 975         ILDB A,B
 976         SKIPE A
 977          BUG                    ;NOT FOLLOWED BY ZERO
 978         POP P,I
 979         POP P,B
 980         POP P,A
 981         MOVEM A,UNFN1(Q)        ;SET FILE NAMES
 982         MOVEM B,UNFN2(Q)
 983         JRST POPJ1
 984
 985 QAGARB: JUMPL I,QNOFRE  ;IF GC WAS ALREADY TRIED, DON'T TRY IT AGAIN - GIVE UP.
 986         PUSHJ P,QGC     ;GC.  BTW, IT IS OK TO PCLSR HERE.
 987          JFCL
 988         MOVNI I,1       ;SIGNAL GC HAS BEEN TRIED
 989         JRST QFREFA
 990 \f
 991 ;MAKE ROOM FOR FILE BEFORE J.  Q POINTS TO NEW EMPTY FILE SLOT
 992 QINSRT: PUSH P,A
 993         PUSH P,TT
 994         HRRZ TT,QSNLCN(H)
 995         HRRZ A,UDNAMP(TT)
 996         PUSH P,A
 997         ADDI A,(TT)
 998         HRLS A
 999         SUBI A,LUNBLK
1000         BLT A,-LUNBLK-1(J)
1001         SETZM -LUNBLK(J)
1002         HRRZI A,-LUNBLK+1(J)
1003         HRLI A,-LUNBLK(J)
1004         BLT A,-1(J)
1005         SUB J,QSNLCN(H)
1006         MOVSI A,-NQCHN
1007 QINSR1: HRRZ TT,QUDPR(A)
1008         SKIPL QUSR(A)
1009         CAIE TT,(H)
1010         JRST QINSR2
1011         MOVE TT,QUDFPR(A)
1012         CAMGE TT,(P)
1013         JRST QINSR2
1014         CAIGE TT,(J)
1015         SUBI TT,LUNBLK
1016         MOVEM TT,QUDFPR(A)
1017 QINSR2: AOBJN A,QINSR1
1018         ADD J,QSNLCN(H)
1019         HRRZI Q,-LUNBLK(J)
1020         SUB P,[1,,1]
1021         POP P,TT
1022         POP P,A
1023         POPJ P,
1024 \f
1025 ;DIR NOT IN CORE.  GET IT FROM DISK, CREATE IT IF DOESN'T ALREADY
1026 ; EXIST, OR GIVE NO SUCH DIRECTORY ERROR.
1027 ;C HAS SNAME.  RETURNS DIRECTORY NUMBER IN H.
1028
1029 QSKO1:  PUSHJ P,SWTL
1030             QSKOSW      ;PREVENT TIMING ERROR IF TWO PCS SHOULD
1031         PUSHJ P,QFLD    ; ATTEMPT TO BRING IN SAME DIRECTORY
1032          JRST QSKO11
1033         MOVEI T,2       ;SOMEONE ELSE BROUGHT IT IN, RELEASE QSKOSW
1034         JRST LSWPON     ;BUT LEAVE QSNNR(H) LOCKED.
1035
1036 QSKO11: PUSH P,J
1037         PUSH P,I
1038         PUSHJ P,QFL     ;LOOK UP DIR IN MFD, RET TRACK IN J
1039          JRST QSKON     ;NON EXISTENT
1040         PUSHJ P,QFLDF   ;FIND FREE LOSER DIR SLOT
1041         MOVE I,MDSK
1042         PUSHJ P,QCHNF   ;FIND FREE CHNL (TO READ IN DIR)
1043         MOVEM C,QSNUD(H)        ;SET USER NAME IN DIR SLOT
1044         MOVEM J,QSLGL(E)        ;REQUEST READ IN OF USER DIR FROM TRACK IN J
1045         MOVEI TT,%QMUDR
1046         MOVEM TT,QSRAC(E)
1047 QSKON1: MOVEI T,2
1048         PUSHJ P,LSWPON  ;RELEASE QSKOSW, LEAVE SOSSET OF QSNNR(H)
1049         POP P,I         ;GO AWAY WILL HANG UP WAITING IN QUDLK
1050         POP P,J         ;DIR IS LOCKED BUT NOT ON LSWPR, PI WILL UNLOCK AFTER READIN
1051         JRST QSTRTR
1052
1053 QNOFRE: POP P,I         ;NO FREE FILES AVAIL
1054         JRST POPBAJ
1055
1056 QPNL24: PUSHJ P,OPNL24
1057         JRST URET
1058
1059 QPNL20: PUSHJ P,OPNL20
1060         SKIPE QLD(U)
1061          PUSHJ P,OPNL47 ;FOUND LINK, BUT IT POINTS TO NON-EXISTENT DIRECTORY
1062         JRST URET
1063
1064 AUTOCR:                 ;AUTOMATICALLY CREATED DIRECTORIES
1065 IFN TPLP+UNSPLP,SIXBIT /.LPTR./ ;FOR TPL SPOOLING
1066         SIXBIT /.MSGS./         ;FOR MESSAGES TO ALL LOSERS
1067         SIXBIT /.MAIL./         ; Programs like to write mail here
1068         SIXBIT /CRASH/          ; Programs like to dump themselves here
1069         SIXBIT /.TEMP./         ; Programs like to write randomness here
1070 NATOCR==.-AUTOCR
1071 \f
1072 QSKON:  JUMPE C,QPNL20  ;DON'T ALLOW ZERO USER NAME
1073         PUSH P,TT
1074         MOVSI TT,-NATOCR
1075 QSKONA: CAMN C,AUTOCR(TT)
1076          JRST QSKONB
1077         AOBJN TT,QSKONA
1078         CAMN A,[SIXBIT /..NEW./]
1079          CAME B,[SIXBIT /(UDIR)/]
1080           JRST [POP P,TT
1081                 JRST QPNL20]
1082         BUG INFO,[DSK: DIR ],SIXBIT,C,[CREATED BY ],SIXBIT,UNAME(U),SIXBIT,JNAME(U)
1083 QSKONB: POP P,TT
1084         SKIPG NQFUS
1085          JRST QPNL24    ;NO MFD SLOTS AVAILABLE
1086         PUSH P,A
1087         PUSH P,B
1088         PUSH P,C
1089 QSKONE: PUSHJ P,QFLDF   ;FIND FREE DIR SLOT
1090         PUSHJ P,QMLOCK
1091         PUSHJ P,TCALL
1092          JRST IOMQ
1093           JRST [PUSHJ P,LSWPOP  ;QMDRO
1094                 PUSHJ P,LSWPOP  ;QSNNR
1095                 PUSHJ P,UDELAY  ;HOPEFULLY MEMORY WILL APPEAR SHORTLY
1096                 JRST QSKONE]
1097         MOVEM C,QSNUD(H)
1098         SOS NQFUS       ;NO TIMING ERR DUE TO QSKOSW
1099         MOVEI J,MU23UD
1100         DPB J,[MUR,,MEMBLT(A)]
1101         DPB H,[MNUMB,,MEMBLT(A)]
1102         LSH A,10.
1103         HRRM A,QSNLCN(H)
1104         SETZM (A)
1105         HRLS A
1106         AOS B,A
1107         BLT A,2000-2(B)
1108         MOVEI A,2000
1109         MOVEM A,UDNAMP-1(B)
1110         MOVE A,QSNUD(H)
1111         MOVEM A,UDNAME-1(B)
1112         MOVE B,QACTB            ;NOW PUT UFD INTO MFD
1113         IORB B,QMDRO
1114         MOVE TT,MDNAMP(B)       ;LOOK FOR A FREE SLOT
1115         ADDI TT,(B)
1116 QSKONC: TRNN TT,1777
1117          JRST QSKOND
1118         SKIPN MNUNAM(TT)
1119          JRST QSKONF
1120         ADDI TT,LMNBLK
1121         JRST QSKONC
1122
1123 QSKONF: SUBI TT,(B)
1124         JRST QSKONG
1125
1126 QSKOND: MOVNI TT,LMNBLK         ;NO FREE SLOTS, SO EXTEND DOWNWARD
1127         ADDB TT,MDNAMP(B)
1128 QSKONG: ADDI B,(TT)
1129         MOVEM A,MNUNAM(B)
1130         SUBI TT,2000-2*NUDSL    ;GET DISK BLOCK NUMBER
1131 IFN KA10P, SKIPGE TT
1132 IFE KA10P, CAIGE TT,2           ; Don't clobber 'HOM' blocks
1133          BUG                    ;TOO MANY UFDS (NQFUS CHECK DIDN'T WORK)
1134         LSH TT,-1
1135         MOVEM TT,QSNMI(H)
1136         MOVE TT,QACTB           ;UNLOCK UFD AND CAUSE IT TO GET WRITTEN
1137         HLLM TT,QSNLCN(H)
1138         PUSHJ P,QMULK           ;UNLOCK MFD
1139         POP P,C
1140         POP P,B
1141         POP P,A
1142         JRST QSKON1
1143 \f
1144 SUBTTL MAKE LINK
1145
1146 QALINK: MOVE I,MDSK     ;ENTER WITH QSNNR ON LSWPR
1147         MOVEM I,EPDL(U)
1148         PUSHJ P,QWRO2   ;MAKES NEW FILE WITH MINIMUM OF 37 BYTES OF DESC SPACE
1149         MOVSI A,UNLINK  ; AND ADDS QUSR AND QSNLCN ON LSWPR
1150         IORM A,UNRNDM(Q)        ;SET LINK BIT
1151         MOVE A,E        ;QSK CHANNEL NUMBER
1152         MOVE C,SRN5(U)  ;SNAME LINKED TO
1153         PUSHJ P,LDEP
1154          PUSHJ P,QUDS
1155         MOVE C,SRN3(U)  ;FN1 LINKED TO
1156         PUSHJ P,LDEP
1157          PUSHJ P,QUDS
1158         MOVE C,SRN4(U)  ;FN2 LINKED TO
1159         PUSHJ P,LDEP
1160          JFCL
1161         MOVE E,A        ;QSK CHANNEL NUMBER FOR QCHNRT
1162         MOVEI R,EPDL(U) ;DON'T CLOSE A REAL IOCHNM WORD
1163         PUSHJ P,QSOCL4  ;CLOSE CHNL & FILE
1164         PUSHJ P,LSWDEL  ;DELETE QUSR, HAS BEEN SETOM'ED
1165         PUSHJ P,LSWDEL  ;DELETE QSNRR, HAS BEEN SOS'ED
1166         JRST POPJ1
1167
1168 LDEP:   MOVEI E,6       ;STORE SIXBIT FROM C INTO LINK DESC
1169 LDEPL:  MOVEI B,0       ;GET NEXT CHAR
1170         LSHC B,6
1171         JUMPE B,LDEPS   ;*THIS ALLOWS EMBEDDED BLANKS.
1172         CAIE B,';
1173          CAIN B,':
1174          JRST LDEPS
1175 LDEPS2: MOVE D,B
1176         PUSHJ P,QUDS
1177         SOS E           ;NUMBER OF CHARACTERS LEFT IN WORD
1178         JUMPN C,LDEPL   ;JUMP IF ANY MORE NON-BLANK CHARS TO STORE
1179         MOVEI D,';
1180         JUMPE E,POPJ1   ;JUMP IF STORED 6 CHARACTERS
1181         POPJ P,         ;STORED FEWER, NEED TERMINATOR
1182
1183 LDEPS:  MOVEI D,':      ;THIS CHAR NEEDS TO BE QUOTED
1184         PUSHJ P,QUDS
1185         JRST LDEPS2
1186 \f
1187 ;LINK ENCOUNTERED DURING LOOKUP
1188
1189 QLINK:  TRNE D,%DONLK/2 ;CHECK 3.5 BIT IN OPEN MODE
1190          JRST QOLINK    ;JUMP IF DON'T CHASE LINKS MODE
1191         AOS A,QLD(U)
1192         CAIL A,100.
1193          JRST OPNL27    ;LINK DEPTH EXCEEDED
1194         PUSH P,E        ;SAVE XR NEEDED BY LSWPOP OF QUSR ENTRY
1195         MOVE E,TT
1196         IDIVI E,UFDBPW
1197         ADD E,QSNLCN(H)
1198         ADDI E,UDDESC
1199         MOVE TT,QBTBLI(TT)
1200         HRR TT,E
1201         MOVE I,[440600,,A]
1202         SETZB A,B
1203         SETZ C,
1204 QL1:    ILDB J,TT
1205         JUMPE J,QL3     ;END DESC
1206         CAIN J,':
1207          JRST QL4       ;QUOTE NEXT CHAR
1208         CAIN J,';
1209          TLZA I,770000  ;TERMINATE THIS WORD
1210 QL5:      IDPB J,I
1211         JRST QL1
1212
1213 QL4:    ILDB J,TT       ;GET CHAR THAT WAS QUOTED
1214         JRST QL5
1215
1216 QL3:    EXCH A,C        ;END OF DESC REACHED
1217         EXCH A,B        ;MAKE A FN1 B FN2 C SNM
1218         SKIPN C
1219          MOVE C,USYSN1(U)
1220         PUSHJ P,QUDULK  ;UNLOCK DIR
1221         POP P,E         ;RESTORE XR USED BY LSWPOP OF QUSR ENTRY
1222         PUSHJ P,LSWPOP  ;QUSR ENTRY
1223         PUSHJ P,LSWPOP  ;QSNNR ENTRY
1224         PUSHJ P,OPBRK   ;IF TRYING TO BE PCLSRED, SUBMIT
1225         JRST QSKOL
1226
1227 QOLINK: MOVSI TT,%QALNK ;OPENING UP A LINK
1228         IORM TT,QSRAC(E);DON'T ALLOW FILE-ONLY OPERATIONS SUCH AS IOT
1229         JUMPL D,QWROR1  ;LEAVE RH(QSRAC)=%QMIDL SO PI LEVEL WON'T MESS WITH IT
1230         JRST QOEX1      ;AND FINISH OPENING
1231 \f
1232 SUBTTL PAW OVER MFD
1233
1234 QMCH1:  CONO PI,UTCOFF
1235         MOVE TT,QMDRO
1236         TLNE TT,40000
1237         AOJE TT,QMCH2   ;NOT ON WAY IN
1238 QMCH3:  CONO PI,UTCON
1239         SKIPGE QMDRO
1240          PUSHJ P,UFLS
1241         MOVSI E,2
1242         TDNN E,QMDRO
1243          POPJ P,        ;PAWED OVER
1244         PUSHJ P,QMLOCK
1245         ANDCAM E,QMDRO
1246         HRRZ E,QMDRO
1247         MOVE TT,MDCHK(E)
1248         CAME TT,[SIXBIT /M.F.D./]
1249          BUG HALT,[MFD CLOBBERED]
1250 QMCH1A: MOVEI E,2000-LMNBLK*NUDSL(E)
1251 IFN KA10P, SETZM NQFUS
1252 IFE KA10P,[
1253         MOVNI TT,2              ;PROTECT DEC 'HOM' BLOCKS SO KLDCP OR 8080
1254         MOVEM TT,NQFUS          ; CAN FIND ITS CRUFT
1255 ] ;IFE KA10P
1256 QMCH1E: LDB TT,[1200,,E]
1257         JUMPE TT,QMULK
1258         SKIPN (E)
1259          AOS NQFUS
1260         ADDI E,LMNBLK
1261         JRST QMCH1E
1262
1263 QMCH2:  SOS QMDRO       ;INDICATE ON WAY IN
1264         CONO PI,UTCON
1265         SKIPG QFCHN
1266          BUG            ;DON'T WANT TO WAIT FOR CHANNEL?
1267         PUSHJ P,QCHNF
1268         MOVEI TT,MFDBLK ;MFD TRACK
1269         MOVEM TT,QSLGL(E)
1270         MOVEI TT,%QMMDR
1271         MOVEM TT,QSRAC(E)
1272         PUSHJ P,QSTRTR
1273         JRST QMCH3
1274 \f
1275 SUBTTL PAW OVER TUT
1276
1277 QTCH1:  CONO PI,UTCOFF
1278         MOVSI TT,200000
1279         TDNE TT,QTUTO(I)
1280          JRST QTCH2     ;GO READ IT IN
1281         CONO PI,UTCON
1282 QTCH1A: PUSHJ P,QTLOCK  ;TO MAKE SURE IT'S IN
1283         AOSE QDPWF(I)
1284          JRST QTULK     ;ALREADY PAWED OVER
1285         PUSH P,A
1286         PUSH P,B
1287         MOVE T,QTUTO(I)
1288         MOVE E,QSWAPA(T)
1289         IDIVI E,DECADE
1290         SKIPE TT
1291          ADDI E,1
1292         IMULI E,DECADE  ;ROUND SWAPPING ALLOC TO MULTIPLE OF A DECADE
1293         MOVEM E,QSWAPA(T)
1294         PUSH P,D
1295         PUSH P,E        ;FIRST TRACK OF NON-SWAPPING (FILE) AREA
1296         MOVE E,QTUTP(T) ;ROUND TUT POINTER TO MULTIPLE OF A DECADE
1297         ADDI E,DECADE-1
1298         IDIVI E,DECADE
1299         IMULI E,DECADE
1300         CAMGE E,(P)     ;KEEP IT WITHIN THE FILE AREA
1301          MOVE E,(P)
1302         MOVEM E,QTUTP(T)
1303         MOVE E,QPKNUM(T)
1304 IFN DC10P,[
1305         CAME E,QPKID(I)
1306          BUG HALT,[PACK ID ],OCT,E,[IN TUT FOR UNIT ],DEC,I,[DIFFERS FROM HARDWARE PACK ID],OCT,QPKID(I)
1307 ]
1308 IFE DC10P,      MOVEM E,QPKID(I)
1309         MOVE E,QPAKID(T)
1310         MOVEM E,QPKNM(I)
1311 IFN QRSRVP,[
1312         MOVE E,QTRSRV(T)
1313         MOVEM E,QRESRV(I)
1314 ]
1315 ;DROPS THROUGH
1316 \f;DROPS IN
1317         CLEARM QSFTS(I) ;FREE SPACE IN SWAPPING AREA
1318         SETZB D,QSFT(I)
1319         MOVE B,QTUTO(I)
1320         HRLI B,(TUTBP)
1321         ADDI B,LTIBLK
1322 QTCH1D: ILDB A,B
1323         JUMPN A,QTCH1F
1324         CAML D,(P)
1325          AOS QSFT(I)    ;BLOCK IN NON-SWAPPING AREA
1326         CAMGE D,(P)
1327          AOS QSFTS(I)   ;BLOCK IN SWAPPING AREA
1328 QTCH1F: ADDI D,1
1329         CAMGE D,QLASTB(T)
1330          JRST QTCH1D
1331         SUB P,[1,,1]
1332         POP P,D
1333         POP P,B
1334         POP P,A
1335         JRST QTULK
1336
1337 QTCH2:  SETOM QDPWF(I)
1338         ANDCAM TT,QTUTO(I)
1339         CONO PI,UTCON
1340         SKIPG QFCHN
1341          BUG                    ;DON'T WANT TO WAIT FOR CHANNEL?
1342         PUSHJ P,QCHNF
1343         HRRZM I,QDSKN(E)
1344         MOVEI TT,MFDBLK         ;TELL PI LEVEL TO READ IT ALL IN
1345         SUB TT,NTBL(I)
1346         MOVEM TT,QSLGL(E)
1347         LDB TT,[121000,,QTUTO(I)]
1348         MOVEM TT,QSCABN(E)
1349         MOVEI TT,%QMTTR
1350         MOVEM TT,QSRAC(E)
1351         PUSHJ P,QSTRTR
1352         JRST QTCH1A
1353
1354 ;ROUTINE TO ACCESS TUT
1355 ;CALL WITH DISK UNIT NUMBER IN I, BLOCK NUMBER IN D
1356 ;RETURNS IN D AN LDB-STYLE POINTER TO THE TUT AND IN B THE BYTE
1357 ;THAT YOU WOULD GET BY LDB'ING THAT POINTER.
1358 ;CLOBBERS E
1359 ;CALLER MUST LOCK TUT
1360
1361 TUTPNT: MOVE B,QTUTO(I)
1362         CAML D,QFRSTB(B)
1363         CAML D,QLASTB(B)
1364          BUG                    ;BLOCK NUMBER NOT IN RANGE COVERED BY TUT
1365         SUB D,QFRSTB(B)
1366         IDIVI D,TUTEPW
1367         ADDI D,LTIBLK(B)
1368         HLL D,TBTBL(E)
1369         LDB B,D
1370         POPJ P,
1371 \f
1372 QSTRTR:
1373 IFN DC10P,[
1374 QSTRT1: CONSO DC0,DSKCHN
1375          SETOM QHUNGF           ;SOMEONE PUSHED RESET BUTTON, RECOVER AT PI LEVEL
1376         CONO DC0,DCSET+DCIENB+DSKCHN    ;ENABLE IDLE INTERRUPT
1377 ]
1378 IFN RP10P+RH10P+RH11P,[
1379         CONO PI,UTCOFF
1380         PUSHJ P,QSTRT1
1381         CONO PI,UTCON
1382 ]
1383         POPJ P,
1384
1385 IFN RP10P+RH10P+RH11P,[ ;START DISK WITH UTC ALREADY OFF
1386 QSTRT1: SETOM QGTBZY    ;NOTE: TURNS UTC BACK ON BUT NOT CLOCK
1387 IFN RP10P,      CONSO DPC,20    ;ONLY IF DISK IDLE
1388 IFN RH10P,      CONSO DSK,%HIBSY
1389 IFN RH11P,      IORDQ TT,%HRCS1
1390 IFN RH11P,      TRNE TT,%HXRDY
1391          CONO PI,DSKRQ
1392         POPJ P,
1393 ]
1394
1395 ;TRY TO FLUSH UNNEEDED UFDS FROM CORE.
1396 ;ARG IN C IS ROUTINE TO FREE THE MEMORY.
1397 ;CALL WITH UDRSW SIEZED, OR WITH PI 2 IN PROGRESS AND UDRSW NOT LOCKED BY ANYONE
1398 ;CLOBBERS H, TT.  DOESN'T SKIP.
1399 QDFLS:  MOVSI H,-QNUD
1400 QDFLS1: SKIPE QSNUD(H)
1401          SKIPE QSNNR(H)
1402 QDFLS2:   AOBJN H,QDFLS1        ;CAN'T FLUSH IF SLOT NOT USED OR CHANNELS OPEN IN DIR
1403         JUMPGE H,CPOPJ
1404         MOVE TT,QACTB
1405         TLO TT,600000
1406         TDNE TT,QSNLCN(H)
1407          JRST QDFLS2            ;CAN'T FLUSH IF LOCKED OR NOT WRITTEN OUT
1408         PUSHJ P,QDFCHK          ;CHECK THAT NO POINTERS TO THIS DIRECTORY REMAIN
1409         CLEARM QSNUD(H)         ;FLUSH
1410         AOS QFUD
1411         PUSH P,A
1412         HRRZ A,QSNLCN(H)
1413         LSH A,-10.
1414         PUSHJ P,(C)             ;RETURN THE MEMORY
1415         POP P,A
1416         JRST QDFLS2             ;TRY FLUSHING SOME MORE
1417
1418 ;CALL WITH UFD SLOT# IN H, WHEN YOU THINK THAT UFD IS FREE.
1419 QDFCHK: PUSH P,C
1420         PUSH P,J
1421         MOVSI C,-NQCHN
1422 QDFCH1: SKIPGE QUSR(C)
1423          AOBJN C,QDFCH1
1424         JUMPGE C,QDFCH2
1425         HRRZ J,QUDPR(C)
1426         CAIN J,(H)
1427          BUG            ;IT WASN'T REALLY FREE, MAYBE QSNNR IS SCREWED UP?
1428         AOBJN C,QDFCH1
1429 QDFCH2: POP P,J
1430         POP P,C
1431         POPJ P,
1432 \f
1433 ;FIND A FREE UFD SLOT, RETURN INDEX IN H.  PUTS QSNNR ON LSWPR.
1434 ;CLOBBERS T, TT.
1435
1436 QFLDF:  PUSHJ P,SWTL
1437             UDRSW
1438         MOVSI H,-QNUD
1439         SKIPLE QFUD
1440          JRST QFLDF1
1441         PUSH P,C        ;ALL UFD SLOTS IN USE, TRY FLUSHING SOME
1442         MOVEI C,MEMR
1443         PUSHJ P,QDFLS
1444         POP P,C
1445         MOVSI H,-QNUD
1446         SKIPLE QFUD
1447          JRST QFLDF1
1448         PUSHJ P,LSWPOP  ;UDRSW
1449         PUSHJ P,UDELAY  ;WAIT 1/2 SECOND THEN TRY AGAIN, INCLUDING QDFLS
1450         JRST QFLDF
1451
1452 QFLDF1: SKIPN QSNNR(H)  ;SLOT ALREADY GOBBLED
1453          SKIPE QSNUD(H) ;OR ALREADY OCCUPIED
1454           AOBJN H,QFLDF1 ;MEANS CAN'T TAKE IT
1455         SKIPL H
1456          BUG            ;NONE FREE, QFUD OUT OF PHASE WITH REALITY
1457         HRRZS H
1458         SOS QFUD
1459         MOVSI TT,600000 ;DOUBLE LOCK
1460         MOVEM TT,QSNLCN(H)
1461         AOSG QSNNR(H)
1462          BUG
1463         PUSHJ P,LSWPOP  ;UDRSW
1464         PUSHJ P,LOSSET
1465             QFLDRT
1466         POPJ P,
1467
1468 ;LOSSET ROUTINE
1469 QFLDRT: SKIPL A,AC0S+H(U)
1470          CAIL A,QNUD
1471           BUG           ;H CLOBBERED
1472         SOSGE T,QSNNR(A)
1473          BUG
1474         JUMPG T,CPOPJ   ;HOW DID SOMEONE ELSE GET IT?
1475         SKIPN QSNUD(A)
1476          AOS QFUD       ;READ-IN NEVER STARTED, SLOT BECOMES FREE
1477         POPJ P,         ;OK TO LEAVE 600000,, SET IN QSNLCN
1478
1479 ;C HAS DIR NAME.
1480 ;IF IN CORE, SET H TO UFD SLOT#, AOS QSNNR, PUT ON LSWPR, AND SKIP.
1481 ;IF DIRECTORY NOT IN CORE, NO SKIP.  CLOBBERS T,TT.
1482 QFLD:   PUSHJ P,SWTL
1483             UDRSW
1484 QFLD1A: MOVSI H,-QNUD
1485 QFLD1:  CAME C,QSNUD(H)
1486          AOBJN H,QFLD1
1487         JUMPGE H,LSWPOP ;JUMP ON FAILED TO FIND USER.
1488 QFLD2A: AOSG QSNNR(H)
1489          BUG            ;MUST HAVE GOTTEN NEGATIVE SOMEHOW
1490         PUSHJ P,LSWPOP  ;UDRSW
1491 ;       PUSHJ P,SOSSET
1492 ;           QSNNR(H)
1493 ;THIS IS AN ATTEMPT TO FIND A BUG.
1494         PUSH P,T
1495         MOVEI T,QSNNR(H)
1496         MOVEM T,IOTBTS(U)
1497         PUSHJ P,LOSSET
1498             [ SOSGE @IOTBTS(U)
1499                BUG
1500               POPJ P, ]
1501         POP P,T
1502 ;END TEMPORARY CODE
1503         JRST POPJ1
1504 \f
1505 ;C <=SYS NAME,   RETURNS TRACK ADDR OF DIR IN J, SKIPS IF FINDS LOSER
1506 QFL:    PUSHJ P,QMLOCK
1507         PUSHJ P,QFL0
1508          JRST QMULK
1509         AOS (P)
1510         JRST QMULK
1511
1512 QFL0:   PUSH P,Q
1513         HRRZ Q,QMDRO
1514         ADD Q,MDNAMP(Q) ;PTR TO USER AREA
1515 QFL1:   LDB J,[1200,,Q]
1516         JUMPE J,QFL3
1517         CAMN C,MNUNAM(Q)
1518          JRST QFL2
1519         ADDI Q,LMNBLK
1520         JRST QFL1
1521
1522 QFL2:   SUBI J,2000-LMNBLK*NUDSL        ;J <= TRACK ADDR OF USER DIR
1523         LSH J,-1
1524         AOS -1(P)       ;SUCCESS
1525 QFL3:   POP P,Q
1526         POPJ P,
1527
1528 ;ROUTINE TO ASSIGN A DISK CHANNEL.
1529 ;ARGS:  U USER TO GO IN QUSR, H UFD SLOT# TO GO IN QUDPR, I DSK# TO GO IN QDSKN
1530 ;RETURNS QSK CHNL INDX IN E.
1531 ;DOESN'T DO A LOSSET OF QCHNRT, BUT CALLER MAY WANT TO.
1532 ;CLOBBERS T.  NEVER SKIPS.
1533
1534 QCHNF:  PUSHJ P,SWTL    ;PREVENT ANYONE ELSE FROM ALLOCATING CHANNELS
1535             QCHSW
1536         MOVSI E,-NQCHN
1537         SKIPLE QFCHN
1538          JRST QCH2      ;SOME CHANNELS ARE AVAILABLE, GO FIND ONE
1539         PUSHJ P,LSWPOP  ;QCHSW
1540         SKIPG QFCHN
1541          PUSHJ P,UFLS
1542         JRST QCHNF
1543
1544 QCH2:   SKIPGE QSRAC(E) .SEE %QALOK
1545          JRST QCH3
1546         SKIPGE QUSR(E)
1547          JRST QCH1
1548 QCH3:   AOBJN E,QCH2
1549         BUG             ;WHERE DID THAT FREE CHANNEL GO?
1550
1551 QCH1:   HRRZS E         ;CHANNEL ALLOCATED, INITIALIZE VARIABLES
1552         HRRZM I,QDSKN(E)
1553         SETOM QSCABN(E)
1554         SETOM QSGL(E)
1555         SETOM QSLGL(E)  ;IN CASE OF WRITE-OVER ON 0-LENGTH FILE.
1556         SETZM QBFP(E)
1557         SETZM QSBFS(E)
1558         CLEARM QSLBLK(E)
1559         SETOM QSMDN(E)
1560         SETZM QSCRW(E)
1561         SETZM QSBI(E)
1562         SETZM QSRAC(E)  .SEE %QMIDL
1563         CLEARM QFBLNO(E)
1564         SETZM QSMPRC(E)
1565         SETZM QSMPRP(E)
1566         MOVE T,[444400,,1]      ;ASSUME BYTES=WORDS, WILL BE FIXED LATER
1567         MOVEM T,QSBYTE(E)
1568         SETZM QPCLSR(E)
1569         HRRZM H,QUDPR(E)
1570         SETZM QUDFPR(E) ;NOT YET SET UP TO ANY PARTICULAR FILE
1571         MOVEM U,QUSR(E) ;CHANNEL IS NOW IN-USE
1572         SOSGE QFCHN
1573          BUG
1574         JRST LSWPOP     ;QCHSW
1575
1576 ;LOSSET ROUTINE TO RETURN TENTATIVELY ASSIGNED QSK CHNL
1577 ;E HAD BETTER CONTAIN THE QSK CHANNEL NUMBER AT "ALL" TIMES
1578 QCHNRT: SKIPL T,AC0S+E(U)
1579          CAIL T,NQCHN
1580           BUG           ;E CLOBBERED
1581         HRRZ A,U        ;LSWPOP MESSES WITH LH(U)
1582         CAME A,QUSR(T)
1583          BUG
1584         SETOM QUSR(T)
1585         AOS QFCHN
1586         POPJ P,
1587 \f
1588 SUBTTL DELETE, RENAME
1589 ;COME HERE FOR DELETE, OR RENAME NOT WHILE OPEN, ON DISK.
1590
1591 QRNAM:  SKIPN SRN3(U)
1592          JRST QDEL
1593         PUSH P,A
1594         PUSH P,B
1595         SKIPN B,SRN4(U)
1596          JRST QPNL11
1597         MOVE A,SRN3(U)
1598         PUSHJ P,MFDCK
1599          JRST .+2
1600           JRST QPNL13
1601         PUSHJ P,FLDRCK
1602          JRST .+2
1603           JRST QPNL13
1604         POP P,B
1605         POP P,A
1606         PUSH P,SRN3(U)
1607         PUSH P,SRN4(U)
1608         PUSHJ P,QUDLK
1609         PUSHJ P,QLOOK
1610          JRST [ SUB P,[2,,2]
1611                 JRST QROR1C ]   ;GIVE FILE NOT FOUND OR FILE LOCKED
1612         MOVE I,Q
1613         POP P,B
1614         POP P,A
1615         PUSHJ P,QGRLSC
1616          JRST QPNLBN    ;FILE ALREADY EXISTS
1617         PUSHJ P,QFNG
1618 QRNAM4: PUSHJ P,QLOOK
1619          JRST QRNAM3
1620         CAME I,Q        ;ALLOW RENAME THAT DOESN'T CHANGE NAMES.
1621          JRST QPNL13
1622 QRNAM3: MOVE Q,I
1623         MOVSI TT,UNDUMP ;SAY FILE NOT DUMPED.
1624         ANDCAM TT,UNRNDM(Q)
1625         MOVNI E,1       ;TELL QFREF NOT TO CLOBBER NON-EX DISK CHNL.
1626         PUSHJ P,QFREF   ;"REFERENCE" FILE
1627         PUSHJ P,QRELOC  ;STORE NEW NAMES IN DIR
1628 QRNAM2: MOVE TT,QACTB
1629         IORM TT,QSNLCN(H)
1630 QRNAM1: MOVE U,USER     ;U MAY NOT HAVE USER IF CAME HERE FROM LOGOUT
1631         PUSHJ P,LSWCLR
1632         JRST POPJ1
1633
1634 QGRLSC: CAME A,[SIXBIT />/]     ;SKIP NONE IF BOTH A+B ARE SPECIAL
1635         CAMN A,[SIXBIT /</]     ;ONCE IF ONE IS
1636          SOS (P)
1637         CAME B,[SIXBIT />/]     ;AND TWICE IF NEITHER
1638         CAMN B,[SIXBIT /</]
1639          SOS (P)
1640         AOS (P)
1641         JRST POPJ1
1642
1643 \f
1644 ;MOVE FILE POINTED TO BY Q SO THAT NEW NAMES A AND B WILL BE IN
1645 ;ALPHABETICAL ORDER
1646 QRELOC: PUSH P,TT
1647         PUSH P,E
1648         PUSH P,J
1649         PUSH P,Q
1650         PUSH P,D
1651         PUSH P,W
1652         PUSH P,R
1653         PUSHJ P,QLGLK   ;SEE WHERE FILE MUST GO
1654          BUG            ;DIR WAS EMPTY
1655         HRRZ TT,QSNLCN(H)
1656 QRLOCK: CAIL J,2000(TT)
1657          JRST QRLOCJ
1658         CAMN A,UNFN1(J)
1659         CAME B,UNFN2(J)
1660          JRST QRLOCJ
1661         MOVE Q,UNRNDM(J)
1662         TLNE Q,UNIGFL
1663          JRST QRLOCJ
1664         ADDI J,LUNBLK
1665         JRST QRLOCK
1666
1667 QRLOCJ: HRRZ Q,-3(P)    ;WHERE FILE IS NOW
1668         CAIE J,LUNBLK(Q)
1669          CAMN J,Q
1670           JRST QRLOCS   ;SAME PLACE
1671 REPEAT LUNBLK,  PUSH P,.RPCNT(Q)
1672         CAMG Q,J
1673          JRST QRLOCB
1674         MOVEI TT,(Q)
1675 QRLOCC: SUBI TT,LUNBLK
1676         HRLZ D,TT
1677         HRRI D,LUNBLK(TT)
1678         BLT D,2*LUNBLK-1(TT)
1679         CAILE TT,(J)
1680          JRST QRLOCC
1681 QRLOCA:
1682 REPEAT LUNBLK,  POP P,LUNBLK-.RPCNT-1(J)
1683         MOVEM A,UNFN1(J)
1684         MOVEM B,UNFN2(J)
1685         HRRZ TT,QSNLCN(H)
1686         SUB Q,TT
1687         SUB J,TT
1688         CAML J,Q
1689          JRST QRLOCD
1690         MOVEI D,LUNBLK
1691         HRRZ W,J
1692         HRRZ R,Q
1693 QRLOCE: MOVSI TT,-NQCHN
1694 QRLOCF: HRRZ E,QUDPR(TT)
1695         SKIPL QUSR(TT)
1696          CAIE E,(H)
1697           JRST QRLOCG
1698         HRRZ E,QUDFPR(TT)
1699         CAIN E,(Q)
1700          JRST QRLOCI
1701         CAIL E,(W)
1702          CAIL E,(R)
1703           JRST QRLOCG
1704         ADD E,D
1705         HRRZM E,QUDFPR(TT)
1706 QRLOCG: AOBJN TT,QRLOCF
1707 QRLOCH: POP P,R
1708         POP P,W
1709         POP P,D
1710         POP P,Q
1711         POP P,J
1712         POP P,E
1713         POP P,TT
1714         POPJ P,
1715
1716 QRLOCB: HRRZ D,Q
1717         HRLI D,LUNBLK(Q)
1718         BLT D,-1-LUNBLK(J)
1719         SUBI J,LUNBLK
1720         JRST QRLOCA
1721
1722 QRLOCD: MOVNI D,LUNBLK
1723         HRRZI W,LUNBLK(Q)
1724         HRRZI R,LUNBLK(J)
1725         JRST QRLOCE
1726
1727 QRLOCI: HRRZM J,QUDFPR(TT)
1728         JRST QRLOCG
1729
1730 QRLOCS: MOVEM A,UNFN1(Q)
1731         MOVEM B,UNFN2(Q)
1732         JRST QRLOCH
1733 \f
1734 QDEL:   PUSHJ P,QUDLK
1735         PUSHJ P,QLOOK
1736          JRST QDFNF
1737         MOVE TT,UNRNDM(Q)
1738         TLNE TT,UNLINK
1739          JRST QDEL5A
1740         LDB J,[UNPKN+UNRNDM(Q)]
1741 QDELTA: MOVSI I,-NQS
1742         CAME J,QPKID(I)
1743          AOBJN I,.-1
1744         JUMPGE I,QPKNF6 ;PACK OF FILE NOT MOUNTED
1745 QDEL5:  PUSHJ P,QUDULK
1746         PUSHJ P,QDELA
1747          JRST QDFNF     ;GONE AWAY BETWEEN LOCKS
1748         JRST QRNAM1
1749
1750 QDEL5A: ;DELETE LINK
1751         MOVE I,MDSK     ;RANDOM EXISTANT UNIT
1752         JRST QDEL5
1753
1754 QPKNF6: PUSHJ P,QUDULK
1755         PUSHJ P,QPKNFP  ;MAYBE JUST TUT NOT IN YET?
1756          JRST QDEL      ;YUP, GOT IT NOW, TRY AGAIN
1757         PUSHJ P,QUDLK   ;NO, FILE IS ON NOT-MOUNTED PACK
1758         PUSHJ P,QLOOK   ;SO GET IT AGAIN
1759          JRST QDFNF     ;GONE AWAY BETWEEN LOCKS, LOSE
1760                         ;AND DELETE IT WITHOUT HACKING TUT
1761 QDFPK:  LDB A,[UNDSCP+UNRNDM(Q)]        ;POINTER TO DESCRIPTION AREA
1762         PUSHJ P,QSQSH   ;REMOVE ENTRY
1763         IDIVI A,UFDBPW
1764         ADD A,QSNLCN(H)
1765         ADDI A,UDDESC
1766         HLL A,QBTBLI(B)
1767         MOVEI C,0
1768 QNFDL2: ILDB B,A
1769         DPB C,A
1770         TRNE B,40
1771          JRST QNFDL3
1772         JUMPN B,QNFDL2
1773         JRST QRNAM2
1774
1775 QNFDL3: REPEAT NXLBYT,[IDPB C,A
1776 ]
1777         JRST QNFDL2
1778
1779 IFN QAUTHP,[
1780 QAUTH:  PUSH P,B        ;STORE UFD INDEX OF FILE'S CREATOR
1781         PUSH P,C        ;THIS IS NOT ALLOWED TO PCLSR.  WE SEARCH THE MFD
1782         PUSH P,J        ;WITHOUT LOCKING IT WHICH SHOULD BE ALL RIGHT SINCE
1783         PUSH P,I        ;UFD'S DON'T MOVE AROUND AND THE MFD IS WIRED IN 1 PLACE IN CORE.
1784         MOVE J,QSNMI(H)
1785         MOVE C,UNAME(U)
1786         CAMN C,QSNUD(H)
1787          JRST QAUTH1    ;UNAME = SNAME
1788         PUSHJ P,QFL0
1789          SKIPA          ;NOT FOUND IN MFD
1790           JRST QAUTH1
1791         SETZM C
1792         MOVEI J,5       ;STRIP OFF ANY NUMERICS
1793         MOVE TT,[440600,,UNAME(U)]
1794         MOVE I,[440600,,C]
1795         ILDB B,TT
1796         IDPB B,I
1797 QAUTH2: ILDB B,TT
1798         CAIG B,'Z
1799         CAIGE B,'A
1800          JRST QAUTH3
1801         IDPB B,I
1802         SOJG J,QAUTH2
1803         SKIPA           ;NO NON-LETTERS
1804
1805 QAUTH3: PUSHJ P,QFL0
1806          SKIPA C,HSNAME(U)      ;CAN'T CONVERT UNAME IN ANY FORM, TRY HSNAME AS LAST RESORT
1807           JRST QAUTH1
1808         PUSHJ P,QFL0
1809          SETOM J                ;CAN'T ENCODE AUTHOR AT ALL
1810 QAUTH1: DPB J,[UNAUTH+UNREF(Q)]
1811         POP P,I
1812         POP P,J
1813         POP P,C
1814         POP P,B
1815         POPJ P,
1816 ]               ;END IFN QAUTHP
1817 .ELSE QAUTH==CPOPJ
1818 \f
1819 ;Q=0 => LOOK UP FILE TO DELETE
1820 ;Q .NE. 0 => DELETE FILE POINTED TO BY QUDFPR OF CHNL IN D
1821 ;H MUST HAVE DIR SLOT INDEX
1822 QDELA:  MOVEI Q,0
1823 QDLA1:  PUSHJ P,SLUGH
1824             QCHSW
1825             1000,,QSNLCN(H)
1826             1000,,QTUTO(I)
1827         JUMPN Q,QDLA2
1828         PUSHJ P,QLOOK
1829          JRST QDEL4A    ;FNF
1830         SETO D,         ;NO ASSOCIATED CHANNEL
1831 QDLA3:  LDB A,[UNLNKB+UNRNDM(Q)]
1832         LDB TT,[UNPKN+UNRNDM(Q)]
1833         CAME TT,J
1834          JUMPE A,QDELA1 ;ON DIFFERENT DISK (DIDN'T LOCK RIGHT TUT TRY AGAIN)
1835         MOVE A,Q
1836         SUB A,QSNLCN(H)
1837         MOVSI J,-NQCHN
1838 QDEL1:  CAIN D,(J)
1839          JRST QDEL2     ;IGNORE CHANNEL (IF ANY) WHOSE CLOSING CAUSED THIS
1840         HRRZ TT,QUDPR(J)
1841         SKIPL QSCRW(J)  ;ONLY LOOK AT READ CHNLS
1842          CAIE TT,(H)
1843           JRST QDEL2
1844         HRRZ TT,QUDFPR(J)
1845         SKIPL QUSR(J)
1846          CAIE TT,(A)
1847           JRST QDEL2
1848         MOVSI TT,%QADEL         ;FOUND CHNL WITH THIS FILE OPEN
1849         IORM TT,QSRAC(J)        ;DELETE FILE WHEN THIS CHNL CLOSED
1850         MOVSI TT,UNCDEL         ;SET DELETED BIT
1851         IORM TT,UNRNDM(Q)
1852 QDEL4:  MOVE TT,QACTB
1853         IORM TT,QSNLCN(H)
1854         MOVE TT,DCHBT(I)
1855         IORM TT,QTUTO(I)
1856 QDEL4B: PUSHJ P,QTULK
1857         PUSHJ P,QUDULK
1858         PUSHJ P,LSWPOP
1859         JRST POPJ1
1860
1861 QDLA2:  MOVE Q,QUDFPR(D)        ;COMPUTE FILE ADR FROM CHNL IN D
1862         ADD Q,QSNLCN(H) ;DIR MAY HAVE MOVED
1863         JRST QDLA3
1864
1865 QDEL4A: SOS (P)
1866         JRST QDEL4B
1867 \f
1868 QCDLWO: PUSH P,R        ;OUTPUT CLOSE BUT FILE WAS DELEWO'ED
1869         SETZM QSCRW(D)  ;FAKE OUT ERROR CHECK AT QSQSH6
1870         PUSHJ P,QUDULK
1871 QSICLD: MOVE H,QUDPR(D) ;ENTRY FROM INPUT CLOSE, FILE WAS DELETED
1872         MOVE I,QDSKN(D)
1873         PUSHJ P,QUDLK
1874         MOVE Q,QSNLCN(H)
1875         ADD Q,QUDFPR(D)
1876         MOVE J,QPKID(I)
1877         PUSHJ P,QUDULK
1878         PUSH P,D
1879         PUSHJ P,QDLA1
1880          BUG            ;FILE ISNT THERE?
1881         POP P,D
1882         MOVE H,QUDPR(D) ;DIRECTORY NUMBER
1883         SETOM QUSR(D)   ;FREE THE DISK CHANNEL
1884         AOS QFCHN
1885         JRST QICLX
1886
1887 QDELA1: PUSHJ P,QDEL4B  ;NOT OUR DISK IN J
1888          JFCL
1889         MOVE J,TT       ;DISK ITS REALLY ON
1890 QDELA2: MOVSI I,-NQS    ;TRANSLATE PACK # IN J TO DRIVE # IN I
1891         CAME J,QPKID(I)
1892           AOBJN I,.-1
1893         JUMPGE I,QPKNF1
1894         JRST QDELA
1895
1896 QSOCLD: PUSH P,D        ;DELETE FILE WHEN CLOSING OVER IT
1897         PUSH P,R
1898         LDB J,[UNPKN+UNRNDM(Q)]
1899         PUSHJ P,QUDULK
1900         PUSHJ P,QDELA2
1901          JFCL
1902 QPKNF7: POP P,R
1903         POP P,D
1904         POPJ P,
1905
1906 QPKNF1: PUSHJ P,QPKNFP  ;MAYBE TUT NOT IN YET?
1907          JRST QDELA2    ;YUP, TRY AGAIN
1908         PUSHJ P,QUDLK
1909         PUSHJ P,QLOOK
1910          JRST QUDULK    ;GONE AWAY BETWEEN LOCKS
1911         JRST QDFPK      ;GO DELETE OFF OF NON-MOUNTED PACK
1912
1913 QDL2:   PUSHJ P,QTULK   ;DELETE LINK
1914         MOVEI T,2
1915         PUSHJ P,LSWPON  ;UNLOCK QCHSW
1916 QDLINK: LDB E,[UNDSCP+UNRNDM(Q)]
1917         IDIVI E,UFDBPW
1918         ADD E,QSNLCN(H)
1919         ADDI E,UDDESC
1920         HLL E,QBTBLI(TT)
1921         ILDB A,E
1922         SKIPN E
1923          BUG            ;NULL LINK?
1924         MOVEI B,0
1925 QDL1:   DPB B,E                 ;CLEAR OUT THE CHAR
1926         CAIN A,':
1927          IDPB B,E               ;CLEAR A QUOTED CHAR WITHOUT LOOKING AT IT
1928         ILDB A,E
1929         JUMPN A,QDL1
1930         PUSHJ P,QSQSH   ;REMOVE ENTRY
1931         MOVE TT,QACTB
1932         IORM TT,QSNLCN(H)
1933         PUSHJ P,QUDULK
1934         JRST POPJ1
1935 \f
1936 QDEL2:  AOBJN J,QDEL1           ;CHECK NEXT DISK CHANNEL
1937         MOVE C,UNRNDM(Q)        ;NOT OPEN, SO REALLY DELETE IT
1938         TLNE C,UNLINK
1939          JRST QDL2
1940         ANDI C,.BM UNDSCP
1941         IDIVI C,UFDBPW
1942         ADD C,QSNLCN(H)
1943         ADDI C,UDDESC
1944         HLL C,QBTBLI(D)         ;GET DESCRIPTOR POINTER IN C AND TT
1945         MOVE TT,C
1946         MOVEI A,0
1947         PUSHJ P,NFLLN1          ;A GETS NUMBER OF BLOCKS IN FILE
1948         PUSH P,A
1949         SKIPN D,QSFBT(H)        ;SEE IF ENOUGH QSFBT STORAGE EXISTS
1950          JRST QDEL11
1951 QDEL10: HLRE B,(D)              ;NUMBER OF FREE LOCATIONS IN THIS PAGE
1952         ADD A,B                 ;DECREASE LOCATIONS NEEDED
1953         MOVE D,1(D)             ;CDR
1954         JUMPN D,QDEL10
1955 QDEL11: JUMPLE A,QDEL12         ;JUMP IF SUFFICIENT STORAGE EXISTS
1956         PUSHJ P,TCALL           ;GET MORE
1957             JRST IOMQ
1958          JRST [ MOVE U,USER     ;U MAY NOT HAVE USER IF CAME FROM LOGOUT
1959                 PUSHJ P,LSWCLR  ;HAVE TO WAIT FOR MEMORY
1960                 PUSHJ P,MQTEST  ;AVOID DEADLOCKS BY UNLOCKING EVERYTHING
1961                  PUSHJ P,UFLS
1962                 JRST UUOTRO ]
1963         MOVEI D,MU23FB
1964         DPB D,[MUR,,MEMBLT(A)]
1965         LSH A,10.
1966         MOVEI D,2(A)
1967         HRLI D,-1776
1968         MOVEM D,(A)
1969         MOVE D,A
1970         EXCH A,QSFBT(H)         ;ADD TO FRONT OF LIST
1971         MOVEM A,1(D)
1972         MOVE A,(P)              ;GET BACK NUMBER OF BLOCKS NEEDED
1973         JRST QDEL10             ;SEE IF THERE ARE ENOUGH NOW
1974
1975 QDEL12: POP P,A                 ;GET RID OF BLOCKS COUNT
1976         PUSHJ P,QSQSH           ;REMOVE ENTRY, CANNOT PCLSR AFTER THIS
1977         CLEARB J,D              ;J GETS NUMERIC TRACK NUMBER, D BYTE POINTER TO TUT
1978         MOVE TT,QTUTO(I)        ;D ZERO SO WILL HALT IF DESC DOESN'T START WITH LOAD-ADDR!
1979         MOVE Q,QSFBT(H)         ;Q -> AOBJN POINTER FOR STORING BLOCK NUMBERS
1980 QDEL3:  ILDB B,C                ; INTO QSFBT AS DESCRIPTORS ARE ZEROED OUT
1981         MOVEI A,0               ;I DISK, C BP TO DESCRIPTOR, A,B,E TEMP.
1982         DPB A,C
1983         JUMPE B,QDEL4           ;END OF FILE DESCRIPTION
1984         TRNE B,40
1985          JRST QDEL6
1986         CAILE B,UDTKMX
1987          JRST QDEL7
1988 QDEL8:  SKIPN Q
1989          BUG                    ;OOPS, OUT OF QSFBT STORAGE
1990         SKIPL E,(Q)             ;PICK UP AOBJN POINTER
1991          JRST [ MOVE Q,1(Q)     ;THIS PAGE FULL, TRY NEXT
1992                 JRST QDEL8 ]
1993         MOVEM J,(E)             ;STORE DISK,,BLOCK FOR LATER FREEING
1994         AOBJN E,.+1
1995         MOVEM E,(Q)             ;INCREMENT POINTER
1996         MOVE E,QSNLCN(H)        ;DECREASE DIR'S BLOCKS-USED
1997         HRRZ A,UDBLKS(E)
1998         SOSL A
1999          HRRM A,UDBLKS(E)
2000         ILDB A,D                ;CHECK TUT
2001         SKIPN A
2002          BUG                    ;TUT SHOWS TRACK NOT USED
2003         AOS J                   ;DO NEXT BLOCK IN CONTIGUOUS GROUP
2004         SOJG B,QDEL8
2005         JRST QDEL3
2006
2007 IFN NXLBYT-2, .ERR THIS ROUTINE AND OTHERS KNOW IMPLICITLY THAT NXLBYT=2
2008 QDEL6:  MOVEI D,0               ;LOAD ADDRESS
2009         DPB B,[140500,,D]
2010         ILDB B,C
2011         DPB B,[060600,,D]
2012         DPB A,C                 ;A HAS ZERO FROM QDEL3
2013         ILDB B,C
2014         DPB B,[0600,,D]
2015         DPB A,C
2016         MOVE J,D
2017         HRL J,I
2018         PUSHJ P,TUTPNT
2019         ADD D,[TUTBYT_14,,]     ;MAKE INTO ILDB-TYPE POINTER
2020         JRST QDEL7A
2021
2022 QDEL7:  CAIN B,UDWPH
2023          JRST QDEL3
2024         SUBI B,UDTKMX
2025         ADD J,B
2026         IBP D
2027         SOJG B,.-1
2028 QDEL7A: MOVEI B,1       ;LOAD ADDRESS OR SKIP AND TAKE, SO ONLY ONE TRACK
2029         JRST QDEL8
2030
2031 QDFNF:  PUSHJ P,OPNL4
2032         JRST URET
2033
2034 QDELB:  CONO PI,UTCON
2035         JRST QDELA
2036
2037 ;PERFORM BLOCK-FREEING SPECIFIED BY QFBTS
2038 QDLFBT: CONO PI,UTCOFF          ;PROTECT QFBTS
2039         SKIPN B,QFBTS
2040          JRST UTCONJ
2041         MOVE T,1(B)
2042         MOVEM T,QFBTS
2043         CONO PI,UTCON
2044         HRRZ T,(B)              ;FIRST FREE LOCATION
2045         SUBI T,2(B)             ;NUMBER OF LOCATIONS TO DO
2046         HRLO A,T
2047         EQVI A,1(B)
2048         AOBJP A,QDLFB9          ;A NOW -> BLOCKS TO FREE, & CHECK FOR EMPTY
2049         SETO I,                 ;NO TUT LOCKED YET
2050 QDLFB1: HLRZ J,(A)              ;DISK NUMBER
2051         CAMN J,I                ;MAKE SURE RIGHT TUT IS LOCKED
2052          JRST QDLFB2
2053         SKIPL I
2054          PUSHJ P,QTULK
2055         MOVE I,J
2056         PUSHJ P,QTLOCK
2057 QDLFB2: HRRZ D,(A)              ;BLOCK NUMBER TO FREE
2058         PUSHJ P,TUTPNT
2059         CAIGE B,TUTMNY          ;USED IN "MANY" FILES(1,2,...,TUTMNY,TUTLK)
2060          SOJL B,[JRST 4,.]      ;HALT IF TUT SHOWS TRACK NOT USED
2061         JUMPN B,QDLFB3          ;NOT LAST USE
2062         HRRZ T,(A)              ;BLOCK NUMBER AGAIN
2063         MOVE TT,QTUTO(I)
2064         CAML T,QSWAPA(TT)
2065          AOSA QSFT(I)
2066           AOS QSFTS(I)          ;TRACK IN SWAPPING AREA
2067 QDLFB3: DPB B,D                 ;DECREASE USAGE COUNT IN TUT
2068         AOBJN A,QDLFB1
2069         PUSHJ P,QTULK
2070 QDLFB9: MOVEI A,-1(A)           ;GET AN ADDRESS ON THAT PAGE
2071         LSH A,-10.              ;DONE WITH THIS PAGE, FREE IT
2072         PUSHJ P,TMEMR           ;RETURN PAGE TO FREE AND TRY FOR MORE
2073             MU23FB
2074         JRST QDLFBT
2075 \f
2076 ;REMOVE HOLE FROM NAME AREA AT Q
2077 QSQSH:  PUSH P,A
2078         PUSH P,B
2079         PUSH P,C
2080         PUSH P,TT
2081         HRRZ TT,QSNLCN(H)
2082         MOVE A,UDNAMP(TT)
2083         CAILE A,2000
2084          BUG            ;UDNAMP BAD
2085         ADDI A,(TT)
2086         HRRZ C,Q
2087         SUB C,A
2088         SKIPL C
2089         CAIL C,2000-UDDESC
2090          BUG            ;Q BAD
2091         HRRZ C,Q
2092 QSQSH1: SUBI C,LUNBLK
2093         CAMLE A,C
2094          JRST QSQSH2
2095         HRLZ B,C
2096         HRRI B,LUNBLK(C)
2097         BLT B,2*LUNBLK-1(C)
2098         JRST QSQSH1
2099
2100 QSQSH2:
2101 REPEAT LUNBLK,SETZM .RPCNT(A)
2102         SUBI A,-LUNBLK(TT)
2103         HRRZM A,UDNAMP(TT)
2104         HRRZ C,Q
2105         SUBI C,(TT)     ;INDEX OF DELETED FILE
2106         HRRZI TT,-LUNBLK(A)     ;INDEX OF OLD BEGINNING OF NAME AREA
2107         MOVSI A,-NQCHN
2108 QSQSH3: HRRZ B,QUDPR(A)
2109         SKIPL QUSR(A)
2110          CAIE B,(H)
2111           JRST QSQSH4
2112         SKIPN B,QUDFPR(A)
2113          JRST QSQSH4
2114         CAIGE B,(TT)
2115          BUG
2116         CAIN B,(C)
2117          JRST QSQSH6    ;PNTR TO FLUSHED HOLE, CHECK IF READ CHNL
2118         CAIG B,(C)      ;IF AFTER DELETED FILE DON'T RELOCATE
2119          ADDI B,LUNBLK
2120         HRRZM B,QUDFPR(A)
2121         SKIPL QSCRW(A)
2122          JRST QSQSH4    ;READ CHNL
2123         ADD B,QSNLCN(H)
2124         MOVE B,UNRNDM(B)
2125         TLNN B,UNWRIT
2126          BUG            ;CHNL WRITING BUT BEING WRITTEN BIT NOT SET
2127 QSQSH4: AOBJN A,QSQSH3
2128         POP P,TT
2129         POP P,C
2130         POP P,B
2131         POP P,A
2132         POPJ P,
2133
2134 QSQSH6: MOVE B,QSRAC(A) ;FOUND PNTR TO DELETED FILE
2135         TLNE B,%QADEL   ;SKIP IF NOT DELETE AFTER CLOSE
2136          SKIPGE QSCRW(A) ;ALSO ERROR IF NOT READ CHNL
2137           BUG
2138         JRST QSQSH4     ;WAS DELETE AFTER CLOSE ON READ CHNL
2139 \f
2140 SUBTTL DIRECTORY LOOK UP, > FEATURE
2141
2142 ;A contains the FN1 and B contains the FN2.
2143 ;H is the index of the directory slot.  The dir must be locked.
2144
2145 ;Returns the address of the filename block in Q.
2146 ;Clobbers C.
2147
2148 ;Internally, J and Q point to the bottom and top of the
2149 ;area of the dir we are still searching.
2150 ;Bit 4.9 of J is set to indicate one of the names is ">".
2151 ;C used as a flag: sign bit says creating a file.
2152 ;Bit 1.1 of C says FN2 is > or <.
2153
2154 ;Look for place to create new file,
2155 ;and generate new version for >.
2156 QFNG:   MOVEM Q,EPDL3(U)
2157         SKIPA C,[SETZ]
2158 ;Look for existing files only
2159 QLOOK:   MOVEI C,0
2160         PUSH P,J
2161         HRRZ J,QSNLCN(H)
2162         MOVEI Q,2000-LUNBLK(J)
2163         ADD J,UDNAMP(J)
2164         CAMN A,[SIXBIT />/]
2165          TLOA J,400000
2166           CAMN A,[SIXBIT /</]
2167            JRST QLOOKA  ;4.9 BIT OF J SET IF >
2168         CAMN B,[SIXBIT />/]
2169          TLOA J,400000
2170           CAMN B,[SIXBIT /</]
2171            AOJA C,QLOOK1
2172         PUSHJ P,QLGLK
2173          JRST POPJJ     ;FNF
2174         TRNN J,1777
2175          JRST POPJJ     ;J IS OFF THE END OF THE BLOCK
2176         PUSH P,C
2177         EXCH Q,J
2178 QLK1:   CAMN A,UNFN1(Q)
2179          CAME B,UNFN2(Q)
2180           JRST QLK3     ;FNF
2181         MOVE C,UNRNDM(Q)
2182         TLNN C,UNIGFL   ;BEING WRITTEN OR DELETED
2183          JRST QLK2      ;FOUND IT
2184         SUBI Q,LUNBLK   ;SEARCH THROUGH * FILES
2185         CAML Q,J
2186          JRST QLK1
2187 QLK3:   POP P,C
2188         JRST POPJJ
2189
2190 QLK2:   AOS -2(P)
2191         JRST QLK3
2192
2193 QFNF2:  SUB P,[2,,2]
2194         JRST OPNL4
2195
2196         ;REFERENCE FILE POINTED TO BY Q
2197 QFREF:  LDB C,[UNREFD+UNREF(Q)]
2198         CAME E,[-1]     ;IF A DISK CHNL IN USE,
2199          HRLM C,OLDRDT(E) ;SAVE OLD REF DATE IN DSK CHNL VAR
2200         SKIPGE T,QDATE          ; If date unknown
2201          POPJ P,                ; don't clobber
2202         HLRZ T,T                ; Just get date part
2203         CAMN C,T                ; If same as old date
2204          POPJ P,                ; no need to do anything
2205         DPB T,[UNREFD+UNREF(Q)]
2206         MOVE T,MDSK     ;MAKE MDSK WRITE OUT
2207         MOVE T,DCHBT(T)
2208         IORM T,QSNLCN(H)
2209         POPJ P,
2210 \f
2211 QLOOKA: CAME B,[SIXBIT /</]
2212         CAMN B,[SIXBIT />/]
2213          JRST POPJJ     ;MUST BE READ RETN FILE NOT FOUND
2214 QLOOK1: JUMPGE C,QLOOK9
2215         CAMN B,[SIXBIT /</]
2216          TLO J,400000   ;IF WRITING, TURN "<" INTO ">"
2217 QLOOK9: PUSH P,D
2218         PUSH P,TT
2219         PUSH P,I
2220         PUSH P,[-1]     ;BEST INDEX
2221         PUSH P,[SETZ]   ;BEST "NUMERIC" PART
2222         PUSH P,[SETZ]   ;BEST ALPHA PART
2223 QLOOK4: CAIGE Q,(J)
2224          JRST QLOOK2
2225         XCT QLKI1(C)
2226          JRST QLOOK3
2227         MOVE D,UNRNDM(Q)
2228         TLNE D,UNIGFL
2229          JUMPGE C,[ SKIPGE -2(P)        ;FILE LOCKED, REMEMBER IT IF WE HAVE NO BETTER,
2230                      HRRM Q,-2(P)       ; BUT DON'T CONSIDER IT IF READING
2231                     JRST QLOOK3 ]       ;BUT IF WRITING, CONSIDER ALL FILES
2232         SKIPE TT,@QLKI1+1(C)
2233 QLOOK6:  TRNE TT,77     ;RIGHT ADJ
2234           JRST QLOOK5
2235         LSH TT,-6
2236         JRST QLOOK6
2237
2238 QLOOK5: MOVEI I,0
2239 QLOOK8: LDB D,[600,,TT]
2240         CAIL D,'0
2241         CAILE D,'9
2242          JRST QLOOK7    ;NOT A DIGIT
2243 QLOK5B: TRNE I,77       ;RIGHT ADJ LOW NON NUM PART
2244          JRST QLOK5A
2245         LSH I,-6
2246         JUMPN I,QLOK5B
2247 QLOK5A: TLC TT,400000   ;AVOID CAM LOSSAGE
2248         TLC I,400000
2249         SKIPGE -2(P)
2250          JRST QLOK5D    ;FIRST MATCH
2251         JUMPGE J,QLOK5E ;GET LEAST
2252         CAMGE TT,-1(P)  ;GET GREATEST
2253          JRST QLOOK3
2254         CAME TT,-1(P)
2255          JRST QLOK5D
2256         CAMGE I,(P)
2257          JRST QLOOK3    ;NOT AS GOOD
2258 QLOK5D: HRRZM Q,-2(P)
2259         MOVEM TT,-1(P)
2260         MOVEM I,(P)
2261 QLOOK3: SUBI Q,LUNBLK
2262         JRST QLOOK4
2263
2264 QLOK5E: CAMLE TT,-1(P)
2265          JRST QLOOK3
2266         CAME TT,-1(P)
2267          JRST QLOK5D
2268         CAMLE I,(P)
2269          JRST QLOOK3
2270         JRST QLOK5D
2271
2272 QLOOK7: LSHC TT,-6      ;LOW DIGIT NOT NUMERIC
2273         JUMPN TT,QLOOK8 ;NO NUMERIC DIGITS AT ALL ("BIN", MAYBE?)
2274         JUMPL J,QLOK5B  ;IF LOOKING FOR GREATEST, LET THIS BE LEAST
2275         MOVNI TT,1      ;GREATEST IF LOOKING FOR LEAST
2276         JRST QLOK5B
2277
2278 QLOOK2: JUMPL C,QFNG1   ;REALLY WANT TO MAKE F.N.'S FOR WRITE
2279         SUB P,[1,,1]
2280         POP P,C ;BEST "NUMERIC" PART
2281         POP P,Q ;ADR
2282         POP P,I
2283         POP P,TT
2284         POP P,D
2285         AOJE Q,POPJJ
2286         MOVE A,UNFN1-1(Q)       ;ACTUAL MATCHED FILE NAMES
2287         MOVE B,UNFN2-1(Q)
2288         SOJGE Q,POPJJ1          ;FOUND A FILE THAT WASN'T LOCKED
2289         MOVEI Q,-LUNBLK(Q)
2290         JRST POPJJ
2291 \f
2292 QFNG1:  SKIPGE -2(P)
2293          JRST QFNG2     ;NOT FOUND START W/ 1
2294         MOVE TT,-1(P)
2295         TLC TT,400000
2296         MOVE I,[600,,TT]
2297 QFNG3:  LDB D,I
2298         CAIL D,'0
2299         CAILE D,'9
2300          JRST QFNG4     ;REACH END OF NUMERIC FIELD
2301         AOS D
2302         CAILE D,'9
2303          JRST QFNG5
2304         DPB D,I
2305 QFNG5A: TLNE TT,770000
2306          JRST QFNG3A
2307         LSH TT,6
2308         JRST QFNG5A
2309
2310 QFNG2:  MOVSI TT,(SIXBIT /1/)
2311 QFNG3A: MOVEM TT,A(C)   ;STORE INTO A OR B AS APPRO
2312         SUB P,[3,,3]
2313         POP P,I
2314         POP P,TT
2315         POP P,D
2316         MOVE Q,EPDL3(U)
2317         JRST POPJJ
2318
2319 QFNG5:  MOVEI D,'0
2320         DPB D,I
2321         ADD I,[60000,,]
2322         JUMPL I,QFNG5A
2323         JRST QFNG3
2324
2325 QFNG4:  TLNN TT,770000  ;SKIP ON ALREADY 6 CHAR NAME
2326          LSH TT,6
2327         MOVEI D,'1
2328         DPB D,I
2329         MOVEI D,'0
2330 QFNG4B: TLNN I,770000
2331          JRST QFNG5A
2332         IDPB D,I
2333         JRST QFNG4B
2334
2335 QLKI1:  CAME B,UNFN2(Q)
2336         CAME A,UNFN1(Q)
2337         UNFN2(Q)
2338
2339 QPKNF:  MOVE C,QSNUD(H)
2340         PUSHJ P,QUDULK  ;UNLOCK DIR
2341         PUSHJ P,LSWPOP  ;QUSR ENTRY
2342         PUSHJ P,LSWPOP  ;QSNNR ENTRY
2343         PUSHJ P,QPKNFP
2344          JRST QSKOL
2345         PUSHJ P,OPNL16  ;PACK NOT MOUNTED
2346         JRST URET
2347
2348 QPKNFP: MOVSI I,-NQS
2349 QPKNF3: SKIPGE QACT(I)
2350          JRST QPKNF4
2351         MOVE TT,QTUTO(I)
2352         SKIPL QDPWF(I)
2353          TLNE TT,40000
2354           JRST QPKNF2   ;PACK NOT IN OR NOT PAWED OVER
2355 QPKNF4: AOBJN I,QPKNF3
2356         JRST POPJ1
2357
2358 QPKNF2: JRST QTCH1      ;MAYBE THIS UNIT HAS GOODIES
2359
2360 QFDF:   PUSHJ P,OPNL5   ;FILE DIR FULL ON WRITE
2361         JRST URET
2362
2363 QPNL13: PUSHJ P,OPNL13
2364         JRST URET
2365
2366 QPNL22: PUSHJ P,OPNL22
2367         JRST URET
2368
2369 QPNLBN:
2370 QPNL11: PUSHJ P,OPNL11
2371         JRST URET
2372 \f
2373 ;ROUTINE TO FIND PLACE IN DIRECTORY WHERE A B WOULD GO
2374 ;SKIPS ONLY IF DIRECTORY CONTAINS AT LEAST ONE FILE
2375 ;FOR INSERTION, FILE GOES BEFORE PNTR RETURNED IN J
2376 ;RETURNS PNTR IN Q TO BEGINNING OF NAME AREA
2377 ;(ONLY WORKS FOR LUNBLK = 5)
2378 QLGLK:  HRRZ J,QSNLCN(H)
2379         HRRZ Q,UDNAMP(J)
2380         ADDI Q,(J)
2381         CAIL Q,2000(J)
2382          POPJ P,        ;DIRECTORY EMPTY
2383         TLC A,(SETZ)
2384         TLC B,(SETZ)
2385         PUSH P,D
2386         PUSH P,E
2387         ADDI J,600      ;128. NAME BLOCKS FROM END
2388 REPEAT 7,[              ;THIS CODE DELIBERATELY NOT INDENTED. NEED 4 DIMENSIONS.
2389         CAMGE J,Q
2390         JRST .+6
2391         MOVE D,UNFN1(J)
2392         TLC D,(SETZ)
2393         CAMN A,D
2394         JSP E,QLGLE
2395         CAML A,D
2396         ADDI J,<1_<7-.RPCNT>>*LUNBLK
2397         SUBI J,<1_<6-.RPCNT>>*LUNBLK
2398 ]
2399         CAMGE J,Q
2400          ADDI J,LUNBLK
2401         CAMGE J,Q
2402          BUG
2403         MOVE D,UNFN1(J)
2404         TLC D,(SETZ)
2405         CAME A,D
2406          JRST QLGL1
2407         MOVE D,UNFN2(J)
2408         TLC D,(SETZ)
2409         CAMLE B,D
2410 QLGL2:   ADDI J,LUNBLK
2411 QLGL3:  TLC A,(SETZ)
2412         TLC B,(SETZ)
2413         POP P,E
2414         POP P,D
2415         JRST POPJ1
2416
2417 QLGL1:  CAML A,D
2418          JRST QLGL2
2419         JRST QLGL3
2420
2421 ;CALL BY JSP E,QLGLE
2422 QLGLE:  MOVE D,UNFN2(J)
2423         TLC D,(SETZ)
2424         CAMN B,D
2425          JRST QLGL3
2426         CAML B,D
2427          JRST 1(E)
2428         JRST 2(E)
2429 \f
2430 SUBTTL LOCKING ROUTINES
2431
2432 QMLOCK: PUSHJ P,LSWTL
2433             QMDRO
2434         POPJ P,
2435
2436 QMULK:  PUSH P,U
2437         MOVE U,USER
2438         MOVE U,LSWPR(U)
2439         HRRZ U,(U)
2440         CAIE U,QMDRO
2441          BUG
2442         POP P,U
2443         JRST LSWPOP
2444
2445 QTLOCK: PUSHJ P,LSWTL
2446             QTUTO(I)
2447         POPJ P,
2448
2449 QTULK:  PUSH P,U
2450         MOVE U,USER
2451         MOVE U,LSWPR(U)
2452         HRRZ U,(U)
2453         CAIE U,QTUTO(I)
2454          BUG
2455         POP P,U
2456         JRST LSWPOP
2457
2458 QUDLK:  PUSHJ P,LSWTL
2459             QSNLCN(H)
2460         POPJ P,
2461
2462 QUDULK: PUSH P,U
2463         MOVE U,USER
2464         MOVE U,LSWPR(U)
2465         HRRZ U,(U)
2466         CAIE U,QSNLCN(H)
2467          BUG
2468         POP P,U
2469         JRST LSWPOP
2470
2471 SBTBLI:
2472 QBTBLI: 440600,,        ;IF GOING TO ILDB
2473 SBTBL:
2474 QBTBL:  360600,,
2475         300600,,
2476         220600,,
2477         140600,,
2478         060600,,
2479         000600,,
2480
2481 TBTBL=.+1
2482 TBTBLI: REPEAT 1+TUTEPW, TUTBP-<.RPCNT*TUTBYT*010000,,>
2483 \f
2484 SUBTTL DIRECTORY GARBAGE COLLECTOR
2485
2486 ; MOVE H, directory number
2487 ; lock the directory
2488 ; PUSHJ P,QGC
2489 ;  return if directory full.
2490 ;  return if won.
2491 ; No ACs clobbered.
2492 ; All pointers to directory relocated appropriately.
2493
2494 ; Called from disk open routines if a new file is to be created
2495 ; and there are less than 6+LUNBLK words in the free area of the directory.
2496 ; Called from QSBWG if %QAFUL is set in QSRAC.
2497 ; %QAFUL means "must have successful GC before committing another track to this file."
2498
2499 ;NOTE NOTE NOTE:
2500 ; This GC allocates an extra block of core for temporary storage.
2501 ; If no memory is free in low half, waits without unlocking directory.
2502 ; Can possibly PCLSR.  No deadly embrace to not unlock directory since
2503 ; it can't be flushed from core anyway and it's not holding anything else in.
2504
2505 QAPBMN==NXLBYT+3        ;minimum number of descriptor bytes which
2506                         ; must be available at the end of a file to
2507                         ; commit another track to the file.
2508                         ;1 for a take-N, NXLBYT+1 for jump, 1 for ending zero.
2509 QAPBMX==36.             ;maximum number of descriptor bytes to allocate at a time.
2510
2511 QGC:    IRPC X,,ABCDQIJTR
2512          PUSH P,X
2513         TERMIN
2514
2515 ;Old GC prints message on system console.  Any reason to with fast one?
2516
2517 ; validate the directory
2518
2519 QGC00:  SKIPL A,QSNLCN(H)
2520          BUG                    ;directory not locked
2521         MOVE C,UDNAME(A)
2522         MOVEM C,LASTGC          ;save name of last dir GCed
2523         CAME C,QSNUD(H)
2524          BUG                    ;directory clobbered
2525         SKIPLE C,UDNAMP(A)
2526         CAILE C,2000
2527          BUG                    ;name pointer out of bounds
2528         IMULI C,UFDBPW
2529         SKIPL D,UDESCP(A)
2530         CAIL D,-UDDESC*UFDBPW(C)
2531          BUG                    ;descriptor/name overlap
2532
2533 ; Get a block of core to use for temporary storage.
2534 ; The block is left in the "in-process" state.
2535
2536         HRRZ Q,A
2537         PUSHJ P,TCALL
2538             JRST IOMQ
2539          JRST [ PUSHJ P,UDELAY  ;no core available in low half
2540                 JRST QGC00 ]    ;so wait, then loop back to beginning
2541         LSH A,10.
2542         MOVEI B,1(A)            ;zero it out
2543         HRL B,A
2544         SETZM (A)
2545         BLT B,1777(A)
2546         EXCH Q,A                ;A -> directory, Q -> temporary core
2547 ;Drops through
2548 \f;Drops in
2549 ; Scan the directory and count:
2550 ;  I    all files
2551 ;  J    files open for writing
2552 ;  R    active bytes of descriptor
2553
2554         SETZB I,J
2555         SETZ R,
2556         MOVEI B,2000(A)         ;end of name area
2557         ADD A,UDNAMP(A)         ;start of name area
2558 QGC10:  CAML A,B
2559          JRST QGC19             ;jump if all files done
2560         SKIPE UNFN2(A)
2561         SKIPN UNFN1(A)
2562          BUG                    ;zero name block?
2563         AOJA I,QGC12            ;file exists
2564
2565 QGC11:  ADDI A,LUNBLK           ;advance to next file
2566         AOJA R,QGC10            ;also count the zero byte that ends the descriptor
2567
2568 QGC12:  MOVE C,UNRNDM(A)
2569         TLNE C,UNWRIT
2570          ADDI J,1
2571         ANDI C,.BM UNDSCP       ;get descriptor ptr (undscp has pos=0)
2572         IDIVI C,UFDBPW
2573         HLL C,QBTBLI(D)
2574         ADDI C,UDDESC-2000(B)
2575         MOVE D,UNRNDM(A)
2576         TLNE D,UNLINK
2577          JRST QGC14
2578 QGC13:  ILDB T,C                ;get byte of descrip
2579         JUMPE T,QGC11           ;eof
2580         CAIG T,UDWPH
2581          AOJA R,QGC13           ;1-byte desc
2582 REPEAT NXLBYT, IBP C            ;multi-byte desc
2583         ADDI R,NXLBYT+1
2584         JRST QGC13
2585
2586 QGC14:  ILDB T,C                ;count bytes of link descriptor
2587         JUMPE T,QGC11
2588         CAIN T,':
2589          AOJA R,[IBP C          ;quoted
2590                  AOJA R,QGC14 ]
2591         AOJA R,QGC14
2592
2593
2594 ; Compute number of bytes of descriptor to add after each
2595 ; file open for output.  If > QAPBMX, set to QAPBMX.
2596 ; If < QAPBMN, take directory-full exit.
2597
2598 QGC19:  MOVE C,I                ;save number of files
2599         IMULI I,LUNBLK*UFDBPW   ;number of bytes in name area
2600         ADDI R,UDDESC*UFDBPW(I) ;R := total number of bytes claimed
2601         MOVEI A,2000*UFDBPW-1
2602         SUB A,R                 ;A := number of bytes left
2603         SKIPE J
2604          IDIV A,J               ;number of bytes available to extend open files
2605         CAIGE A,QAPBMN
2606          JRST QGC69             ;if < minimum, dir. full
2607         CAILE A,QAPBMX
2608          MOVEI A,QAPBMX         ;limit to at most QAPBMX bytes at a time
2609 ;Drops through
2610 \f;Drops in
2611 ; A = number of bytes of room to leave after each file open for writing
2612 ; B -> name block under consideration
2613 ; C -> old descriptors
2614 ; D = disk channel number under consideration.  Also D = C+1
2615 ; J counts new descriptor bytes generated
2616 ; Q -> new descriptors (in temporary core block)
2617 ; R -> base of directory
2618
2619         SETZ J,
2620         HRRZ R,QSNLCN(H)        ;old dir
2621         ADDI Q,UDDESC           ;new dir
2622         HLL Q,QBTBLI
2623         MOVE B,UDNAMP(R)
2624         ADD B,R
2625
2626 ; Loop over files
2627
2628 QGC20:  CAIL B,2000(R)
2629          JRST QGC40              ;all files done
2630         LDB C,[UNDSCP UNRNDM(B)] ;get old desc ptr
2631         DPB J,[UNDSCP UNRNDM(B)] ;store new desc ptr
2632
2633 ; Loop over all disk channels, relocating the ones that point to this file
2634
2635         MOVSI D,-NQCHN
2636 QGC31:  HRRZ T,QUDPR(D)
2637         SKIPL QUSR(D)
2638          CAIE T,(H)
2639           AOBJN D,QGC31         ;not in use or not same directory
2640         JUMPGE D,QGC39          ;jump if all disk channels done
2641         LDB T,[1200,,B]
2642         CAME T,QUDFPR(D)
2643          JRST QGC32             ;not same file
2644         MOVE T,J                ;relocate descriptor pointer
2645         SUB T,C
2646         ADDM T,QDIRP(D)
2647 QGC32:  AOBJN D,QGC31
2648
2649 QGC39:  IDIVI C,UFDBPW          ;make desc pntr into byte pointer
2650         HLL C,QBTBLI(D)
2651         ADDI C,UDDESC(R)
2652         MOVE T,UNRNDM(B)
2653         TLNE T,UNLINK
2654          JRST QGC22
2655 QGC21:  ILDB T,C                ;copy descriptor bytes of a file into temporary core
2656         IDPB T,Q
2657         JUMPE T,QGC23
2658         CAIG T,UDWPH
2659          AOJA J,QGC21
2660 REPEAT NXLBYT,[
2661         ILDB T,C
2662         IDPB T,Q
2663 ]       ADDI J,NXLBYT+1
2664         JRST QGC21
2665
2666 QGC22:  ILDB T,C                ;copy descriptor bytes of a link into temporary core
2667         IDPB T,Q
2668         JUMPE T,QGC23
2669         CAIN T,':
2670          AOJA J,[ILDB T,C
2671                  IDPB T,Q
2672                  AOJA J,QGC22 ]
2673         AOJA J,QGC22
2674
2675 QGC23:  MOVE T,UNRNDM(B)
2676         TLNN T,UNWRIT
2677          JRST QGC25
2678         ADD J,A                 ;file being written, increase desc area
2679         MOVE T,A
2680         IBP Q
2681         SOJG T,.-1
2682
2683 QGC25:  ADDI B,LUNBLK           ;next file
2684         AOJA J,QGC20            ;also account for final zero at end of descriptor
2685 \f
2686 ; Paranoia:  check that all disk channels to this directory look OK
2687
2688 QGC40:  MOVEM J,UDESCP(R)       ;store free-desc pointer
2689         LDB A,[1200,,Q]         ;last word used by descriptors
2690         CAML A,UDNAMP(R)
2691          BUG                    ;overlap
2692         ANDI Q,-2000            ;base of temp core block again
2693         MOVSI A,-NQCHN
2694 QGC41:  HRRZ T,QUDPR(A)
2695         SKIPL QUSR(A)
2696          CAIE T,(H)
2697           AOBJN A,QGC41         ;channel not in use, or to some other dir
2698         JUMPGE A,QGC49          ;all channels done
2699         SKIPN B,QUDFPR(A)       ;get file open on this channel
2700          JRST QGC42             ;channel not set up to any particular file
2701         CAIGE B,2000
2702          CAMGE B,UDNAMP(R)
2703           BUG                   ;file pointer screwed
2704         ADD B,R
2705         SKIPL J,QDIRP(A)        ;get descriptor pointer
2706          CAMLE J,UDESCP(R)
2707           BUG                   ;descriptor pointer screwed
2708         LDB C,[UNDSCP UNRNDM(B)]
2709         CAIGE B,2000-LUNBLK(R)  ;skip if last file in dir
2710          LDB D,[UNDSCP UNRNDM+LUNBLK(B)] ;else get desc pntr for next file
2711         CAIL B,2000-LUNBLK(R)
2712          MOVEI D,2000*UFDBPW    ;but if last file, get infinity
2713         CAML J,C                ;verify that QDIRP points to this file
2714          CAML J,D
2715           BUG
2716 QGC42:  AOBJN A,QGC41           ;do next channel
2717
2718 ; If you thought that was paranoid, get a load of this:
2719
2720 QGC49:  MOVE B,UDNAMP(R)
2721         ADD B,R
2722 QGC50:  CAIL B,2000(R)
2723          JRST QGC60
2724         LDB C,[UNDSCP UNRNDM(B)]
2725         SOS C
2726         IDIVI C,UFDBPW          ;NOTE if UNDSCP = 0 we depend on bytes
2727         HLL C,QBTBL(D)          ; off left end of word LDB'ing as zero
2728         ADDI C,UDDESC(Q)
2729         LDB T,C
2730         SKIPE T
2731          BUG                    ;descriptor not preceeded by zero
2732         MOVE J,UNRNDM(B)
2733         TRZ J,#.BM UNDSCP       ;LH(J) flags, RH(J) just desc pntr
2734         TLNE J,UNLINK
2735          JRST QGC52
2736 QGC51:  ILDB T,C
2737         JUMPE T,QGC53
2738         CAIG T,UDWPH
2739          AOJA J,QGC51
2740 REPEAT NXLBYT, IBP C
2741         ADDI J,NXLBYT+1
2742         JRST QGC51
2743
2744 QGC52:  ILDB T,C
2745         JUMPE T,QGC53
2746         CAIE T,':
2747          AOJA J,QGC52
2748         IBP C
2749         ADDI J,2
2750         JRST QGC52
2751
2752 QGC53:  TLNE J,UNWRIT           ;RH(J) has desc pntr to the zero that ends the file
2753          ADDI J,QAPBMN          ;if being written, needs room for one more track
2754         CAIL B,2000-LUNBLK(R)   ;now set D to point to next descriptor area
2755          SKIPA D,UDESCP(R)      ;do this instr if last file in dir
2756           LDB D,[UNDSCP UNRNDM+LUNBLK(B)]       ;else get next file's desc pntr
2757         CAIG D,(J)
2758          BUG                    ;descriptors overlap
2759         ADDI B,LUNBLK
2760         JRST QGC50
2761 \f
2762 ; Copy the descriptors back into the directory
2763
2764 QGC60:  MOVSI C,UDDESC(Q)       ;make BLT pointer to copy it back
2765         HRRI C,UDDESC(R)
2766         MOVE B,UDNAMP(R)        ;use same BLT to zero out the free area
2767         ADD B,R
2768         BLT C,-1(B)
2769
2770 ; Take win return.
2771
2772         AOS -9(P)
2773 QGC69:  LDB A,[121000,,Q]       ;core block number of temporary page
2774         PUSHJ P,TMEMR           ;return it
2775             MUINP               ;verifying that it is the right one.
2776         IRPC X,,RTJIQDCBA
2777          POP P,X
2778         TERMIN
2779         POPJ P,
2780 \f
2781 SUBTTL INTERPRET DESCRIPTORS
2782
2783 QFNTR:  MOVE H,QUDPR(A) ;BYTE # IN Q CHNL # IN A
2784         PUSHJ P,QUDLK   ;DONT SKIP IF OFF FILE
2785         MOVE T,QSNLCN(H) ;RETN BLOCK IN QSLGL(A) AND QSBI(A)  DIR PNTR IN QDIRP(A)
2786         ADD T,QUDFPR(A) ;FIRST ADR OF BLOCK IN QFBLNO(A)
2787         LDB TT,[UNDSCP+UNRNDM(T)]       ;CHAR ADR OF FILE BEG
2788         MOVEM TT,QDIRP(A)       ;SKIPS IF FINDS BLOCK AND LEAVES USER DIR LOCKED
2789         CLEARM QSBI(A)
2790         CLEARM QFBLNO(A)
2791         CLEARB J,QSLGL(A)       ;J HAS ORG OF FIRST NON-EX-BLOCK IF OFF END OF FILE
2792 QFNT1A: PUSHJ P,QFNT1
2793          JRST QUDULK    ;OFF END OF FILE RETN NOT SKIPPING
2794         CAMLE J,Q
2795          JRST QFNT7     ;LOCATED BLOCK CONTAINING WORD
2796         MOVEM J,QFBLNO(A)
2797         JRST QFNT1A
2798
2799 QFNTN:  MOVE H,QUDPR(A) ;LIKE ABOVE BUT SCAN FORWARD ONLY FROM CURRENT SPOT
2800         PUSHJ P,QUDLK
2801         PUSHJ P,QFNT1
2802          CAIA           ;EOF, DON'T SKIP RETURN
2803           AOS (P)
2804         MOVEM J,QFBLNO(A)
2805         JRST QUDULK
2806
2807 QFNT1:  SKIPE QSBI(A)   ;DECODE NEXT BLOCK, CHNL IN A, SKIP UNLESS EOF.
2808          JRST QFNT2     ;BLOCK # IN QSLGL FILE ADR IN J (TAKE N PENDING)
2809 QFNT3:  PUSHJ P,QMPDCH  ;GOBBLE NEXT CHR OF DESC IN R (POINTED TO BY QDIRP) INCR QDIRP
2810         CAIN R,UDWPH    ;ALSO RET BYTE PNTR IN TT
2811          JRST QFNT3     ;NULL
2812         JUMPN R,QFNT8   ;NOT OFF END OF FILE
2813         SOS QDIRP(A)
2814         POPJ P,
2815
2816 QFNT8:  TRNE R,40
2817          JRST QFNT4
2818         CAILE R,UDTKMX
2819          JRST QFNT6     ;SKIP AND TAKE
2820         MOVEM R,QSBI(A)
2821 QFNT2:  SOS QSBI(A)
2822         AOS QSLGL(A)
2823 QFNT5:  MOVEI J,2000    ;ACTIVE BYTES IN BLOCK
2824         IMULI J,@QSBYTE(A)
2825         ADD J,QFBLNO(A)
2826         JRST POPJ1
2827
2828 QFNT7:  MOVSI T,%QALBK  ;SET UP PROC LAST BLOCK FLG AND RETN
2829         ANDCAM T,QSRAC(A)       ;CLEAR LAST BLOCK OF FILE BIT
2830         SKIPE QSBI(A)
2831          JRST QFNT7A    ;NOT LAST BLOCK
2832         ILDB R,TT       ;GET NEXT CHR IN DIR
2833         JUMPN R,QFNT7A
2834         IORM T,QSRAC(A) ;PROCESSING LAST BLOCK
2835 QFNT7A: AOS QSBI(A)     ;FAKE OUT PI ROUTINE WHICH WILL TRY TO INCREMENT
2836         SOS QSLGL(A)
2837         JRST POPJ1
2838
2839 QFNT4:  MOVEI J,0       ;LOAD ADR
2840         DPB R,[140400,,J]
2841         PUSHJ P,QMPDCH
2842         DPB R,[060600,,J]
2843         PUSHJ P,QMPDCH
2844         DPB R,[0600,,J]
2845         MOVEM J,QSLGL(A)
2846         JRST QFNT5
2847
2848 QFNT6:  MOVEI J,1-UDTKMX(R)
2849         ADDM J,QSLGL(A)
2850         JRST QFNT5
2851 \fEBLK
2852
2853 SUBTTL DISK CHANNEL DATA AREAS
2854
2855 QBFP:   BLOCK NQCHN     ;BUFFER LIST LH LAST RH FIRST
2856                         ;READ: PI IN MP OUT.  WRITE: MP IN PI OUT.
2857 SINLST: BLOCK NQS       ;SWAP-IN LISTS FOR EACH DISK
2858 SOUTLS: BLOCK NQS       ;SWAP-OUT LISTS FOR EACH DISK
2859
2860 ;READ/WRITE LISTS LINK THROUGH MLO IN MEMBLT.
2861 ;LH(MEMPNT) HAS DISK ADDR, RH(MEMPNT) HAS # BYTES IN BLOCK IF FILE READ
2862 ;MWC IN MEMBLT HAS WORD COUNT IF WRITE (FOR EXTRA-WORDS)
2863
2864 QFCHN:  NQCHN           ;NUMBER OF FREE QSK CHNLS (NOT COUNTING DIR WRITE AND SWAP CHANNELS)
2865
2866 QUSR:   REPEAT NQCHN,-1 ;USER
2867 DWUSR:  -1      ;0 IF DIR WRITE ACTIVE
2868 SWUSR:  REPEAT NQS,-1   ;0 IF SWAP XFER ACTIVE
2869 QDIRP:  BLOCK NQCHN     ;CHAR ADR PNTR TO DESC AREA FOR FILE
2870 QSLBLK: BLOCK NQCHN+NQS+1       ;LAST BLOCK NUMBER OF FILE WRITTEN
2871 QSLGL:  BLOCK NQCHN     ;LAST QSGL
2872 QSGL:   REPEAT NQCHN+NQS+1,-1   ;-1 IDLE + ACTIVE TRACK
2873                         ;LAST NQS+1 FOR FD WRITE AND SWAPPING
2874 QSBI:   BLOCK NQCHN     ; COUNT CONSECUTIVE BLOCKS
2875 QSBFS:  BLOCK NQCHN     ;NUMBER OF BUFFS THIS CHNL +1 IF EOF AT PI WITH QSBFS=0
2876 QPCLSR: BLOCK NQCHN     ;PCLSR STATUS OF MAIN PROGRAM - LOAD SYSTEM CALL
2877 QSMDN:  BLOCK NQCHN     ;MAIN PRGM ACTIVE BUFFER NUM
2878 OLDRDT: BLOCK NQCHN     ;STORAGE FOR PREVIOUS REFERENCE DATE
2879 QSRAC:  BLOCK NQCHN+1
2880         REPEAT NQS, %QMSWP ;SWAPPING CHANNELS START OUT IN SWAP MODE
2881  %QA==525252(1)
2882  %QALOK==400000         ;4.9 CHNL LOCKED (NOT USED)
2883  %QAEFR==200000         ;4.8 EOF REACHED READ
2884  %QAEFW==100000         ;4.7 EOF WRITE
2885  %QACTH==40000          ;4.6 DONT RELOAD. CORE JOB HUNG ON ACTIVE BUFFER
2886  %QAFUL==20000          ;4.5 GC DIR BEFORE COMMITTING ANOTHER BLOCK TO FILE
2887  %QADEL==10000          ;4.4 DELETE WHEN CLOSED
2888  %QAACC==4000           ;4.3 FILE ADDRESS ALTERED BY .ACCESS OR OTHERWISE
2889  %QAPAR==2000           ;4.2 NON RECOV PARITY ERR (OR OTHER DISK ERR) AT PI
2890  %QAOUT==1000           ;4.1 ASSOC USER OUT DONT RELOAD (NOT IMPLEM.)
2891  %QALBK==400            ;3.9 READ CHNL PROCESSING LAST BLOCK FLAG
2892  %QAMPU==200            ;3.8 UPDATE QSMPRP, QSMPRC ON NEXT BUFFER GOBBLE
2893  %QAWOV==100            ;3.7 FILLING OUT LAST BLK OF FILE IN WRITE OVER MODE PAST ORIG EOF
2894  %QALNK==40             ;3.6 FILE IS REALLY A LINK
2895  %QALOP==20             ;3.5 LINKS WERE TRACED IN OPENING THIS FILE.
2896  %QARWT==10             ;3.4 MAKE WOULD-BE READERS WAIT (RATHER THAN GETTING FILE LOCKED ERROR)
2897  %QAFNY==4              ;3.3 "FUNNY BLOCK", WORD COUNT IN LAST WORD
2898                         ; 8/20/90 No longer ever gets set.
2899  $QAMOD==220200         ;3.2-3.1 READ/WRITE MODE 0 NORMAL 1 WRITE OVER 2 COPY OVER WRITE
2900  %QAMWO==1              ;3.1=1 => WRITE-OVER MODE.
2901  %QM==777777            ;RH CHANNEL MODE.  INDEX INTO ACTION TABLES USED AT PI LEVEL.
2902 .SEE %QMIDL             ;FOR TABLE OF CHANNEL MODES
2903
2904 QDSKN:  BLOCK NQCHN     ;DISK UNIT NUMBER
2905 DWSKN:  0               ;DISK WRITING DIR ON
2906 SWSKN:  REPEAT NQS,.RPCNT       ;DISK SWAP XFER
2907 QSCRW:  BLOCK NQCHN     ;0 READ -1 WRITE
2908         -1              ;D.W.
2909         BLOCK NQS       ;SWAP
2910 QSCABN: BLOCK NQCHN     ;ACTIVE BUFFER NUMBER PI LEVEL OR -1 IF NONE
2911 DWABN:  -1              ;DISK D.W. A.B.N
2912 SWABN:  REPEAT NQS,-1   ;SWAP ABN
2913 QUDPR:  BLOCK NQCHN     ;NUMBER OF ASSOCIATED USER DIR PNTR
2914 QUDFPR: BLOCK NQCHN     ;RELATIVE PNTR TO FILE AREA, ZERO IF NO PARTICULAR FILE
2915 QMPTN:  BLOCK NQCHN     ;HAS LAST TRACK STORED IN DIRECTORY
2916 QMPTC:  BLOCK NQCHN     ;MAIN PRGM TRACK COUNT
2917 QMTTR:  BLOCK NQCHN     ;TRACK RESERVED OR -1
2918 QMFTP:  BLOCK NQCHN+1   ;TRACK NUMBER FOR SCAN FOR FREE TRACKS IN TUT ON WRITE
2919         REPEAT NQS,NUDSL; DITTO FOR SWAP CHANNELS
2920 QERRS:  BLOCK NQCHN+NQS+1 ;NUMBER ERRORS TRYING LAST OP
2921 QSMPRP: BLOCK NQCHN     ;MAIN PRGM BYTE POINTER
2922 QSMPRC: BLOCK NQCHN     ;M.P. COUNT (BYTES LEFT IN BUFFER)
2923 QSBYTE: BLOCK NQCHN     ;LH BYTE PNTR (P=44), RH BYTES PER WORD
2924 QSBSIZ==300600,,QSBYTE  ;BYTE POINTER TO CHANNEL BYTE SIZE
2925 QFBLNO: BLOCK NQCHN     ;BYTE # IN FILE OF BEG OF BLOCK BEING PROCESSED AT M.P. LEVEL
2926 QRADAD: BLOCK NQCHN     ;DESIRED BYTE ADR (LOOKED AT IF %QAACC OR %QAMPU IN QSRAC SET)
2927 QPIBSZ: BLOCK NQCHN     ;NUMBER OF BYTES IN BLOCK ACTIVE AT P.I. LEVEL (READ)
2928                         ;BIT 4.9 => GET FROM LAST WORD IN BLOCK (%QAFNY)
2929                         ; 8/20/90 %QAFNY can no longer happen.
2930 QMPBSZ: BLOCK NQCHN     ;NUMBER OF BYTES IN MN PROG ACTIVE BUFFER
2931 QLDPTR: BLOCK NQCHN     .SEE NLDSBQ ;DURING SBLK LOADING, HOLDS THE AOBJN POINTER
2932                         ;INTO USER CORE FOR DOING A DISK TRANSFER ON.
2933 QSMMP:  BLOCK NQS       ;MMP ADDRESS OF BLOCK ACTIVE ON SWAPPING CHANNEL
2934 \f
2935 ;VARIABLES FOR CURRENT TRANSFER
2936
2937 QSDU:   -1              ;UNIT TRANSFERING DATA, -1 IF NONE.
2938 QSDCH:  -1              ;CHNL READY TO BE TRANSFERED ON QSDU
2939 QERS1:  -1              ;ERR VERIFY SWITCH -1 NO ERR 0 EXPECTING COMPLETION OF VERIFY OP
2940 QDWIP:  0               ;NUMBER OF DIR WRITE IN PROGRESS 4.9=1=>MASTER
2941
2942 IFN T300P,[
2943 QSDU1:  -1              ;QSDU FOR OTHER CONTROLLER
2944 QSDCH1: -1              ;ASSOCIATED CHANNEL
2945 QTUNT1: -1              ;UNIT TO TRANSFER NEXT
2946 QTCHN1: -1              ;CHANNEL TO TRANSFER NEXT
2947 NRXFR1: 0               ;METERS
2948 NWXFR1: 0
2949 NSRXF1: 0
2950 NSWXF1: 0
2951 LQTM1:  0               ;TIME LAST TRANSFER STARTED
2952 ];T300P
2953
2954 ;MASTER FILE DIRECTORY
2955
2956 QMDRO:  -1              ;ORIGIN OF MASTER DIR 4.9 IF LOCKED
2957                         ;-2 ON WAY IN
2958                         ;4.6 NOT IN
2959                         ;4.5, 4.4, 4.3, ... CHANGED + NOT WRITTEN UNIT 0, 1, 2, ...
2960                         ;3.2=1 NOT RECONCILED (NQFUS NOT SET UP)
2961                         ;3.1-3.5 MUST BE ZERO (AT LEAST AFTER ITS RECONCILED)
2962 QAMDNO: -1              ;ASCENDING MASTER DIRECTORY NUMBER, -1 NOT SET UP
2963 NQFUS:  0               ;NUMBER OF FREE LOSER SLOTS IN MFD
2964
2965 ;TRACK UTILIZATION TABLES
2966
2967 QTUTO:  REPEAT NQS,-1   ;ADDRESS OF TUT.  LH SIMILAR TO QMDRO
2968                         ;4.9 LOCK
2969                         ;4.8 READ-IN NOT STARTED YET
2970                         ;4.6 NOT READ IN YET
2971                         ;CHANGED AND NOT WRITTEN ON UNIT
2972                         ;0 = 4.5  1 = 4.4  2 = 4.3  3 = 4.2  4 = 4.1
2973                         ;5 = 3.9  6 = 3.8
2974                         ;3.1-3.5 MUST BE ZERO
2975 QDPWF:  BLOCK NQS       ;-1 TUT NOT RECONCILED (CALL QTCH1)
2976 QTWRTM: BLOCK NQS       ;TIME TUT LAST WRITTEN
2977 QSFT:   REPEAT NQS,-1   ;NUMBER TRACKS FREE IN USER AREA
2978 QSFTS:  BLOCK NQS       ;NUMBER TRACKS FREE IN SWAPPING AREA
2979 QPKNM:  BLOCK NQS       ;NAME OF PACK
2980 QPKID:  REPEAT NQS,-1   ;PACK ID OF DISK ON DRIVE
2981 IFN QRSRVP,[
2982 QRESRV: REPEAT NQS,-1   ;NON-ZERO => PACK ON THIS DRIVE RESERVED.  SET FROM TUT.
2983                         ;NOT 0 AND NOT -1 => SIXBIT DEVICE NAME FOR "SECONDARY" PACK
2984 ];QRSRVP
2985 NTBL:                   ;NUMBER OF BLOCKS IN TUT ON THIS DRIVE
2986 IFE T300P, REPEAT NQS, NTUTBL
2987 IFN T300P,[
2988         REPEAT T300P, NTUTBL
2989         REPEAT NQS-T300P, NTUTB1
2990 ];T300P
2991
2992 ;POSITIONER VARIABLES (INDEXED BY PHYSICAL DRIVE)
2993
2994 QSKT1:  REPEAT NQS,-1   ;CHANNEL POSITIONER SET FOR OR -1 IF NONE
2995 QRCAL:  REPEAT NQS,0    ;-1 IF RECALIBRATING
2996 QSPPS:  REPEAT NQS,-1   ;INTENDED POSITIONER POSITION (NOT USED???)
2997 QSEEK:  BLOCK NQS       ;-1 IF SEEKING
2998 QPOS:   REPEAT NQS,-1   ;CURRENT CYLINDER
2999 QPOSGL: BLOCK NQS       ;CYLINDER TRYING TO POSITION TO
3000 IFN DC10P,[
3001 QRCTIM: BLOCK NQS       ;RECALIBRATE TIMEOUT IN HALF SECONDS.  THE ATTNS
3002 ];DC10P                 ; TEND TO GET LOST FOR SOME REASON
3003
3004 ;MISCELLANEOUS DISK VARIABLES
3005
3006 QACT:   REPEAT NQS,0    ;ONLY USE UNITS WITH 0
3007 QACTB:  0               ;4.5 UNIT 0 ACT  4.4 1 ACT  4.3 2  4.2 3  4.1 4
3008                         ;3.9 5  3.8 6
3009 QWBUFS: 0               ;TOTAL NUMBER OF WRITE BUFFERS ACTIVE
3010
3011 QWBFMX: 10.*DC10P+15.*RP10P+30.*RH10P+20.*RH11P  ;MAX # ALLOWED.  SHOULD BE
3012                                                  ; ABOUT 1 SEC DISK XFER.
3013 QHUNGF: 0               ;-1 => DISK CONTROL HUNG, PI LEVEL SHOULD RESET, RECALIBRATE, RETRY
3014 NTQHNG: BLOCK NQS       ;NUMBER OF TIMES TRANSFER HUNG ON THIS UNIT
3015
3016 QTUNT:  0       ;UNIT TO TRANSFER ON NEXT
3017 QTCHN:  0       ;CHNL ..
3018 QLCHN:  0       .SEE QINT2C
3019 QWRU:   -1      ;DEFAULT WRITE UNIT (-1 if there isn't a default unit yet)
3020 MDSK:   0       ;DRIVE # OF MASTER DISK
3021 QACTTM: -1      ;SETOM ON READ OR WRITE DATA TRANSFER
3022                 ;AOS AT SSLCK IF + OK TO WRITE DIRS
3023                 ;IE DON'T TIE UP DISK TO WRITE DIR UNLESS THINGS ARE QUIET
3024 QDWFAR: -10.    .SEE QINT3      ;WRITE DIRS SOME OF THE TIME ANYWAY
3025 LQTM:   0       ;TIME AT WHICH LAST COMMAND GIVEN TO DISK
3026 QFTTHR: 600.    ;IF FREE TRKS ON QWRU GOES BELOW THIS, SWITCH TO UNIT WITH MOST FREE TRACKS
3027 QRDAHD: IFE MCOND DM,[0] .ELSE 2        ;NUMBER OF BLOCKS TO READ AHEAD
3028
3029 LASTGC: 0       ;NAME OF LAST DIRECTORY TO GET GC'ED
3030 \f
3031 ;USER DIRECTORIES
3032
3033 QNUD==40.               ;NUMBER USER DIRECTORIES
3034
3035 QFUD:   QNUD            ;NUMBER OF FREE UFD SLOTS
3036
3037 QSNUD:  BLOCK QNUD      ;USER NAME OR 0 IF FREE
3038 QSNLCN: BLOCK QNUD      ;4.9 LOCKED, 4.8 ALSO NOT IN CORE RH CORE ADR
3039          .SEE DCHBT     ;4.6 =1 NOT PAWED OVER 4.5 CHNGD AND NOT WRITTEN ON UNIT 0
3040                         ;4.4 UNIT 1 4.3 UNIT 2 4.2 UNIT 3 4.1 UNIT 4
3041                         ;3.9 UNIT 5 3.8 UNIT 6 3.7 UNIT 7
3042  %QUDWM==40             ;3.6 WRITE IMMEDIATELY ON MASTER DISK
3043                         ;@ + XR BITS MUST = 0
3044
3045 QSNNR:  BLOCK QNUD      ;NUMBER PC'S LOOKING AT THIS IE
3046                         ;+1 FOR FILE OPEN AND USER IN CORE(?)
3047 QSNMI:  BLOCK QNUD      ;TRACK N OF USER DIR IF NOT NEWLY CREATED
3048 QSFBT:  BLOCK QNUD      ;FREED-BLOCKS-TABLE.  HEAD OF A LIST OF PAGES,
3049                         ;THREADED THROUGH THE SECOND WORD AND ENDING WITH
3050                         ;ZERO.  FIRST WORD IS AOBJN POINTER TO FREE PART
3051                         ;OF PAGE.  FROM THIRD WORD UP TO BELOW WHERE AOBJN
3052                         ;POINTS ARE WORDS UNIT,,BLOCK WHICH RECORD DISK
3053                         ;BLOCKS TO BE FREED ONCE THE DIR HAS BEEN WRITTEN
3054                         ;OUT TO THE MASTER DISK.  ELIMINATES REUSED ADDRESS
3055                         ;PROBLEMS BY GUARANTEEING THAT IF THE SYSTEM SHOULD
3056                         ;CRASH AT ANY TIME, THERE CANNOT BE TWO DIRECTORIES
3057                         ;ON DISK THAT BOTH POINT TO THE SAME BLOCK.
3058
3059 IFN QRSRVP,[
3060 QSALLO: BLOCK QNUD      ;-1 OR DRIVE # DIRECTORY ALLOCATED TO
3061 ]
3062
3063 ;LOCKS
3064
3065 UDRSW:  -1      ;USER DIR AREA LOCKED
3066         0
3067 QCHSW:  -1      ;CHNL AREA LOCKED
3068         0
3069 QSKOSW: -1      ;QSKO1 LOCKED (USER DIR READIN)
3070         0
3071
3072 ;LIST OF PAGES CONTAINING BLOCKS WHICH CAN NOW BE FREED.  MOVED TO
3073 ;HERE FROM QSFBT WHEN THE DIR IS WRITTEN OUT.  THE ACTUAL FREEING
3074 ;IS DONE BY THE CORE JOB.
3075
3076 QFBTS:  0
3077
3078 ;VARIABLES FOR SYSTEMS CONCEPTS DISK CONTROL
3079
3080 IFN DC10P,[
3081 QRCSW:  105     ;- NO READ COMPARE 0 COMPARE WRITES + COMPARE ALL
3082 QCST:   0       ;CONI DC0, AT QINT
3083 QERST:  0       ;HAS CONI DC1, BITS WHEN AN ERROR HAPPENS
3084 PKIDM:  0       ;-1 WAITING FOR PACK ID TO BE READ
3085 RPKID:  -1      ;PACK ID READ INTO HERE BY DISK CONTROL
3086 QDRSTS: 0       ;DRIVE STATUS WORD STORED BY DISK CONTROL
3087 ]
3088 IFE DMDSK,[
3089         0       ;FOR BLT INTO QXWDS
3090 QXWDS:  BLOCK NXWDS
3091 ]
3092 IFN DC10P,[
3093 QCHPRG: 0
3094 QCHPR2: DCOPY (-2000_2&37774)
3095         DCOPY (-NXWDS_2&37774)QXWDS
3096 QCHPR4: DHLT    ;OR DRC
3097 QCHPR3: DCCOMP (-2000_2&37774)
3098         DCCOMP (-NXWDS_2&37774)QXWDS
3099         DHLT
3100
3101 GPKID:  DSPC+DSCRHD+DSWNUL+DUNENB+TUTCYL_11.+TUTSRF_6+TUTSEC
3102         DCOPY RPKID(37774)
3103         DHLT
3104 QRECAL: DSPC+DSRCAL+DUNENB
3105 ]
3106
3107 ;VARIABLES FOR DEC RP10 DISK CONTROL
3108
3109 IFN RP10P,[
3110 QERST:  0       ;CONI DPC, ON ERROR
3111 QERDTI: 0       ;DATAI DPC, ON ERROR
3112 QCST:   0       ;CONI DPC, AT QINT
3113 QCHPRG: 0       ;SEEK COMM
3114 IFN KA10P, QIOWD: -2000,,       ;XFER DATA (HRRM ADR-1 IN RH)
3115 IFE DMDSK,[
3116         -NXWDS,,QXWDS-1
3117         -200+NXWDS,,0
3118 ];DMDSK
3119         0
3120
3121 QRECAL: 700000,,
3122 QGTBZY: 0       ;FLAG FOR SOFTWARE AT INT
3123 ];RP10P
3124 IFN QRDCMP,[
3125 QRCSW:  0       ;NON-ZERO TO ENABLE READ-COMPARING
3126 RDCPHS: 0       ;0 NORMAL, -1 DOING OPERATION WHICH SHOULD BE READ-COMPARED
3127                 ; AFTERWARD, + DOING READ-COMPARE
3128 IFN KA10P,[
3129 RCIOWD: BLOCK 2 ;CHANNEL PROGRAM FOR READ INTO QRCBUF
3130 ];KA10P         ;ON KL WE HAVE TO PUT IT IN THE EPT!
3131 QRCBUF: BLOCK 2000
3132 ];QRDCMP
3133 \f
3134 ;VARIABLES FOR DEC RH10 DISK CONTROL
3135
3136 IFN RH10P,[
3137 QCHPRG: 0       ;DATA TRANSFER COMMAND
3138 QCHPGA: 0       ;ADDRESS (CYL IN LH, TRACK-SECTOR IN RH)
3139 NCSHI:  0       ;NUMBER OF CACHE INVALIDATES
3140 NCSHIL: 0       ;NUMBER OF LOOPS WAITING FOR CACHE INVALIDATES
3141 NCSHU:  0       ;NUMBER OF CACHE UNLOADS
3142 NCSHUL: 0       ;NUMBER OF LOOPS WAITING FOR CACHE UNLOADS
3143 QERST:  0       ;CONI AT LAST ERROR (LEAVE THIS THROUGH QECPAT IN SAME ORDER)
3144         0       ;DATAI AT LAST ERROR
3145 QERSTS: 0       ;%HRSTS AT LAST ERROR
3146 QERER1: 0       ;%HRER1 AT LAST ERROR
3147 QERER2: 0       ;%HRER2 AT LAST ERROR
3148 QERER3: 0       ;%HRER3 AT LAST ERROR (IBM WOULD CALL THIS A CHANNEL LOGOUT AREA)
3149 QERDCL: 0       ;%HRDCL AT LAST ERROR
3150 QECPOS: 0       ;%HRPOS AT LAST ERROR
3151 QECPAT: 0       ;%HRPAT AT LAST ERROR
3152 QCST:   0       ;CONI AT LAST INTERRUPT
3153 QGTBZY: 0       ;FLAG FOR SOFTWARE-CAUSED INTERRUPT
3154 QECCS:  BLOCK NQS       ;NUMBER OF ECC CORRECTED ERRORS, PER DRIVE
3155 QECCAD: BLOCK NQS       ;DISK ADDRESS OF MOST RECENT ECC CORRECTED ERROR
3156 RHDATO: -1              ;LAST DATAO DSK, FOR DEBUGGING
3157 ECCPAG: BLOCK 8         ;TEMP FOR SAVING PAGE MAP VARS AT QECC (WITH SPM)
3158 NQDRE:  BLOCK NQS       ;# MASSBUS TIMEOUTS PER DRIVE.
3159 NQSATN: BLOCK NQS       ;# SPURIOUS ATTENTIONS IN MID-TRANSFER
3160 NQEATN: BLOCK NQS       ;# ATTENTIONS REPORTING ERRORS
3161 ]
3162
3163 ;VARIABLES FOR DEC RH11 DISK CONTROL (ON THE KS10 UNIBUS)
3164
3165 IFN RH11P,[
3166 QCHPRG: 0       ;DATA TRANSFER COMMAND
3167 QCHPGA: 0       ;ADDRESS (CYL IN LH, TRACK-SECTOR IN RH)
3168 QIOWD:  0       ; BA,,WC for RH11
3169 QCST:   0       ;CS1 AT LAST INTERRUPT
3170 QGTBZY: 0       ;FLAG FOR SOFTWARE-CAUSED INTERRUPT
3171
3172 QERST::         ;Gubbish saved at last error
3173 QERCS1: 0       ; CS1   Control & Status 1
3174 QERCS2: 0       ; CS2   Control & Status 2
3175 QERSTS: 0       ; STS   Drive status
3176 QERBA:  0       ; BA    Unibus address for transfer
3177 QERWC:  0       ; WC    Word count for transfer
3178 QERER1: 0       ; ER1   Error 1
3179 QERER2: 0       ; ER2   Error 2
3180 QERER3: 0       ; ER3   Error 3
3181 QERPOS::
3182 QECPOS: 0       ; POS   ECC position
3183 QERPAT::
3184 QECPAT: 0       ; PAT   ECC pattern
3185 QERMAP: 0 ? 0   ; Unibus map to disk buffer
3186
3187 QECCS:  BLOCK NQS       ;NUMBER OF ECC CORRECTED ERRORS, PER DRIVE
3188 QECCAD: BLOCK NQS       ;DISK ADDRESS OF MOST RECENT ECC CORRECTED ERROR
3189
3190 NQSATN: BLOCK NQS       ;# SPURIOUS ATTENTIONS IN MID-TRANSFER
3191 NQEATN: BLOCK NQS       ;# ATTENTIONS REPORTING ERRORS
3192 NQOFFL: BLOCK NQS       ;# TIMES DISK WENT OFFLINE
3193 ]
3194
3195 DIRHNG: 0       ;LH POINTS TO LIST OF DIRHNG DEVICE CHANNELS,
3196                 ;CHAINED THROUGH LH'S OF IOCHNM WORDS.
3197                 ;0 MEANS END OF LIST
3198                 ;MODIFY ONLY WITH THE CLOCK OFF.
3199         ;EACH DIRHNG DEVICE CHANNEL'S IOCHST WORD RH CONTAINS THE
3200         ;TRACK NUMBER OF THE DIRECTORY IT IS LOOKING AT.
3201
3202 BBLK
3203
3204 ;DISK CONSTANTS
3205
3206 IFN RP10P,[
3207 QATTNS: REPEAT NQS,500000+.RPCNT_14,,1_<10-.RPCNT>
3208 ;WORDS TO CLEAR ATTNS AND SELECT DRIVES
3209 ]
3210
3211 SWAPL:  SINLST(Q)
3212         SOUTLS(Q)
3213
3214 DCHBT:  20000,, ;BIT SET IF DIR NOT WRITTEN OUT ON UNIT
3215         10000,,
3216         4000,,
3217         2000,,
3218         1000,,
3219         400,,
3220         200,,
3221         100,,
3222 IFL .-DCHBT-NQS,.ERR YOU BETTER FIND ANOTHER BIT FOR QACTB,QSNLCN,QTUTO
3223
3224 IFN DC10P,[
3225 QTRAN:  0       ;FORMERLY MAPPED 203 CYL VIRTUAL DRIVES TO 406 CYL CALCOMPS
3226         1       ;4.9 => 2ND HALF OF PHYSICAL DRIVE
3227         2       ;(DOESN'T DO ANYTHING NOW THAT MEMOWRECKS ARE GONE,
3228         3       ; BUT KEEP AROUND IN CASE EVER NEEDED AGAIN.)
3229         4
3230         5
3231         6
3232         7
3233 IFL .-QTRAN-NQS,        .ERR BARF AT QTRAN
3234 ]
3235 \f
3236 SUBTTL DISK CLOSE ROUTINES
3237
3238 QICL:   PUSH P,R
3239         SKIPGE QUSR(A)
3240          BUG
3241         MOVSI Q,%QAACC
3242         ANDCAM Q,QSRAC(A)       ;FLUSH RANDOM ACCESS HACKERY
3243         PUSHJ P,QICLW1          ;WAIT FOR INPUT TO STOP
3244         MOVE TT,QSRAC(D)
3245         TLNE TT,%QADEL  ;DELETE?
3246          JRST QSICLD    ;YES
3247         MOVE H,QUDPR(D)             ;DIRECTORY NUMBER
3248         SETOM QUSR(D)
3249         AOS QFCHN
3250 QICLX:  SOSGE QSNNR(H)              ;FREE DIRECTORY CHANNEL HAD BEEN USING
3251          BUG
3252         POP P,R
3253         SETZM (R)
3254         POPJ P,
3255
3256 QICLW1: MOVE D,A                ;IDLE CHANNEL AND FLUSH READ BUFFERS
3257         CONO PI,UTCOFF
3258         SKIPGE QSGL(D)
3259          JRST QSICL3
3260         SKIPL QSCABN(D)
3261          JRST QSICL4
3262         SETOM QSGL(D)
3263
3264 QSICL3: HLLZS QSRAC(D) .SEE %QMIDL ;STOP PI
3265         CONO PI,UTCON
3266 QSICL5: PUSHJ P,QSBRB1  ;RETURN M.P. BUFFER IF ANY
3267 QOCL7:  HRRZ A,QBFP(D)  ;ALSO ENTER TO RETURN UNUSED READ BUFFER ON WRITE OVER MODE
3268 QSICL2: JUMPE A,QSICL6
3269         LDB C,[MLO,,MEMBLT(A)]
3270         PUSHJ P,MEMR
3271         MOVE A,C
3272         SOS QSBFS(D)
3273         JRST QSICL2
3274
3275 QSICL6: SETZM QBFP(D)
3276         POPJ P,
3277
3278 QSICL4: MOVEI A,%QMRD1  ;STOP PI AFTER THIS BLOCK
3279         HRRM A,QSRAC(D)
3280         CONO PI,UTCON
3281         SKIPL QSGL(D)   ;WAIT FOR CHANNEL TO DEACTIVATE
3282          PUSHJ P,UFLS
3283         JRST QSICL5
3284 \f
3285 ;OUTPUT CLOSE
3286 QOCL:   PUSHJ P,QSOCL5  ;CLEAN UP THE DISK CHANNEL
3287 QSOCL4: MOVE D,A        ;ENTRY FROM QALINK
3288 QSOCL6: MOVE Q,QUDFPR(D)
3289         MOVE H,QUDPR(D)
3290         ADD Q,QSNLCN(H)
3291         MOVE TT,QSRAC(D)
3292         TLNE TT,%QADEL
3293          JRST QCDLWO    ;DELETED (PRESUMABLY VIA DELEWO)
3294         MOVE A,UNFN1(Q) ;Get names of file being hacked.
3295         MOVE B,UNFN2(Q)
3296         PUSHJ P,QLOOK   ;FILING OVER ANYTHING?
3297          JRST QSOCL3
3298         HRRZ I,QSNLCN(H)
3299         ADD I,QUDFPR(D)
3300         CAMN I,Q        ;BEING WRITTEN BITS WENT AWAY?
3301          BUG            ;TRYING TO DELETE THE FILE WE'RE WRITING
3302         PUSHJ P,QSOCLD  ;YES FLUSH IT
3303         PUSHJ P,QUDLK   ;RELOCK DIR UNLOCKED BY QSOCLD ETC
3304         JRST QSOCL6     ;MAKE SURE ONE HASN'T REAPPEARED WHILE DIR UNLOCKED
3305
3306 QSOCL5: LDB H,[$QAMOD,,QSRAC(A)]
3307         JUMPN H,QOCL6   ;DONT HACK ACTIVE WD COUNT IN WRITEOVER MODE
3308 QOCL6A: MOVN D,QSMPRC(A)        ;- NUMBER OF BYTES IN BLOCK NOT USED
3309         ADDB D,QMPBSZ(A)        ;ADJUST BYTE COUNT OF LAST BLOCK TO REFLECT WHATS USED
3310         CLEARM QSMPRC(A)        ;SO WILL BE A NOOP IF PCLSR OUT AND COME BACK THRU HERE
3311 QOCL4:  MOVSI Q,%QAEFW
3312         IORM Q,QSRAC(A)         ;SET EOF BIT FOR QSBWW AND QUDS
3313         JUMPN H,QOCL5
3314         SKIPL QSMDN(A)          ;NO M.P. BUFFER ANYWAY
3315          JUMPE D,QOCL1          ;ABOUT TO WRITE NULL BLOCK, DON'T
3316 QOCL5:  PUSHJ P,QSBWW
3317 QOCL2:  MOVE T,A
3318         PUSHJ P,[ SKIPGE QSCRW(T)       ;WAIT FOR CHANNEL EITHER LEAVING WRITE MODE
3319                    SKIPN QSBFS(T)       ;OR WRITING OUT ALL ITS BUFFERS, I.E. PI LEVEL
3320                     JRST POPJ1          ;ISN'T GOING TO DO ANYTHING MORE TO IT.
3321                   POPJ P, ]
3322          PUSHJ P,UFLS
3323         SKIPE QBFP(A)           ;MAKE SURE IF QSBFS NON-ZERO THAT IS ONLY EOF
3324          BUG                    ;NOT A BUFFER SITTING AROUND FORGOTTEN
3325 QOCL3:  MOVE H,QUDPR(A)
3326         PUSHJ P,QUDLK
3327         SKIPN D,QMPTC(A)        ;SKIP ON NEXT "N" STILL PENDING
3328          POPJ P,
3329         PUSHJ P,QUDS            ;STORE IT AWAY
3330         CLEARM QMPTC(A)
3331         POPJ P,
3332
3333 QOCL6:  SKIPGE QSCRW(A) ;WAIT FOR CHANNEL TO IDLE OR HANG UP IN READ
3334          PUSHJ P,UFLS
3335         SKIPL QSGL(A)
3336          PUSHJ P,UFLS
3337         MOVE D,A
3338         PUSHJ P,QOCL7
3339         MOVE A,D
3340         MOVE Q,QSRAC(A)
3341         MOVE B,QSBFS(A)
3342         JUMPE B,QOCL6B
3343         TLNE Q,%QAEFW
3344          JRST QOCL6B
3345         TLNE Q,%QAEFR
3346          SOS B,QSBFS(A) ;COMPENSATE FOR EXTRA AOS ON EOF READ
3347 QOCL6B: CAILE B,1
3348          BUG
3349         TLNE Q,%QAWOV
3350          JRST QOCL6A    ;HACKING LAST BLOCK PAST EOF, UPDATE ACTIVE WD COUNT
3351         JRST QOCL4
3352
3353 QOCL1:  PUSHJ P,QSBRB   ;DISCARD BUFFER
3354         SOS QSBFS(A)
3355         SOS QWBUFS
3356         MOVE D,QDSKN(A)
3357         AOS QSFT(D)     ;RESTORE TRACK
3358         JRST QOCL2
3359 \f
3360 QSOCL3: MOVE Q,QUDFPR(D)
3361         MOVE TT,QSNLCN(H)
3362         ADDI Q,(TT)
3363         MOVSI T,UNWRIT
3364         ANDCAM T,UNRNDM(Q)      ;CLEAR WRITE IN PROG
3365         MOVE TT,QSNLCN(H)
3366         MOVE T,UDNAMP(TT)       ;MAKE SURE IT GOES BEFORE * FILE OF SAME NAME
3367         ADDI T,(TT)
3368         CAMN T,Q
3369          JRST QSOC3E    ;NO PREV FILE
3370         MOVE J,Q
3371 QSOC3A: SUBI J,LUNBLK
3372         CAMN A,UNFN1(J)
3373         CAME B,UNFN2(J)
3374          JRST QSOC3B    ;PREV FILE HAS DIFFERENT NAME
3375         CAILE J,(T)
3376          JRST QSOC3A
3377 QSOC3C: CAMN J,Q
3378          JRST QSOC3E
3379 REPEAT LUNBLK,  PUSH P,.RPCNT(J)
3380         MOVE T,J
3381         HRL T,Q
3382         BLT T,LUNBLK-1(J)
3383 REPEAT LUNBLK,  POP P,LUNBLK-.RPCNT-1(Q)
3384         SUB Q,J
3385         SUBI J,(TT)
3386         MOVSI T,-NQCHN
3387 QSOC3D: HRRZ A,QUDPR(T)
3388         SKIPL QUSR(T)
3389          CAIE A,(H)
3390           JRST QSOC3F
3391         HRRZ A,QUDFPR(T)
3392         CAIN A,(J)
3393          ADD A,Q
3394         MOVEM A,QUDFPR(T)
3395 QSOC3F: AOBJN T,QSOC3D
3396 QSOC3E: SETOM QUSR(D)   ;FREE THE DISK CHANNEL
3397         AOS QFCHN
3398         MOVE C,QSNUD(H)
3399 IFN TPLP+UNSPLP,[
3400         MOVEI TT,SCRTPC
3401         CAMN C,[SIXBIT /.LPTR./]
3402          IORM TT,SUPCOR ;CLOSING FILE ON TPL DEVICE SO SET FLAG FOR SYS JOB
3403 ];TPLP
3404         CAMN C,[SIXBIT/.MAIL./]
3405          AOS NQMFWR     ;CLOSING FILE ON .MAIL. => BUMP COUNT TO WAKE MAILER DEMON
3406 IFN XGP,[
3407         CAMN C,[SIXBIT/.XGPR./]
3408          AOS NXGPFW     ;WAKE XGPSPL
3409 ];XGP
3410         MOVE A,QSNMI(H) ;TELL DIRHNG DEVICE ABOUT IT
3411         PUSHJ P,DIRSIG
3412         MOVE TT,QACTB   ;DIR CHANGED (AT LEAST WRITE-IN-PROG BIT TURNED OFF)
3413         IORM TT,QSNLCN(H)
3414         PUSHJ P,QUDULK
3415         SOSGE QSNNR(H)
3416          BUG
3417         PUSHJ P,QSTRTR
3418         SETZM (R)       ;CLEAR IOCHNM WORD.
3419         POPJ P,
3420
3421 QSOC3B: ADDI J,LUNBLK
3422         JRST QSOC3C
3423
3424 QOCLR:  MOVE Q,QSRAC(A) ;CLOSE UNIT ASCII OUTPUT
3425         TLNN Q,%QAWOV
3426          TLNN Q,%QAMWO+%QALNK
3427           PUSHJ P,QOCLPD        ;PUT NEEDED PADDING UNLESS NOT A FILE OR NOT AT END
3428         JRST QOCL
3429
3430 QOCLPD: LDB Q,[360600,,QSMPRP(A)] ;NUMBER OF BITS NOT WRITTEN IN LAST WORD
3431         CAIL Q,44
3432          POPJ P,        ;LAST WORD NOT WRITTEN AT ALL
3433         LSH Q,18.+6     ;FILL THOSE BITS WITH ^CS
3434         HRR Q,QSMPRP(A)
3435         MOVE C,[EOFWRD]
3436         SKIPLE QSMPRC(A) ;INHIBIT STORE IF NO BUFFER ETC.
3437          DPB C,Q
3438         POPJ P,
3439 \f
3440 SUBTTL DISK INTERRUPT ROUTINES
3441
3442 OVHMTR QIN      ;DISK INTERRUPT LOW-LEVEL
3443
3444 IFN RP10P,[
3445
3446 QINT:   AOS QGTBZY
3447         MOVEM TT,QCST
3448 IFN DMDSK,[
3449         TRNN TT,200000  ;END OF CYLINDER
3450          JRST QINT0
3451         SKIPGE C,QSDCH
3452          BUG
3453         MOVE D,QSGL(C)
3454         IDIVI D,NBLKSC  ;IS IT LEGITIMATE?
3455         SKIPL QSDU      ;IF NO TRANSFER IN PROGRESS, IGNORE
3456          CAIN E,NBLKSC-1        ;IS LEGITIMATE FOR LAST BLOCK IN CYLINDER
3457           CAIA          ;IGNORE
3458            BUG PAUSE,[MAYBE DISK CONTROL IS WRITING ALL OVER THE DISK AGAIN]
3459 QINT0:  ];DMDSK
3460         TDNE TT,[17177700]      ;ANY ERRORS?
3461          JRST QINTE
3462 QINTN2: DATAI DPC,R
3463         SKIPGE QSDU     ;DONT CLOB CMD BUF TO CLR ATTS DURING DATA XFER
3464          TRNN R,776     ;ANY ATTNS
3465           JRST QINTA    ;NO
3466         LDB I,[11000,,R]        ;YES,FIND WHICH DRIVE
3467         JFFO I,.+1      ;CLOBBERS Q
3468         SUBI Q,28.
3469
3470 QINTAT: DATAO DPC,QATTNS(Q)     ;CLEAR ATTNS
3471         DATAI DPC,E
3472         TLNN E,40
3473          JRST QRECAT            ;NOT ON CYLINDER, RECALIBRATE
3474         LDB A,[DCYLI E]
3475         TRNE E,.BM DCYLXI
3476          ADDI A,400
3477         CAME A,QPOSGL(Q)
3478          JRST QRECAT    ;SEEK TO THE WRONG PLACE (CALCOMPS LIKE TO DO THIS)
3479         MOVEM A,QPOS(Q) ;REMEMBER WHERE IT IS AT
3480         SETZM QSEEK(Q)
3481         SETZM QRCAL(Q)
3482         JRST QINT       ;TRY AGAIN
3483
3484 QINTA:  SKIPGE Q,QSDU
3485          JRST QINT1     ;NOT EXPECTING DATA COMPLETION - FIND NEW TRANSFER
3486         CONSO DPC,400000
3487         CONSO DPC,10
3488          JRST DSKEX     ;TRANSFER STILL IN PROGRESS, DISMISS
3489         CONSZ DPC,20
3490          JRST .-1       ;BUSY?
3491         AOSN QHUNGF
3492          JRST QHE       ;XFER HUNG, RECALIBRATE AND RETRY
3493         JRST QINTA1     ;TRANSFER COMPLETE...
3494 \f
3495 QINTE:  DATAI DPC,R
3496         CONI DPC,TT     ;THIS LOOKS REDUNDANT BUT APPARENTLY IS NECESSARY
3497                         ;DUE TO TIMING OF THE DISK-NOT-READY CONDITION
3498         CONO DPC,175700+DSKCHN  ;RESET CONDITIONS
3499         MOVEM TT,QERST
3500         MOVEM R,QERDTI
3501         CONSZ DPC,20    ;WAIT FOR UNBUSY
3502          JRST .-1
3503         MOVE Q,QSDU     ;FOR QOVR
3504         MOVE E,QCHPRG
3505         TRNE TT,20000   ;OVERRUN
3506          JRST QOVR
3507         TRNE TT,2000    ;NOT READY
3508          JRST QNRDY
3509         TDNE TT,[12010700]      ;BITS 14,16,23,27-29 ARE LOSERS
3510          BUG HALT,[DSK: TOTALLY FATAL ERROR, CONI=],OCT,QERST
3511         TLNE TT,5       ;WD OR SECTOR PARITY ERROR
3512          JRST QDE
3513         TRNE TT,1000    ;WRITE LOCKED
3514          JRST QIRWRE
3515         TRNE TT,40000   ;SEARCH FAILED
3516          JRST QHE
3517         TRNN TT,100000  ;POWER FAILURE
3518          JRST QINTE1
3519         CONSZ DPC,100000        ;TRY IT AGAIN
3520          JRST 4,.-1
3521         JRST QHE
3522
3523 QINTE1: TLNE R,10       ;FILE UNSAFE--NEED OPERATOR INTERVENTION
3524          BUG PAUSE,[DSK: FILE UNSAFE UNIT ],DEC,Q
3525         TLNE R,4
3526          BUG    ;NO SUCH DRIVE
3527         TLNE R,110      ;POSITION FAILURE (OR PROCEEDED FILE UNSAFE)
3528          JRST QHE
3529         AOS NQSE(Q)     ;SPURIOUS ERROR
3530         JRST QINTX      ;IGNORE
3531
3532 QIRWRE: BUG PAUSE,[DSK: WRITE LOCKED UNIT ],DEC,Q
3533         JRST QHE
3534
3535 QNRDY:  LDB Q,[410300,,R]       ;WHICH DPC
3536         SKIPN QSEEK(Q)
3537          SKIPGE QRCAL(Q)        ;NOT SEEKING OR RECALIBRATING IS ERROR
3538           JRST QINTN2
3539         BUG PAUSE,[DSK: UNIT ],DEC,Q,[NOT READY]
3540         JRST QREC
3541 ] ;END IFN RP10P
3542 \f
3543 IFN DC10P,[
3544
3545 QINT:   MOVEM TT,QCST
3546         SKIPL PKIDM     ;GETS SPURIOUS DIPE WHEN READING PACK ID
3547          CONSO DC1,7777 ;RUMOR THAT DSSERR DOESN'T ALWAYS SET
3548           TRNE TT,DSSERR
3549            JRST QINTE
3550         TRNE TT,DSSATT
3551          JRST QINTAT
3552 QINTA:  SKIPGE Q,QSDU
3553          JRST QINT1     ;NOT EXPECTING DATA COMPLETION, FIND NEW TRANSFER
3554         CONSZ DC0,DSSRUN+DSSACT
3555          JRST DSKEX     ;ACTIVE OR RUN, TRANSFER IN PROGRESS, DISMISS
3556         AOSN PKIDM      ;SKIP IF NOT FINISHED READING PACK ID
3557          JRST QSPKID
3558         AOSN QHUNGF
3559          JRST QHE       ;XFER HUNG, RECALIBRATE AND RETRY
3560         SKIPL QERS1
3561          JRST QEROK     ;OK ON VERIFY
3562         JRST QINTA1     ;TRANSFER COMPLETE...
3563
3564 QINTE:  CONI DC1,TT
3565         CONO DC0,DCCLR+DCERR+DSKCHN     ;CLEAR ERRORS
3566         MOVEM TT,QERST
3567         MOVE Q,QSDU
3568         CONSZ DC0,DSSRUN+DSSACT
3569          JRST .-1       ;ACTIVE OR RUN?
3570         SKIPL QERS1
3571          JRST QERL1     ;VERIFY ALSO LOST
3572         TRNE TT,DOFFL+DPROT+DDOBSY+DNXM+DCPERR
3573          JRST QINTE1    ;REALLY LOST BIG
3574         TRNE TT,DOVRRN
3575          JRST QOVR
3576         TRNE TT,DWTHER+DFUNSF   ;SEEK INC, END DISK, WATCHDOG, OR UNSAFE
3577          JRST QHE       ;TRY TO RECALIBRATE
3578         SKIPGE PKIDM
3579          TRZ TT,DRLNER  ;IGNORE LENGTH ERROR IF READING PACK #
3580         TRNE TT,DIPE+DRLNER+DRCER+DCKSER
3581          JRST QDE       ;TRY AGAIN
3582         SKIPGE PKIDM
3583          TRNE TT,-1
3584           AOS NQSE      ;SPURIOUS ERROR (NOT LENGTH ERROR IN PKIDM)
3585         JRST QINTX      ;SPURIOUS ERROR
3586
3587 QINTE1: TRNE TT,DOFFL
3588          BUG PAUSE,[DSK: UNIT ],DEC,Q,[OFFLINE]
3589         TRNE TT,DPROT
3590          BUG PAUSE,[DSK: UNIT ],DEC,Q,[WRITE PROTECTED]
3591         TRNE TT,DDOBSY
3592          BUG PAUSE,[DSK: DATAO WHEN BUSY]
3593         TRNE TT,DNXM+DCPERR
3594          BUG PAUSE,[DSK: MEM PAR OR NXM ERROR]
3595         JRST QOVR
3596
3597 QINTAT: CONI DC1,Q
3598         CONO DC0,DCCLR+DCCATT+DSKCHN    ;CLEAR ATTENTION
3599         LDB Q,[DSATDN Q] ;ATTENTION DRIVE NUMBER
3600         CAIGE Q,NQS
3601          SKIPL QRCAL(Q)
3602           JRST QINTX
3603         SETZM QRCAL(Q)
3604         CONO DC0,DCCLR+DCATEB+DSKCHN    ;CLEAR ATTENTION ENABLE
3605         JRST QINTX
3606
3607 ;THIS IS CALLED EVERY HALF SECOND
3608 QRCTMO: MOVEI Q,NQS-1
3609         SKIPL QRCAL(Q)
3610 QRCTM1:  SOJGE Q,.-1
3611         JUMPL Q,CPOPJ
3612         SOSL QRCTIM(Q)
3613          JRST QRCTM1
3614         BUG INFO,[DSK: RECAL TIMEOUT UNIT],DEC,Q
3615         SETZM QRCAL(Q)
3616         CONO DC0,DCCLR+DCATEB+DSKCHN    ;CLEAR ATTENTION ENABLE I GUESS
3617         JRST QRCTM1
3618 ];DC10P
3619 \f
3620 IFN RH11P,[
3621
3622 ;;; RHCLRC(Q)   Clear controller errors and select drive Q
3623 ;;; RHSLCT(Q)   Select drive Q
3624 ;;; RHCMD(A)    Command in A to current drive
3625 ;;; RHCLRD      Clear current drive
3626 ;;; RHCHEK      Check for immediate bad news
3627 ;;;     All return CS1 in A
3628
3629 RHSLCT: IOWRQ Q,%HRCS2
3630 RHCHEK: IORDQ A,%HRCS1
3631         TRNE A,%HXTRE+%HXMCP
3632          BUG HALT,[DSK: MASSBUS ERROR, CS1=],OCT,A
3633         POPJ P,
3634
3635 RHCLRC: IOWRQ Q,%HRCS2          ; Must select drive before clearing controller
3636         MOVEI A,%HXTRE+%HXIE+%HMNOP
3637 RHCMD:  TROA A,%HXIE
3638 RHCLRD:  MOVEI A,%HXIE+%HMCLR
3639         IOWRQ A,%HRCS1
3640         JRST RHCHEK
3641
3642 EBLK
3643 DSKBRK: 0
3644 BBLK
3645         JSR UTCSAV
3646 QINT:   AOS QGTBZY
3647         MOVE Q,QSDU
3648         IORDQ TT,%HRCS1
3649         MOVEM TT,QCST
3650         TRNE TT,%HXTRE+%HXMCP
3651          JRST QINTE
3652         TRNN TT,%HXSC           ; Perhaps some drive needs attention?
3653          JRST QINT0             ; Not unless SC is set!
3654         IORDQ A,%HRATN
3655         JFFO A,QINTAT
3656 QINT0:  SKIPGE Q,QSDU
3657          JRST QINT1             ; Not expecting completion of transfer.
3658         TRNN TT,%HXRDY
3659          JRST DSKEX             ; Transfer still in progress.
3660         AOSN QHUNGF
3661          JRST QHE               ; Transfer hung, recalibrate and retry.
3662         PUSHJ P,RHSLCT          ; Select that drive.
3663         IORDQ A,%HRSTS          ; Get its status.
3664         TRNE A,%HSERR           ; Just in case %HXTRE didn't get set (by
3665          JRST QINTE             ;  analogy with RH10)...
3666         JRST QINTA1             ; Transfer complete...
3667
3668 QINTAT: MOVNI Q,-35.(B)
3669         HRRZS Q
3670         MOVEI A,1
3671         LSH A,(Q)
3672         IOWRQ A,%HRATN          ; Turn off attention bit.
3673         CAIL Q,NQS
3674          JRST QINT0
3675         CAMN Q,QSDU
3676          JRST [ AOS NQSATN(Q)   ; Ignore attention in mid-transfer.
3677                 JRST QINTA2 ]
3678         SKIPE QACT(Q)
3679          JRST QINTA2            ; Ignore this drive.
3680         PUSHJ P,RHSLCT
3681         IORDQ B,%HRSTS          ; Get status of drive with attention.
3682         TRC B,%HSMOL+%HSDPR+%HSRDY
3683         TRNN B,%HSMOL+%HSDPR+%HSRDY+%HSVV
3684          PUSHJ P,QOFFL          ; Went offline and came back online
3685         TRNE B,%HSERR+%HSPIP
3686          JRST [ PUSHJ P,RHCLRD  ; Drive barfing not during transfer
3687                 AOS NQEATN(Q)   ;  so clear it
3688                 JRST .+1]       ;THEN CLEAR SEEK AND RECALIBRATE FLAGS
3689         SETZM QSEEK(Q)          ;POSITIONING COMPLETION
3690 IFDEF %HRCCY,[                  ;Current Cyl register only on RP disks
3691         IORDQ A,%HRCCY
3692         MOVEM A,QPOS(Q)         ;UPDATE CURRENT CYLINDER
3693         CAME A,QPOSGL(Q)
3694          SETOM QSKT1(Q)         ;SEEK TO WRONG PLACE
3695 ];IFDEF %HRCCY
3696 IFNDEF %HRCCY,[
3697         MOVE A,QPOSGL(Q)        ;On RMxx, jump to conclusion
3698         MOVEM A,QPOS(Q)
3699 ];IFNDEF %HRCCY
3700         SETZM QRCAL(Q)          ;NO LONGER RECALIBRATING
3701         JRST QINT0              ;IF NO XFER ACTIVE, MAYBE CAN START ONE ON
3702                                 ; THIS UNIT NOW
3703
3704 QINTA2: SETOM QSKT1(Q)          ;DON'T TRUST POS
3705         JRST DSKEX
3706
3707 ; Went offline and came back online
3708 QOFFL:  TRC B,%HSMOL+%HSDPR+%HSRDY      ;Recover %HRSTS
3709         IORDQ C,%HRER1
3710         IORDQ D,%HRER2
3711 IFDEF %HRER3,[
3712         IORDQ E,%HRER3
3713         BUG INFO,[DSK: UNIT #],DEC,Q,[CAME BACK ONLINE, CS1=],OCT,A,[STS=],OCT,B,[ER1=],OCT,C,[ER2=],OCT,D,[ER3=],OCT,E
3714 ]
3715 IFNDEF %HRER3,[
3716         BUG INFO,[DSK: UNIT #],DEC,Q,[CAME BACK ONLINE, CS1=],OCT,A,[STS=],OCT,B,[ER1=],OCT,C,[ER2=],OCT,D
3717 ]
3718
3719         AOS NQOFFL(Q)
3720         MOVEI A,%HMCLR          ;Clear the drive
3721         PUSHJ P,RHCMD
3722         MOVEI A,%HMRDP          ;I said, clear the drive!
3723         PUSHJ P,RHCMD
3724         MOVEI A,0
3725         IOWRQ A,%HROFS          ;No offset, 18 bits, ECC on, HCI off
3726         MOVEI A,%HMACK          ;Turn %HSVV back on so drive will work
3727         PUSHJ P,RHCMD
3728         POPJ P,
3729 \f
3730 QINTE:
3731 IRPS X,,[CS1 CS2 BA WC POS PAT] ; First get status of controller
3732         IORDQ A,%HR!X
3733         MOVEM A,QER!X
3734 TERMIN
3735         IORDQ A,UBAPAG+QUBPG_1  ; Unibus map counts as part of
3736         MOVEM A,QERMAP          ;  controller status.
3737         IORDQ A,UBAPAG+QUBPG_1+1
3738         MOVEM A,QERMAP+1
3739         SKIPGE Q                ; Try hard to guess the drive.
3740          LDB Q,[$HYDSK QERCS2]
3741         PUSHJ P,RHCLRC          ; Clear controller errors and select drive
3742                                 ; so that we can read its status too.
3743         TRNN A,%HXRDY           ; Why would controller be busy?  (RH10
3744          BUG                    ;  code checks for this...)
3745
3746 IRPS X,,[STS ER1 ER2]
3747         IORDQ A,%HR!X
3748         MOVEM A,QER!X
3749 TERMIN
3750         MOVE A,QERCS1           ; A: CS1
3751         MOVE R,QERCS2           ; R: CS2
3752 IFDEF %HRER3,[                  ; Disks with ER2 -and- ER3
3753         IORDQ A,%HRER3
3754         MOVEM A,QERER3
3755         SKIPN QERER2            ; Bad news
3756          SKIPE QERER3
3757           JRST UNSAFE
3758 ]
3759 IFNDEF %HRER3,[                 ; Disks with just ER2
3760         SKIPE QERER2
3761          JRST UNSAFE
3762 ]
3763         TRNN A,%HXMCP           ; Real bad news
3764          TRNE R,%HYWCE+%HYPE+%HYNED+%HYNEM+%HYPGE+%HYMXF
3765           BUG HALT,[DSK: UNIT #],DEC,Q,[LOSING.  CS1=],OCT,A,[ CS2=],OCT,R
3766         TRNE R,%HYDLT+%HYMDP    ; Data bus losing?
3767          JRST QINTE1
3768         MOVE A,QERSTS           ; Check Drive Status
3769         TRC A,%HSVV+%HSRDY+%HSDPR+%HSMOL        ; Better be all on!
3770         TRCE A,%HSVV+%HSRDY+%HSDPR+%HSMOL
3771          BUG
3772         TRNN A,%HSERR
3773          JRST [ AOS NQSE(Q)     ; Spurious?
3774                 JRST QINT0]
3775         MOVE B,QERER1           ; Check the main error register
3776         TRNE B,#<%H1ECC+%H1DTE+%H1CRC+%H1HCE+%H1ECH+%H1FER+%H1PAR>
3777          JRST UNSAFE            ; Those not listed above are considered "hard"
3778         CAIN B,%H1ECC           ; Correct correctable error if that is the
3779          JRST QECC              ;  only problem.
3780         PUSHJ P,QINTER          ; Else print message and reset drive
3781         TRNE B,%H1DTE+%H1CRC+%H1HCE+%H1FER      ; These require recalibration
3782          JRST QHE
3783         TRNE B,%H1ECC+%H1ECH+%H1PAR     ; These require reread
3784          JRST QDE
3785         JRST QOVR               ; No error bits set?  (How can this
3786                                 ; happen?)  Go and retry...
3787
3788 ;;; Controller error:
3789 QINTE1: BUG INFO,[DSK: ERR UNIT #],DEC,Q,[CS1=],OCT,QERCS1,[CS2=],OCT,QERCS2
3790         JRST QOVR
3791
3792 ;;; Drive error:
3793 IFDEF %HRER3,[
3794 QINTER: BUG INFO,[DSK: ERR UNIT #],DEC,Q,[ER1=],OCT,QERER1,[ER2=],OCT,QERER2,[ER3=],OCT,QERER3,[STARTING DISK ADDR=],OCT,QCHPGA
3795 ]
3796 IFNDEF %HRER3,[
3797 QINTER: BUG INFO,[DSK: ERR UNIT #],DEC,Q,[ER1=],OCT,QERER1,[ER2=],OCT,QERER2,[STARTING DISK ADDR=],OCT,QCHPGA
3798 ]
3799         JRST RHCLRD             ; Reset error status in drive
3800 \f
3801 ;;; Come here for drive unsafe and similar bad things.  May be set to
3802 ;;; either halt or attempt retry (via USFHLT variable).  Note that when we
3803 ;;; get here the state of the drive has not yet been disturbed.
3804 UNSAFE: SKIPE USFHLT
3805          BUG PAUSE,[DSK: TOO MANY ERRORS]
3806         MOVEI A,2               ;HALT IF ANOTHER ERROR WITHIN 1/2 - 1 SECOND
3807         MOVEM A,USFHLT
3808         PUSHJ P,QINTER          ;GIVE ERROR MESSAGE AND RESET DRIVE
3809         SKIPL QSDU
3810          JRST QHE               ;RECALIBRATE AND RETRY
3811         JRST QREC               ;Just recalibrate, no transfer to retry
3812
3813 QECC:   PUSHJ P,RHCLRD          ; Reset drive
3814         CAME Q,QSDU             ; ECC error better be for transfer in
3815          BUG                    ; progress...
3816         MOVE A,QCHPRG
3817         TRNN A,10       .SEE %HMRED
3818          BUG                    ; ECC error should only happen during read.
3819         LDB A,[$UPPAG QERMAP]
3820         IORI A,600000
3821         DPB A,[.PAREP+EXEUMP]   ; Point parity error page at buffer.
3822         CLRPT 400000+PAREP_12   ; Get it into our map now.
3823         CLRPT 401000+PAREP_12   ; Both halves...
3824         MOVE J,QERBA
3825         SUBI J,1000+QUBPG_14    ; Correct to relative byte address of start
3826                                 ; of losing sector.
3827         TRNE J,770777           ; Should always be aligned on sector boundary
3828          BUG                    ;  and within a single block, right?
3829         LSH J,-2                ; J: Address of first word of losing sector
3830                                 ;  within block.
3831         MOVE A,QECPOS           ; Get error position
3832         SOJL A,QDE              ;HARDWARE POS IS OFF BY 1; IF 0 NOT CORRECTABLE
3833         IDIVI A,36.             ;CONVERT TO WORD NO AND BIT NO
3834         CAIL A,177
3835          JRST [ ADDI B,36.      ;LAST WORD IN SECTOR - HACK IT TO AVOID NXM
3836                 SOJA A,.+1]
3837         ADDI J,400000+PAREP_12(A)       ; J: Address of losing word-pair
3838                                         ; (In parity error page.)
3839         MOVE U,B                ;SAVE BIT NUMBER
3840         MOVS B,(J)              ;GET FIRST LOSING WORD
3841         MOVS C,1(J)             ;GET SECOND LOSING WORD
3842         MOVE D,QECPAT           ;GET ERROR PATTERN
3843         SETZ E,                 ;MAKE INTO DOUBLE-WORD
3844         ROTC D,(U)              ;ALIGN IT
3845         XOR B,D                 ;FIX THE BAD BITS
3846         XOR C,E
3847         MOVSM B,(J)             ;PUT CORRECTED DATA BACK
3848         MOVSM C,1(J)
3849         MOVEI A,0
3850         DPB A,[.PAREP+EXEUMP]   ;FLUSH THE DISK BUFF FROM MAP
3851         CLRPT 400000+PAREP_12
3852         CLRPT 401000+PAREP_12   ; Both halves...
3853
3854         AOS QECCS(Q)            ;LOG THE LOSS
3855         LDB E,[111000,,QERBA]   ; E: Number of sectors transferred (including
3856         SUBI E,QUBPG_3          ;  ECC sector)
3857         MOVE A,QCHPGA
3858         LDB B,[$HASEC A]        ;Compute disk address of failing sector:
3859         ADDI B,-1(E)
3860         IDIVI B,NSECS           ; C: sector
3861         DPB C,[$HASEC A]
3862         LDB D,[$HATRK A]
3863         ADD B,D                 ; B: track
3864         DPB B,[$HATRK A]
3865         MOVEM A,QECCAD(Q)
3866         HLRZ A,A                ; A: cylinder
3867         MOVE D,QSDCH            ; D: chnl
3868         BUG INFO,[DSK: ECC CORRECTED ERROR, UNIT #],DEC,Q,[CYL ],DEC,A,[HEAD ],DEC,B,[SEC ],DEC,C,[QSRAC],OCT,QSRAC(D)
3869         CAIL E,SECBLK
3870          JRST QINTA1            ;XFER COMPLETE
3871
3872         LDB B,[$HASEC QCHPGA]   ;NOW DETERMINE WHERE TO RESUME TRANSFER
3873         ADD B,E
3874         IDIVI B,NSECS
3875         DPB C,[$HASEC QCHPGA]
3876         LDB C,[$HATRK QCHPGA]
3877         ADD C,B
3878         DPB C,[$HATRK QCHPGA]   ;NO NEED TO IDIVI A,NHEDS SINCE NEVER CROSS
3879                                 ; CYLINDERS
3880
3881         HRL E,QERWC             ; Reassemble "iowd" from
3882         HRR E,QERBA             ; saved parts.  (Don't trust stuff saved
3883         MOVEM E,QIOWD           ; in controller more than we have to.)
3884         HRRZ C,QSDCH            ;FOR QECCX
3885         JRST QECCX              ;MORE TO DO, CONTINUE XFER
3886
3887 ] ;RH11P
3888 \f
3889 IFN RH10P,[
3890
3891 QINT:   AOS QGTBZY
3892         MOVE Q,QSDU
3893         MOVEM TT,QCST
3894         TRNE TT,%HIERR
3895          JRST QINTE
3896         TRNN TT,%HIATN
3897          JRST QINT0
3898         MOVSI A,%HRATN          ;FIND DRIVES NEEDING ATTENTION
3899         PUSHJ P,RHGET
3900         JFFO A,QINTAT
3901 QINT0:  SKIPGE Q,QSDU
3902          JRST QINT1             ;NOT EXPECTING COMPLETION OF TRANSFER
3903         TRNN TT,%HIDON
3904          JRST DSKEX             ;NO COMPLETED TRANSFER
3905         CONSZ DSK,%HIBSY
3906          JRST 4,.-1             ;TRANSFER STILL IN PROGRESS??
3907         AOSN QHUNGF
3908          JRST QHE               ;XFER HUNG, RECALIBRATE AND RETRY
3909         MOVSI A,%HRSTS(Q)       ;SOMETIMES %HSERR SETS AND %HIERR DOESN'T!
3910         PUSHJ P,RHGET
3911         TRNE A,%HSERR
3912          JRST QINTE
3913         JRST QINTA1             ;XFER COMPLETE...
3914
3915 QINTAT: MOVNI Q,-35.(B)         ;LOW BIT IS DRIVE 0
3916         HRRZS Q
3917         MOVEI A,1               ;TURN OFF ATTENTION (DRIVE MAY BE LOSING
3918         LSH A,(Q)               ;IN SUCH A WAY THAT READING %HRSTS DOESN'T CLEAR ATTN)
3919         HRLI A,%HRATN
3920         PUSHJ P,RHSET
3921         CAMN Q,QSDU
3922          JRST [ AOS NQSATN(Q)   ;IGNORE ATTN IN MID-TRANSFER
3923                 JRST QINTA2 ]
3924         MOVSI A,%HRSTS(Q)       ;GET STATUS OF DRIVE WITH ATTENTION
3925         PUSHJ P,RHGET           ;THIS ALSO CLEARS THE ATTENTION BIT
3926         SKIPE QACT(Q)
3927          JRST QINTA2            ;IGNORE THIS DRIVE
3928         TRNE A,%HSERR+%HSPIP
3929          JRST [ MOVSI A,%HRDCL(Q)
3930                 HRRI A,%HMCLR   ;DRIVE REPORTING ERROR NOT DURING TRANSFER
3931                 PUSHJ P,RHSET   ;SO CLEAR THE DRIVE
3932                 AOS NQEATN(Q)
3933                 JRST .+1 ]      ;THEN CLEAR SEEK AND RECALIBRATE FLAGS
3934         SETZM QSEEK(Q)          ;POSITIONING COMPLETION
3935         MOVSI A,%HRCCY(Q)
3936         PUSHJ P,RHGET
3937         MOVEM A,QPOS(Q)         ;UPDATE CURRENT CYLINDER
3938         CAME A,QPOSGL(Q)
3939          SETOM QSKT1(Q)         ;SEEK TO WRONG PLACE
3940         SETZM QRCAL(Q)          ;NO LONGER RECALIBRATING
3941         JRST QINT0              ;IF NO XFER ACTIVE, MAYBE CAN START ONE ON THIS UNIT NOW
3942
3943 QINTA2: SETOM QSKT1(Q)          ;DON'T TRUST POS
3944         JRST DSKEX
3945
3946 ;INPUT FROM MASSBUS -  ADDRESS IN LH(A), RETURNS DATA IN A
3947
3948 RHGET:  TLZA A,%HRLOD
3949
3950 ;OUTPUT TO MASSBUS -  ADDRESS IN LH(A), DATA IN RH(A)
3951
3952 RHSET:   TLO A,%HRLOD
3953         DATAO DSK,A
3954         MOVEM A,RHDATO          ;SAVE FOR REBUGGING
3955         MOVEI A,5               ;WAIT 3 USEC FOR BUS CYCLE
3956         SOJG A,.
3957         DATAI DSK,A
3958         TLNE A,%HDERR
3959          BUG HALT,[DSK: MASSBUS ERROR, DATAO=],OCT,RHDATO,[DATAI=],OCT,A
3960         ANDI A,177777           ;RETURN 16-BIT REGISTER CONTENTS
3961         POPJ P,
3962 \f
3963 QINTE:  CONI DSK,TT
3964         DATAI DSK,R
3965         CONO DSK,%HOCLR+%HORAE+%HOATN+DSKCHN    ;RESET CONTROLLER SO DRIVE STATUS MAY BE READ
3966         CONSZ DSK,%HIBSY
3967          JRST .-1               ;SOMETIMES CONTROLLER IS BUSY??
3968         MOVEM TT,QERST
3969         MOVEM R,QERST+1
3970         SKIPGE Q                ;TRY HARD TO GUESS THE RIGHT DRIVE!
3971          LDB Q,[$HCDRV R]       ;CURRENTLY SELECTED DRIVE
3972         IRPS X,,[%HRSTS %HRER1 %HRER2 %HRER3 %HRDCL %HRPOS %HRPAT]
3973          MOVSI A,X(Q)           ;GET STATUS OF DRIVE
3974          PUSHJ P,RHGET
3975          MOVEM A,QERST+.IRPCNT+2
3976         TERMIN
3977         SKIPN QERER2            ;FILE UNSAFE
3978          SKIPE QERER3
3979           JRST UNSAFE
3980         TRZE TT,%HIDRE
3981          AOS NQDRE(Q)           ;THIS BIT SUSPECTED OF BEING SET RANDOMLY.
3982         ;;CHECK FOR IRRECOV (?) HARDWARE LOSSAGE. EVEN MORE SO THAN 'UNSAFE'
3983         TDNE TT,[%HIILF+%HISDE+%HINXM+%HIDRE+%HIILC+%HIPWR]
3984          BUG HALT,[DSK: UNIT ],DEC,Q,[ LOSING. RH10 CONI= ],OCT,QERST
3985 IFN KS10P, .ERR So whats this all about?
3986 IFN KL10P,[
3987         TLNN TT,(%HIDPE+%HICPE) ;IF CHANNEL DETECTS PARITY ERROR, CAUSE
3988          JRST QINTE0            ;PROCESSOR PARITY SWEEP WHICH WILL PROBABLY
3989         MOVSI A,SCLPAR          ;CRASH THE SYSTEM ANYWAY.  BEATS LOOPING!
3990         TDNN A,SUPCOR           ;BUT DON'T CAUSE CLKB1E+7 HALT
3991          CONO 10407
3992         BUG CHECK,[DSK: MEM PAR ERR, QICWA/],OCT,QICWA,OCT,QICWA+1,[QIOWD/],OCT,QIOWD
3993 QINTE0:
3994 ];KL10P
3995         TDNE TT,[%HIOVR+%HICOV+%HIDPE+%HICPE+%HIBPE]
3996          JRST QINTE1            ;OVERRUN OR PARITY ON CONTROL BUS OR CHANNEL BUS - RETRY
3997         MOVE A,QERSTS           ;DRIVE EXCEPTION, CHECK DRIVE STATUS
3998         TRC A,%HSVV+%HSRDY+%HSDPR+%HSMOL        ;THESE BITS BETTER ALL BE ON
3999         TRCE A,%HSVV+%HSRDY+%HSDPR+%HSMOL
4000          BUG                    ;DRIVE TURNED OFF?  MAYBE 11 HACKING THIS DRIVE?
4001         TRNN A,%HSERR
4002          JRST [ AOS NQSE(Q)     ;SPURIOUS?
4003                 JRST QINT0 ]
4004         MOVE B,QERER1           ;CHECK THE MAIN ERROR REGISTER
4005         TRNE B,#%H1SOF          ;ANY HARD ERRORS?
4006          JRST UNSAFE
4007         CAIN B,%H1ECC           ;IF JUST A CORRECTABLE ERROR,
4008          JRST QECC              ;GO CORRECT IT
4009         PUSHJ P,QINTER          ;OTHER SOFT ERROR, PRINT MESSAGE AND RESET DRIVE
4010         TRNE B,010620           ;SEARCH ERROR, OR HEADER READ OR FORMAT ERROR OR DRIVE TIMING
4011          JRST QHE               ;REQUIRES RECALIBRATE
4012         TRNE B,100110           ;BUS PARITY OR ECC "HARD"
4013          JRST QDE               ;REQUIRES RE-READ, GIVE UP AFTER N
4014         JRST QOVR               ;NO ERROR BITS, PRINT MESSAGE AND RETRY
4015
4016 ;CONTROLLER ERROR
4017 QINTE1: BUG INFO,[DSK: ERR UNIT #],DEC,Q,[CONI=],OCT,QERST,[DCL=],OCT,QERDCL
4018         JRST QOVR
4019
4020 ;DRIVE ERROR
4021 QINTER: BUG INFO,[DSK: ERR UNIT #],DEC,Q,[ER1=],OCT,QERER1,[ER2=],OCT,QERER2,[ER3=],OCT,QERER3,[STARTING DISK ADDR=],OCT,QCHPGA
4022         MOVSI A,%HRDCL(Q)       ;NOW RESET ERROR STATUS IN DRIVE
4023         HRRI A,%HMCLR
4024         JRST RHSET
4025
4026 ;COME HERE FOR DRIVE UNSAFE AND SIMILAR BAD THINGS.  MAY BE SET TO
4027 ;EITHER HALT OR ATTEMPT RETRY (VIA USFHLT VARIABLE).  NOTE THAT WHEN
4028 ;WE GET HERE THE STATE OF THE DRIVE HAS NOT YET BEEN DISTURBED.
4029 UNSAFE: SKIPE USFHLT
4030          BUG PAUSE,[DSK: TOO MANY ERRORS]
4031         MOVEI A,2               ;HALT IF ANOTHER ERROR WITHIN 1/2 - 1 SECOND
4032         MOVEM A,USFHLT
4033         PUSHJ P,QINTER          ;GIVE ERROR MESSAGE AND RESET DRIVE
4034         JRST QHE                ;RECALIBRATE AND RETRY
4035 \f
4036 QECC:   MOVSI A,%HRDCL(Q)       ;RESET ERROR STATUS IN DRIVE
4037         HRRI A,%HMCLR
4038         PUSHJ P,RHSET
4039         CAME Q,QSDU             ;CORRECT AN ECC ERROR
4040          BUG                    ;BARF ... NO TRANSFER IN PROGRESS
4041         MOVE A,QCHPRG
4042         TRNN A,10
4043          BUG                    ;BARF ... SHOULDN'T HAPPEN DURING WRITE
4044         SKIPN A,QICWA+1         ;GET ADDRESS OF LAST WORD READ
4045          JRST 4,.-1             ;CHANNEL OUGHT TO HAVE STORED CONTROL WORD BY NOW
4046         SOS J,A
4047         TDZ J,[177+.BM $DFCWA]  ;J := ADDRESS OF FIRST WORD IN LOSING SECTOR
4048         LDB A,[$DFCAD QIOWD]
4049         SUBM J,A
4050         SOS H,A                 ;# WORDS SUCCESSFULLY XFERED.
4051         CAIL H,0                ;CHECK IF CHANNEL STORED BAD ADDRESS
4052          CAILE H,2000-200
4053           JRST QDE              ;THIS SHOULD NEVER HAPPEN, BUT IT DOES, FREQUENTLY
4054         MOVE A,QECPOS           ;GET ERROR POSITION
4055         SOJL A,QDE              ;HARDWARE POS IS OFF BY 1; IF 0 NOT CORRECTABLE
4056         IDIVI A,36.             ;CONVERT TO WORD NO AND BIT NO
4057         CAIL A,177
4058          JRST [ ADDI B,36.      ;LAST WORD IN SECTOR - HACK IT TO AVOID NXM
4059                 SOJA A,.+1]
4060         ADD J,A                 ;J := ADDRESS OF LOSING WORD-PAIR
4061         LDB A,[121400,,J]
4062         ANDI J,1777             ;GET ADDR OF PAR ERR PAG
4063         ADDI J,400000+2000*PAREP ;IN EXEC ADDRESS SPACE
4064         IORI A,600000           ;MAKE THAT PAGE POINT TO THE DISK BUFFER
4065         DPB A,[.PAREP+EXEUMP]
4066         SPM ECCPAG              ;GET IT INTO OUR MAP.
4067         LPMR ECCPAG
4068         MOVE U,B                ;SAVE BIT NUMBER
4069         MOVS B,(J)              ;GET FIRST LOSING WORD
4070         MOVS C,1(J)             ;GET SECOND LOSING WORD
4071         MOVE D,QECPAT           ;GET ERROR PATTERN
4072         SETZ E,                 ;MAKE INTO DOUBLE-WORD
4073         ROTC D,(U)              ;ALIGN IT
4074         XOR B,D                 ;FIX THE BAD BITS
4075         XOR C,E
4076         MOVSM B,(J)             ;PUT CORRECTED DATA BACK
4077         MOVSM C,1(J)
4078         MOVEI A,0
4079         DPB A,[.PAREP+EXEUMP]   ;FLUSH THE DISK BUFF FROM MAP
4080         LPMR ECCPAG
4081
4082         AOS QECCS(Q)            ;LOG THE LOSS
4083         MOVE A,QCHPGA
4084         MOVEI E,200(H)
4085         LSH E,-7                ;NUMBER OF SECTORS TRANSFERRED (INCLUDING ECC SECTOR)
4086         LDB B,[$HASEC A]        ;GET DISK ADDR OF FAILING SECTOR
4087         ADDI B,-1(E)
4088         IDIVI B,NSECS
4089         DPB C,[$HASEC A]
4090         LDB D,[$HATRK A]
4091         ADD B,D
4092         DPB B,[$HATRK A]        ;NO NEED TO DIVIDE BY NHEDS SINCE NEVER CROSS CYLINDERS
4093         MOVEM A,QECCAD(Q)
4094         HLRZ A,A
4095         MOVE D,QSDCH
4096         BUG INFO,[DSK: ECC CORRECTED ERROR, UNIT ],DEC,Q,[CYL ],DEC,A,[HEAD ],DEC,B,[SEC ],DEC,C,[QSRAC],OCT,QSRAC(D)
4097         LDB B,[$HASEC QCHPGA]   ;NOW DETERMINE WHERE TO RESUME TRANSFER
4098         ADD B,E
4099         IDIVI B,NSECS
4100         DPB C,[$HASEC QCHPGA]
4101         LDB C,[$HATRK QCHPGA]
4102         ADD C,B
4103         DPB C,[$HATRK QCHPGA]   ;NO NEED TO IDIVI A,NHEDS SINCE NEVER CROSS CYLINDERS
4104         HRRZ C,QSDCH            ;FOR QECCX
4105         LDB A,[$DFCWA QICWA+1]  ;LAST CONTROL WORD PROCESSED
4106         SUBI A,1                ;CRETINOUS DF10
4107         CAIE A,QIOWD
4108          BUG                    ;CHANNEL STORED BAD ADDRESS?
4109         HRRZM A,QICWA
4110         MOVEI A,200(H)          ;# WORDS ALREADY DONE.
4111         DPB A,[$DFWC A]         ;PUT IT IN BOTH FIELDS.
4112         ADDB A,@QICWA           ;ADVANCE C.W. TO REMAINING STUFF
4113         TLNE A,(.BM $DFWC)
4114          JRST QECCX             ;MORE TO DO, CONTINUE XFER
4115         AOS QICWA               ;ELSE ADVANCE TO NEXT C.W.
4116         SKIPE @QICWA
4117          JRST QECCX             ;MORE TO DO, CONTINUE XFER
4118         JRST QINTA1             ;XFER COMPLETE
4119 ]
4120 \f
4121 IFN T300P,[
4122 T3INT:  SETZM DSCDON            ;CLEAR DONE FLAG THAT GOT US HERE
4123         SKIPGE QSDU1            ;OPERATION COMPLETE?
4124          JRST QINT1             ;NO, GO FIND SOMETHING TO DO
4125         HRRZ Q,DSCDRV           ;YES, GET DRIVE OPERATION WAS ON
4126         ADDI Q,T300P
4127         CAIGE Q,NQS
4128          CAME Q,QSDU1           ;TERMINATION ON DRIVE WE EXPECTED?
4129           BUG                   ;DRIVE NUMBER CLOBBERED?
4130         SETZM QRCAL(Q)          ;PRESUMABLY NOT RECALIBRATING ANY MORE.
4131         MOVE A,DSCCMD           ;COMMAND THAT JUST COMPLETED
4132         CAIN A,%DMREC           ;WAS IT A RECALIBRATE?
4133          JRST QINT1E            ;IF SO, CONTROLLER IS IDLE NOW
4134         MOVE C,QSDCH1           ;CHANNEL
4135         HRLZ E,DSCFLT           ;CHECK FOR ERRORS
4136         HRR E,DSCSTS
4137         JUMPE E,QINTI           ;OPERATION COMPLETED UNEVENTFULLY
4138         MOVE D,DSCHED           ;GET DISK ADDRESS AS CYL,,HEAD_9+SECTOR
4139         LSH D,9
4140         IOR D,DSCSEC
4141         HRL D,DSCCYL
4142         SKIPN QERRS(C)          ;PRINT ONLY ONCE, NOT ON RETRIES
4143          BUG INFO,[DSK: T-300 ERR UNIT ],DEC,Q,[FAULT=],OCT,DSCFLT,[STATUS=],OCT,DSCSTS,[CMD=],OCT,DSCCMD,[CYL-SURF-SEC=],OCT,D
4144         TRZE E,%DSRTR+%DSECC    ;THESE ARE NOT ERRORS
4145          AOS QECCS(Q)
4146         JUMPE E,QINTI           ;OPERATION COMPLETED SUCCESSFULLY (WITH INTERVENTION OF 2561)
4147         MOVE T,E
4148         TRZ T,%DSECH+%DSIDE+%DSHCE
4149         JUMPN T,T3INT2          ;CONSIDER USING ERROR RECOVERY FEATURES
4150         TRNE A,%DMRED           ;IF COMMAND IS A READ
4151          TRNE A,10              ;AND WE HAVEN'T TRIED THEM ALL
4152           JRST T3INT2
4153         AOS NQSE(Q)             ;COUNT "SOFT ERRORS" (NOT "SPURIOUS" IN T-300 CASE)
4154         AOJA A,T3IO1            ;GO RETRY OPERATION USING NEXT FEATURE
4155
4156 T3INT2: TLNN E,-1               ;ANY FAULT?  PROBABLY UNRECOVERABLE BUT TRY RECALIBRATE
4157          TRNE E,%DSIDE+%DSHCE+%DSSKE+%DSOFL+%DSFLT      ;DISK CONDITION THAT CALLS FOR RECAL
4158           JRST T3HE
4159         JRST T3DE               ;TRY OPERATION AGAIN.  PROBABLY WILL LOSE BUT TRY.
4160 ];T300P
4161 \f
4162 OVHMTR QSC      ;DISK SCHEDULER (AND HIGHER-LEVEL INTERRUPT STUFF)
4163
4164 QINTA1: SKIPL C,QSDCH           ;XFER COMPLETE
4165 QINTI:  SKIPGE A,QSCABN(C)      ;CHANNEL IN C
4166          BUG                    ;MEMBLT INDEX IN A
4167         MOVE R,A                ;BUFFER ADDRESS IN R
4168 IFN KL10P,[                     ;QSRAC IN D, QSK# IN Q
4169         SKIPL QSCRW(C)          ;IF READ, FLUSH CACHE AGAIN
4170          JRST [ PUSHJ P,CSHSWP  ;SINCE USER MIGHT HAVE TOUCHED ABS PAGE
4171                     CAIA
4172                 MOVE A,R        ;A WAS CLOBBERED
4173                 JRST .+1 ]
4174 ]
4175 IFN KS10P,[
4176         SKIPL QSCRW(C)          ;ON KS, CAN ONLY CLEAR THE WHOLE CACHE
4177          CLRCSH
4178 ]
4179         LSH R,10.
4180         MOVE D,QSRAC(C)
4181 IFN RP10P,[
4182         HRRZ TT,QICWA+1
4183         CAIE TT,1777(R)
4184          TLNE D,%QAPAR          ;IGNORE IF LOSING ANYWAY (E.G. SEARCH ERR)
4185           CAIA
4186            JRST QDFLOS
4187 ];RP10P
4188 IFN QRDCMP,[
4189         SKIPE TT,RDCPHS         ;NEED TO READ-COMPARE?
4190          JRST QRC1              ;READ-COMPARE STARTING OR FINISHED
4191 QRC0:
4192 ];QRDCMP
4193         TRNE D,-%QMMAX
4194          BUG
4195         XCT .+1(D)              ;INVOKE COMPLETION HANDLER
4196         OFFSET -.
4197 %QMIDL::JRST 4,QINT1            ;IDLE - SHOULDN'T BE ACTIVE
4198 %QMRD:: JRST QRDFIN             ;READ
4199 %QMWRT::JRST QWRFIN             ;WRITE
4200 %QMWOV::JRST QWOVFN             ;WRITE-OVER MODE
4201 %QMRD1::JRST QRD1FN             ;READ BLOCK AT A TIME MODE
4202         JRST 4,QINT1            ;ILL CODE
4203 %QMUDR::JRST QUDRIN             ;USER DIR IN
4204 %QMMDR::JRST QMDRIN             ;MASTER DIR IN
4205 %QMTTR::JRST QTUTIN             ;TUT IN
4206 %QMUDW::JRST QUFDWF             ;USER DIR WRITE
4207 %QMMDW::JRST QMFDWF             ;MASTER DIR WRITE
4208 %QMTTW::JRST QTUTWF             ;TUT WRITE
4209 %QMSWP::JRST QSWPFN             ;SWAP FINISHED
4210         JRST 4,QINT1            ;ILL CODE
4211         JRST 4,QINT1            ;ILL CODE
4212         JRST 4,QINT1            ;ILL CODE
4213 %QMMAX::OFFSET 0
4214 IFN %QMMAX-20, .ERR %QMMAX MUST BE A POWER OF 2
4215
4216 IFN RP10P,[
4217 ;CHANNEL DIDN'T TRANSFER EXACTLY 2000 WORDS
4218 QDFLOS: MOVEI D,1777(R)         ;EXPECTED TERMINATION ADDRESS
4219         HRRZ B,QICWA+1          ;ACTUAL TERMINATION ADDRESS
4220         CAIL B,(D)
4221          SKIPL QSCRW(C)
4222           JRST QDFLZ1
4223         BUG HALT,[DSK: CHANNEL TRANSFERRED UP TO ],OCT,B,[RATHER THAN],OCT,D,[DISK IS CLOBBERED NOW.]
4224
4225 QDFLZ1: BUG PAUSE,[DSK: CHANNEL TRANSFERRED UP TO ],OCT,B,[RATHER THAN],OCT,D
4226         JRST QOVR
4227 ];RP10P
4228 \f
4229 ;;; SOFTWARE READ-COMPARE ROUTINES
4230
4231 IFN QRDCMP,[
4232 IFE RP10P+RH10P, .ERR READ-COMPARE ONLY CODED FOR RP-10 AND RH10
4233 ;IFE KA10P, .ERR READ-COMPARE ONLY CODED FOR KA-10
4234
4235 ;;; REGULAR OPERATION COMPLETE, DO A READ-COMPARE TO BE SURE
4236 QRC1:
4237 IFN T300P, CAIGE Q,T300P        ;NO READ/COMPARE IF THIS IS T-300 CONTROLLER
4238         TLNE D,%QAPAR           ;GIVING UP WITH FATAL ERR?
4239          JRST QRC0              ;NO READ-COMPARE THEN
4240         JUMPG TT,QRC2           ;JUMP IF READ-COMPARE COMPLETED
4241         MOVE E,QSGL(C)          ;DISK BLOCK
4242         PUSHJ P,QPOSR           ;E GETS DATAO WORD
4243 IFN RP10P,[
4244         IOR E,[DREADC+7000+RCICWA]      ;MAKE READ COMMAND
4245         CONO DPC,175700+DSKCHN
4246         MOVE T,[-2000,,QRCBUF-1]        ;STORE CHANNEL PROGRAM
4247         MOVEM T,RCIOWD
4248         SETZM RCIOWD+1
4249         MOVEI T,RCIOWD
4250         MOVEM T,RCICWA
4251         SETZM RCICWA+1
4252         DATAO DPC,E             ;START DISK
4253 ];RP10P
4254 IFN RH10P,[
4255         MOVE T,[-2000_4,,QRCBUF-1]      ;DF10-C CHANNEL PROGRAM
4256         MOVEM T,RCIOWD
4257         SETZM RCIOWD+1
4258         MOVEI T,RCIOWD
4259         MOVEM T,RCICWA
4260         SETZM RCICWA+1
4261         SWPUA                   ;DUMP CACHE
4262         CONSZ 200000            ;IT'S INEFFICIENT, BUT WHAT THE HELL
4263          JRST .-1
4264         CONO DSK,%HOCLR+%HORAE+%HOATN+DSKCHN
4265         MOVSI A,%HRADR(Q)
4266         HRR A,E                 ;HEAD AND SECTOR (CYL DOESN'T CHANGE)
4267         PUSHJ P,RHSET
4268         MOVEI A,%HMRED+<RCICWA_6>
4269         TLO A,%HRCTL(Q)
4270         PUSHJ P,RHSET           ;START DISK
4271 ];RH10P
4272         MOVEM T,RDCPHS          ;RDCPHS POSITIVE MEANS DOING RD/CMP NOW
4273         JRST DSKEX              ;AWAIT COMPLETION
4274
4275 ;;; READ-COMPARE COMPLETED.  CHECK IT.
4276 QRC2:   SPM PARPG               ;SET UP MAP TO PAGE BEING READ/WRITTEN
4277         MOVEI T,600000+PMCSHM(A)
4278         DPB T,[.PAREP+EXEUMP]
4279         LPMR PARPG
4280         MOVEI H,0               ;H DIFFERENCE COUNT
4281 IFN KA10P,[
4282         PUSH P,A                ;WILL DO COMPARE LOOP IN ACS
4283         PUSH P,C
4284         PUSH P,D
4285         MOVSI E,-2000           ;E ADDRESS WITHIN PAGE
4286         MOVSI D,[ MOVE T,400000+PAREP*2000(E)   ;A
4287                   CAMN T,QRCBUF(E)              ;B
4288                    AOBJN E,A                    ;C
4289                   JRST QRC3 ]                   ;D
4290         HRRI D,A
4291         BLT D,D
4292         JRST A
4293 ];KA10P
4294 .ELSE [
4295         MOVSI E,-2000           ;E ADDRESS WITHIN PAGE
4296         MOVE T,400000+PAREP*2000(E)
4297         CAMN T,QRCBUF(E)
4298 QRC2A:   AOBJN E,.-2
4299 ];NOT KA10P
4300 QRC3:   JUMPGE E,QRC5           ;JUMP IF DONE
4301         JUMPG H,QRC4            ;COMPARE ERROR, REPORT IT
4302         AOS NQCMPE(Q)
4303 IFN KA10P,[
4304         MOVE T,-1(P)            ;SAVED C
4305         BUG INFO,[DSK: READ-COMPARE ERROR #],DEC,NQCMPE(Q),[UNIT=],DEC,Q,[BLK=],OCT,QSGL(T)
4306 ];KA10P
4307 .ELSE   BUG INFO,[DSK: READ-COMPARE ERROR #],DEC,NQCMPE(Q),[UNIT=],DEC,Q,[BLK=],OCT,QSGL(C)
4308 QRC4:   ADDI H,1
4309         HRRZ T,E
4310         CAIG H,4                ;ONLY REPORT FIRST 4 BAD WORDS
4311          BUG INFO,[DSK: READ-COMPARE DIFFERENCE ],OCT,T,OCT,400000+PAREP*2000(E),OCT,QRCBUF(E)
4312 IFN KA10P,JRST C
4313 .ELSE   JRST QRC2A
4314
4315 QRC5:
4316 IFN KA10P,[
4317         POP P,D
4318         POP P,C
4319         POP P,A
4320 ];KA10P
4321         MOVEI T,0               ;CLEAR MAP
4322         DPB T,[.PAREP+EXEUMP]
4323         LPMR PARPG
4324         JUMPE H,QRC0            ;NO DIFFERENCE, I/O OPERATION IS DONE
4325         CAILE H,4               ;FAILED, DO IT ALL OVER AGAIN
4326          BUG INFO,[DSK: READ-COMPARE DIFFERENCES TOTAL],DEC,H
4327         JRST QOVR
4328 ];QRDCMP
4329 \f
4330 QUFDWF: MOVE TT,QDWIP
4331         CAMN Q,MDSK             ;WRITTEN TO MASTER DISK?
4332          SKIPN E,QSFBT(TT)      ;AND HAVE SOME BLOCKS TO FREE?
4333           JRST QUDWF1
4334         SETZM QSFBT(TT)         ;YES, TRANSFER THEM TO QFBTS LIST
4335         MOVE T,E                ;E FINDS LAST OF LIST, T RPLACD'D IN THERE
4336         EXCH T,QFBTS            ;NCONC QSFBT ONTO FRONT OF QFBTS
4337         SKIPE 1(E)
4338          JRST [ MOVE E,1(E)
4339                 JRST .-1 ]
4340         MOVEM T,1(E)
4341         SKIPN T
4342          AOS NCORRQ             ;WAKE UP CORE JOB IF QFBTS HAD BEEN EMPTY
4343 QUDWF1: JSP D,QDWF
4344             QSNLCN(TT)
4345
4346 QMFDWF: JSP D,QDWF
4347             QMDRO
4348
4349 QTUTWF: AOS T,QSGL(C)           ;NEXT BLOCK TO GO OUT
4350         AOS QSCABN(C)           ;FROM NEXT CORE PAGE
4351         CAIGE T,MFDBLK          ;SKIP IF DONE
4352          JRST QINT1E            ;WRITE MORE
4353         JSP D,QDWF
4354             QTUTO(TT)
4355
4356 QDWF:   MOVSI E,(SETZ)          ;UNLOCK DIR THAT WAS WRITTEN
4357         IOR E,DCHBT(Q)          ;COPY ON THIS DISK IS NOW UP TO DATE
4358         MOVE TT,QDWIP
4359         ANDCAM E,@(D)
4360         HLLZS QSRAC(C) .SEE %QMIDL      ;IDLE THE CHANNEL
4361         SETOM DWUSR
4362         JRST QINT1A             ;DON'T COUNT THIS AS DISK ACTIVITY
4363
4364 QUDRIN: MOVE TT,QUDPR(C)        ;USER DIR IN OK
4365         MOVE D,UDNAME(R)
4366         CAME D,QSNUD(TT)        ;COMPARE UNAME IN DIR WITH RQ'ED
4367          JRST QUDER1
4368         TLO R,40000             ;NOT PAWED OVER
4369         MOVEM R,QSNLCN(TT)
4370         MOVE R,QSLGL(C)
4371         MOVEM R,QSNMI(TT)
4372         MOVEI R,MU23UD          ;USER DIRECTORY
4373         PUSH P,A
4374         PUSH P,C
4375         MOVE C,TT
4376         PUSHJ P,QDIRCK          ;VERIFY NOT TOTALLY BASHED TO BEGIN WITH
4377         POP P,C                 ;CLOBBERS A,B,I
4378         POP P,A
4379 QINTU4: DPB R,[MUR,,MEMBLT(A)]
4380         DPB TT,[MNUMB,,MEMBLT(A)]
4381 QTUTI1: SETOM QUSR(C)           ;FREE THE DISK CHANNEL
4382         AOS QFCHN
4383         JRST QINT1A
4384
4385 QMDRIN: TLO R,2                 ;NOT RECONCILED
4386         MOVEM R,QMDRO           ;MASTER DIRECTORY IN
4387         MOVE TT,MDCHK(R)
4388         CAME TT,[SIXBIT /M.F.D./]
4389          BUG HALT,[MFD CLOBBERED]
4390         MOVE TT,MDNUDS(R)
4391         CAIE TT,NUDSL
4392          BUG HALT,[MFD HAS WRONG NUMBER OF DIRECTORIES]
4393         MOVE TT,(R)             ;ASCENDING DIR #
4394         SKIPGE QAMDNO
4395          MOVEM TT,QAMDNO        ;FIRST DISK IN STORE ASCENDING #
4396         MOVEI R,MU23MD          ;MASTER DIRECTORY
4397         MOVE TT,Q               ;DISK NO
4398         JRST QINTU4
4399
4400 QTUTIN: AOS T,QSGL(C)           ;NEXT BLOCK TO COME IN
4401         AOS QSCABN(C)           ;INTO NEXT CORE PAGE
4402         CAIGE T,MFDBLK          ;SKIP IF DONE
4403          JRST QINT1E            ;READ MORE
4404         HRRZS QTUTO(Q)          ;UNLOCK TUT, BUT QDPWF IS STILL SET
4405         JRST QTUTI1
4406 \f
4407 QSWPFN: MOVE Q,QDSKN(C)
4408         TLNE D,%QAPAR
4409          JRST QSWPF2            ;SWAP READ ERROR (I HOPE)
4410         MOVSI E,MMPTMP          ;PAGE NO LONGER IN TRANSIT
4411         TDNN E,@QSMMP(Q)
4412          BUG                    ;ALREADY WASN'T?
4413         ANDCAM E,@QSMMP(Q)
4414         SKIPL QSCRW(C)
4415          JRST QSWPIF
4416         PUSHJ P,IMEMR           ;SWAP-OUT COMPLETE, RETURN MEMORY
4417         MOVSI E,MMPPGB
4418         ANDCAM E,@QSMMP(Q)
4419         MOVSI E,MMPWOD          ;PAGE HAS BEEN WRITTEN ON DISK.  AND NO LONGER
4420         IORB E,@QSMMP(Q)        ;BEING PAGED BEHIND.
4421         TLNN E,MMPGON
4422          JRST QSWPF2
4423         MOVE A,QSMMP(Q)         ;WE'RE SUPPOSED TO RETURN THE MMP ENTRY
4424         PUSHJ P,RETMMP
4425 QSWPF2: SETOM SWUSR(Q)          ;SWAPPING IDLE
4426         JRST QINT1B
4427
4428 QSWPIF:
4429 ;SOME ERROR CHECKING
4430         MOVE E,QSMMP(Q)
4431         HLLZ TT,1(E)
4432         JUMPE TT,QSWPF3         ;ON INITIAL-SWAP-IN, ADDRESS IN MMP IS SUPPOSED TO BE ZERO
4433         LDB TT,[$MMPUN,,(E)]
4434         CAME TT,Q
4435          BUG
4436         HLRZ TT,1(E)
4437         CAME TT,QSGL(C)
4438          BUG
4439 QSWPF3: LDB TT,[MMMPX,,MEMBLT(A)]
4440         CAIE TT,-MMP(E)
4441          BUG
4442 ;END ERROR CHECKING
4443         MOVEI TT,MURUSR         ;SWAP IN OF PAGE COMPLETED
4444         DPB TT,[MUR,,MEMBLT(A)]
4445         SETZM MMSWP(A)
4446         MOVE D,(E)
4447         SKIPL CIRPSW
4448          JRST QSWPF2            ;CAN'T PUT IN MAPS IF CIRPSW NOT AVAILABLE.
4449         MOVSI D,(TDNE T,)       ;SET UP CHECK USED BY PRIVELEGED USER FEATURE
4450         HRR D,QSMMP(Q)
4451         PUSH P,C
4452         PUSH P,Q
4453         MOVE C,[2200,,MEMPNT(A)]
4454         PUSHJ P,PPIUM           ;PUT PAGE INTO USERS' MAPS
4455         POP P,Q
4456         POP P,C
4457         JRST QSWPF2
4458 \f
4459 QWOVFN: CLEARM QSCRW(C)         ;WRITE OVER SWITCH TO READ MODE
4460         HRRI D,%QMRD1
4461         TLZE D,%QAEFW
4462          HRRI D,%QMIDL          ;TRYING TO CLOSE, STOP CHANNEL
4463         MOVEM D,QSRAC(C)
4464         AOS QWBUFS              ;COMPENSATE FOR EXTRA SOS BELOW
4465
4466 QWRFIN: TLNN D,%QACTH           ;WRITE COMPLETE, RETURN BUFFER
4467          PUSHJ P,IMEMR
4468         TLNE D,%QACTH
4469          PUSHJ P,CIMEMR
4470         SOS QSBFS(C)
4471         SOS QWBUFS
4472         MOVE TT,QSGL(C)
4473         MOVEM TT,QSLBLK(C)
4474         JRST QINT1B
4475
4476 QRD1FN: HLLZS QSRAC(C) .SEE %QMIDL      ;BLOCK-AT-A-TIME READ COMPLETE, IDLE THE CHANNEL
4477
4478 QRDFIN: MOVEI B,.BM MLO         ;NORMAL READ COMPLETED
4479         ANDCAM B,MEMBLT(A)      ;THREAD ONTO CHANNEL LIST
4480         HLRZ B,QBFP(C)
4481         SKIPE B
4482          DPB A,[MLO,,MEMBLT(B)]
4483         SKIPN B
4484          MOVEM A,QBFP(C)
4485         HRLM A,QBFP(C)
4486         SKIPL B,QPIBSZ(C)       ;GET BYTE COUNT OF BLOCK
4487          JRST QRDFN1
4488         HRRZ B,1777(R)          ;FUNNY BLOCK, GET FROM LAST WORD
4489                                 ; 8/20/90 No more funny blocks
4490         HRRZ TT,QSBYTE(C)       ;AND MAKE SURE IT'S NOT TOO BIG
4491         IMULI TT,2000
4492         CAMLE B,TT
4493          MOVE B,TT
4494 QRDFN1: HRRZM B,MEMPNT(A)       ;PASS TO MAIN PROGRAM
4495         AOS QSBFS(C)
4496 IFE DMDSK,      LDB B,[XWBLK QXWDS]
4497      .ALSO      MOVEM B,QSLBLK(C)
4498
4499 ;XFER COMPLETE, DEACTIVATE CHANNEL
4500
4501 QINT1B: SETOM QACTTM
4502 QINT1A: SETOM QSGL(C)
4503         SETOM QSCABN(C)
4504 QINT1E:
4505 IFE DC10P, SETOM QSKT1(Q)
4506 IFN DC10P,[
4507         MOVE TT,QTRAN(Q)
4508         SETOM QSKT1(TT)
4509 ] ;DC10P
4510 IFN T300P,[
4511         CAIL Q,T300P
4512          SETOM QSDU1
4513         CAIGE Q,T300P
4514          SETOM QSDU
4515 ];T300P
4516 .ELSE   SETOM QSDU
4517 ;DROPS THROUGH
4518 \f;DROPS IN
4519
4520 ;ACTIVATE CHANNELS, LOOK FOR SEEKS AND TRANSFERS TO BE DONE
4521
4522 QINT1:  SETZM QHUNGF
4523         SETOM QTUNT             ;NO UNIT SELECTED YET
4524 IFN T300P, SETOM QTUNT1
4525         MOVE C,QTCHN            ;START SCAN IN SUITABLE PLACE
4526         MOVEM C,QLCHN
4527         JRST QINT2D
4528
4529 QINT2L: CAIGE C,NQCHN           ;IF DIR-WRITE OR SWAP CHANNEL, DON'T CHECK QUSR
4530          SKIPL QUSR(C)
4531           SKIPGE D,QSRAC(C)     .SEE %QALOK
4532            JRST QINT2C          ;CHANNEL LOCKED OR NOT OPEN, SKIP IT
4533         MOVE Q,QDSKN(C)
4534         SKIPL E,QSGL(C)
4535          JRST QINT4             ;JUMP IF CHANNEL ACTIVE ALREADY
4536         TLNE D,%QACTH+%QAOUT
4537          JRST QINT2C            ;CHANNEL BLOCKED BY CORE JOB, DON'T ACTIVATE
4538         TRNE D,-%QMMAX
4539          BUG
4540         XCT .+1(D)              ;INVOKE ACTIVATE HANDLER
4541         OFFSET -.
4542 %QMIDL::JRST QINT2C             ;IDLE - DON'T ACTIVATE
4543 %QMRD:: JRST QRDACT             ;READ
4544 %QMWRT::JRST QWRACT             ;WRITE
4545 %QMWOV::JRST QWRACT             ;WRITE OVER
4546 %QMRD1::JRST QRDACT             ;READ 1 BLOCK
4547         JRST 4,QINT2C           ;ILL CODE
4548 %QMUDR::JRST QDRACT             ;UFD READ
4549 %QMMDR::JRST QDRACT             ;MFD READ
4550 %QMTTR::JRST QDRACT             ;TUT READ
4551 %QMUDW::JRST 4,QINT2C           ;UFD WRITE - SHOULDN'T LEAVE THIS MODE AROUND
4552 %QMMDW::JRST 4,QINT2C           ;MFD WRITE - ..
4553 %QMTTW::JRST QINT5              ;TUT WRITE - MAY BE WRITING SECOND PAGE
4554 %QMSWP::JRST SWPACT             ;SWAP
4555         JRST 4,QINT2C           ;ILL CODE
4556         JRST 4,QINT2C           ;ILL CODE
4557         JRST 4,QINT2C           ;ILL CODE
4558 %QMMAX::OFFSET 0
4559
4560 ; ACTIVATION ROUTINES
4561
4562 SWPACT: SKIPL SWUSR(Q)
4563          BUG                    ;SWAPPING ALREADY ACTIVE ON THIS DISK
4564         MOVE A,MEMFR
4565         SUB A,NCBCOM
4566         MOVEI B,0               ;CHECK FIRST FOR SWAP IN OR OUT
4567         CAIGE A,6               ;ACCORDING TO AVAIL MEM
4568          MOVEI B,1
4569         SKIPN @SWAPL(B)         ;IF NO TRAFFIC THAT DIRECTION, CHECK THE OTHER.
4570          TRC B,1
4571         HRRZ E,@SWAPL(B)
4572         JUMPE E,QINT2C          ;NO SWAPPING TRAFFIC THIS DISK.
4573         LDB A,[MLO,,MEMBLT(E)]  ;TAKE BLOCK OFF LIST
4574         SKIPN A
4575          SETZM @SWAPL(B)        ;LAST BLOCK, LIST IS NOW EMPTY
4576         HRRM A,@SWAPL(B)        ;SET NEW FIRST BLOCK
4577         LDB D,[MMMPX,,MEMBLT(E)]
4578         ADD D,MMPEAD            ;GET MMP ADDRESS
4579         LDB TT,[410200,,(D)]
4580         TRNN TT,1
4581          BUG                    ;THIS PAGE SHOULD BE MARKED IN TRANSIT
4582         HRRZM D,QSMMP(Q)
4583         SOS SILNG(B)
4584         CAIGE E,TSYSM
4585         CAIGE E,SYSB
4586          BUG
4587         HRRZM E,QSCABN+NQCHN+1(Q)
4588         CLEARM SWUSR(Q)         ;CHNL ACTIVE
4589         HLRZ E,MEMPNT(E)
4590         MOVEM E,QSGL+NQCHN+1(Q) ;DISK BLOCK
4591         HRRZS QSRAC+NQCHN+1(Q)  .SEE %QMSWP
4592         MOVNM B,QSCRW+NQCHN+1(Q) ;DIRECTION
4593         CLEARM QERRS+NQCHN+1(Q) ;NO ERRORS (YET)
4594         JRST QINT4              ;CHANNEL SUCCESSFULLY ACTIVATED
4595 \f
4596
4597 ; MORE ACTIVATION ROUTINES
4598
4599 QRDACT: TLNE D,%QAACC           ;ACTIVATE READ CHANNEL
4600          JRST QINT2C            ;NOT IF USER HACKING RANDOM ACCESS NOW
4601         SETZM QERRS(C)
4602         MOVE J,QUDPR(C)
4603         SKIPGE QSNLCN(J)
4604          JRST QINT2C            ;USER DIRECTORY OUT OR LOCKED
4605         MOVE A,QSBFS(C)
4606         SKIPL QSMDN(C)
4607          AOS A                  ;A := TOTAL NUMBER OF BUFFERS
4608         CAMLE A,QRDAHD          ;HOW MUCH SHOULD BE READ AHEAD
4609          JRST QINT2C            ;BLOATED, DON'T ACTIVATE
4610         SKIPE QSBI(C)
4611          JRST QINT4A            ;BLOCKS LEFT FROM LAST TIME
4612 QINT4B: PUSHJ P,QIDRCH          ;GET NEXT DESC BYTE IN A, ALSO RET BYTE PNTR IN TT
4613         CAIN A,UDWPH
4614          JRST QINT4B
4615         JUMPE A,QEOF            ;REACHED READ EOF
4616         TRZE A,40
4617          JRST QINT4C
4618         CAILE A,UDTKMX
4619          JRST QINT4D            ;SKIP AND TAKE
4620         MOVEM A,QSBI(C)         ;TAKE NEXT N
4621 QINT4A: SOS QSBI(C)
4622         AOS E,QSLGL(C)
4623 QINT4G: MOVEM E,QSGL(C)
4624         MOVSI B,%QALBK
4625         ANDCAM B,QSRAC(C)       ;CLEAR PROCESSING LAST BLOCK IN FILE BIT
4626         HRRZ A,QSBYTE(C)
4627         IMULI A,2000            ;NUMBER OF BYTES IN A FULL BLOCK
4628 IFN DMDSK,[
4629         MOVSI D,%QAFNY          ;FUNNY FILE
4630         TDNE D,QSRAC(C)
4631          SETO A,
4632 ]
4633         MOVEM A,QPIBSZ(C)       ;SET FUNNY BIT
4634         SKIPE QSBI(C)
4635          JRST QINT4             ;IF MORE BLOCKS FOLLOW DON'T CHECK EOF
4636         PUSHJ P,QIDRCH          ;GET NEXT DESCR BYTE
4637         SOS QDIRP(C)            ;CORRECT PNTR
4638         JUMPN A,QINT4
4639         MOVE A,QUDFPR(C)        ;THIS IS LAST BLOCK
4640         ADD A,QSNLCN(J)
4641         LDB D,[UNBYTE+UNREF(A)]
4642         PUSHJ P,QBDCD
4643         IMUL D,E                ;NUMBER OF UNUSED BITS IN LAST WORD
4644         LDB E,[QSBSIZ(C)]       ;(DEPEND ON DIVIDE ROUNDING DOWN)
4645         IDIV D,E                ;NUMBER OF UNUSED BYTES (IN SIZE OPEN)
4646         LDB E,[UNWRDC+UNRNDM(A)];NUMBER OF USED WORDS IN LAST BLOCK
4647         SKIPN E
4648          MOVEI E,2000
4649         IMULI E,@QSBYTE(C)      ;CONVERT TO NUMBER OF BYTES
4650         SUB E,D                 ;NUMBER OF VALID BYTES IN BLOCK
4651         HRRM E,QPIBSZ(C)        ;STORE BYTE COUNT OF LAST BLOCK
4652         IORM B,QSRAC(C) .SEE %QALBK
4653         MOVE E,QSGL(C)
4654         JRST QINT4
4655
4656 QINT4D: MOVEI E,1-UDTKMX(A)     ;SKIP N AND TAKE 1
4657         ADDB E,QSLGL(C)
4658         JRST QINT4G
4659
4660 QWRACT: SKIPN I,QBFP(C)         ;ACTIVATE WRITE CHANNEL
4661          JRST QINT2C            ;END OF WRITE LIST FOR NOW
4662         HRRZM I,QSCABN(C)
4663         LDB H,[MLO,,MEMBLT(I)]
4664         HRRM H,QBFP(C)
4665         SKIPN H
4666          SETZM QBFP(C)          ;LAST BLOCK, LIST NOW EMPTY
4667         HLRZ E,MEMPNT(I)
4668         MOVEM E,QSGL(C)
4669         JRST QINT4
4670
4671 QDRACT: MOVE E,QSLGL(C)         ;ACTIVATE DIRECTORY-READ CHANNEL
4672         MOVEM E,QSGL(C)
4673 ;       JRST QINT4              ;DROPS THROUGH
4674 \f;DROPS IN
4675 QINT4:  SKIPL QSCABN(C)         ;SKIP IF NEED MEMORY
4676          JRST QINT5
4677         PUSHJ P,IOMQ            ;GET MEMORY FOR READ BUFFER
4678          JRST QINT2C            ;CAN'T
4679 QINT5A: MOVEM A,QSCABN(C)
4680         MOVEI D,MU23B
4681         DPB D,[MUR,,MEMBLT(A)]
4682         DPB C,[MNUMB,,MEMBLT(A)]
4683
4684 QINT5:
4685 IFN DC10P, MOVE TT,QTRAN(Q)
4686 .ELSE      MOVE TT,Q
4687         SKIPN QSEEK(TT)         ;IGNORE SEEKING DRIVE
4688          SKIPGE QRCAL(TT)       ;IGNORE RECALIBRATING DRIVE
4689           JRST QINT2C
4690 IFN T300P,[                     ;IGNORE IF FOR CONTROLLER THAT IS NOT READY
4691         CAIL TT,T300P
4692          JRST [ SKIPGE QSDU1
4693                  SKIPL QTUNT1   ;NOTE CODE HERE IS SIMILAR TO THAT AT QINT2F
4694                   JRST QINT2C   ;T-300 CONTROLLER BUSY OR ALREADY COMMITTED
4695                 HRRZM Q,QTUNT1  ;WILL TRANSFER ON THIS UNIT
4696                 HRRZM C,QTCHN1  ;FOR THIS CHANNEL
4697                 JRST QINT2C ]   ;T-300 CODE IS SIMPLIFIED SINCE NO SEEK OVERLAPS
4698         SKIPL QSDU
4699          JRST QINT2C
4700 ];T300P
4701         HRRZ B,QSKT1(TT)
4702         CAIN B,(C)
4703          JRST QINT2F            ;ALREADY SET FOR ME
4704         SKIPL QSKT1(TT)
4705          JRST QINT2C            ;SET FOR SOME OTHER CHNL
4706         HRRZM C,QSKT1(TT)       ;AVAILABLE, SET IT FOR ME
4707         PUSHJ P,QPOSR           ;CONVERT DISK ADDRESS TO PHYSICAL
4708 IFN DC10P,[                     ;AND INITIATE SEEK
4709         ADD E,[DSEEK]
4710         CONSZ DC0,DSSRUN+DSSACT
4711          JRST .-1
4712         DATAO DC0,E
4713         LDB B,[DCYL E]
4714         MOVE TT,QTRAN(Q)        ;PRETEND SEEK ALREADY COMPLETE
4715         MOVEM B,QPOSGL(TT)
4716         MOVEM B,QPOS(TT)
4717         JRST QINT2F             ;DON'T WAIT FOR SEEK, START TRANSFER RIGHT AWAY
4718 ] ;DC10P
4719 IFN RP10P,[
4720         TLO E,(DSEEKC)          ;DSK SEEK
4721         CONSZ DPC,20
4722          JRST 4,.-1
4723         LDB TT,[DCYL E]
4724         TRNE E,.BM DCYLXB
4725          ADDI TT,400
4726         CAMN TT,QPOS(Q)
4727          JRST QINT2F            ;IF WE'RE THERE, DON'T SEEK
4728         MOVEM TT,QPOSGL(Q)
4729         DATAO DPC,E
4730         MOVEM E,QSEEK(Q)
4731         JRST QINT2C             ;THIS ONE SEEKING, GO GET ANOTHER
4732 ] ;RP10P
4733 IFN RH11P,[
4734         PUSHJ P,RHSLCT          ; Select drive
4735         HRRZ A,E
4736         IOWRQ A,%HRADR          ; Set track and sector
4737         HLRZ A,E
4738         IOWRQ A,%HRCYL          ; Set cylinder
4739         CAMN A,QPOS(Q)
4740          JRST QINT2F            ; On cylinder, don't seek
4741         MOVEM A,QPOSGL(Q)
4742         MOVEI A,%HMSEK
4743         PUSHJ P,RHCMD           ; Start seeking
4744         SETOM QSEEK(Q)
4745         JRST QINT2C             ; Start other drives now?
4746 ] ;RH11P
4747 IFN RH10P,[
4748         MOVSI A,%HRCYL(Q)       ;STORE ADDRESS IN DRIVE
4749         HLR A,E
4750         PUSHJ P,RHSET
4751         MOVSI A,%HRADR(Q)
4752         HRR A,E
4753         PUSHJ P,RHSET
4754         HLRZ TT,E               ;GET CYLINDER PART OF ADDRESS
4755         CAMN TT,QPOS(Q)
4756          JRST QINT2F            ;ON CYLINDER, DON'T SEEK
4757         MOVEM TT,QPOSGL(Q)
4758         MOVSI A,%HRDCL(Q)       ;START SEEK
4759         HRRI A,%HMSEK
4760         PUSHJ P,RHSET
4761         SETOM QSEEK(Q)
4762         JRST QINT2C             ;THIS ONE SEEKING, START OTHER DRIVES
4763 ] ;RH10P
4764 \f
4765 IFN KL10P,[
4766 ;CALL HERE TO SWEEP THE CACHE.  CORE PAGE # IN R.
4767 ;INSTRUCTION AT CALL+1 SHOULD SKIP IF READING INTO CORE.
4768 ;CLOBBERS A,B,D,E,TT.
4769
4770 CSHSWP: SETZB A,B               ;A COUNTS WAIT TIME, B IS SWEEP INSTRUCTION
4771         XCT @(P)
4772          TLOA B,(SWPUO (R))     ;WRITE - UNLOAD PAGE FROM CACHE
4773           MOVSI B,(SWPIO (R))   ;READ - CLEAR PAGE FROM CACHE
4774         LSH R,1                 ;HARDWARE PAGES ARE 1/2 K
4775         XCT B                   ;SWEEP FIRST HALF-PAGE
4776         MOVE D,[CONSZ 200000]
4777         MOVE E,[AOJA A,D]
4778         MOVSI TT,(POPJ P,)
4779         PUSHJ P,D               ;WAIT IN ACS TO MINIMIZE MBOX INTERFERENCE
4780         AOS R                   ;SWEEP SECOND HALF-PAGE
4781         XCT B
4782         PUSHJ P,D
4783         XCT @(P)
4784          AOSA NCSHU             ;COUNT NUMBER OF TIMES THIS DONE
4785           AOSA NCSHI
4786            JRST [ ADDM A,NCSHUL ? JRST .+2 ]
4787           ADDM A,NCSHIL         ;AND COUNT NUMBER OF LOOPS IN ACS
4788         LSH R,-1
4789         JRST POPJ1
4790 ]
4791
4792 ;VARIOUS EXITS FROM CHANNEL-CHECKING ROUTINES
4793
4794 QINT2F: SKIPL QTUNT             ;THIS CHANNEL IS READY TO TRANSFER
4795          JRST QINT2C            ;ALREADY FOUND A TRANSFER
4796         HRRZM Q,QTUNT           ;WILL TRANSFER ON THIS UNIT
4797         HRRZM C,QTCHN           ;FOR THIS CHANNEL
4798 QINT2C: CAMN C,QLCHN            ;CONTINUE CHANNEL SCAN
4799          JRST QINT2E            ;UNLESS CHECKED ALL CHANNELS
4800 QINT2D: CAIL C,NQCHN+1+NQS-1    ;SKIP IF NOT TIME TO WRAP AROUND
4801          SETO C,
4802         AOJA C,QINT2L           ;CHECK ANOTHER
4803
4804 QINT2E:
4805 IFN T300P,[
4806         MOVE C,QTCHN1
4807         SKIPL Q,QTUNT1          ;FOUND XFER FOR T-300?
4808          JRST QDE1              ;YES
4809 ];T300P
4810         SKIPGE Q,QTUNT          ;FOUND XFER?
4811          JRST QINT3             ;IDLE
4812         MOVE C,QTCHN
4813 ;Q DISK TO TRANSFER ON, C CHANNEL.  START (OR RESTART) TRANSFER ON THEM.
4814 QDE1:   MOVE R,QSCABN(C)
4815 IFN KL10P,[
4816         PUSHJ P,CSHSWP
4817           SKIPGE QSCRW(C)
4818 ];KL10P
4819 IFN KS10P,[
4820         SKIPL QSCRW(C)
4821          CLRCSH
4822 ];KS10P
4823 IFE T300P, MOVEM C,QSDCH
4824 IFN T300P,[
4825         CAIL Q,T300P
4826          JRST T3IO
4827         CAIGE Q,T300P
4828          MOVEM C,QSDCH
4829 ];T300P
4830         SKIPGE B,QSCRW(C)       ;LOAD R/W STATUS IN B
4831          JRST QINT6W
4832 \f;READ - DROPS IN
4833 IFN RP10P,[
4834         MOVSI T,(DREADC)
4835 QINT6A: IORI T,7000+QICWA       ;DON'T STOP FOR PARITY ERRORS (PLUS INITIAL CHNL ADR)
4836         MOVEM T,QCHPRG
4837         DPB Q,[DUNFLD+QCHPRG]
4838         HLLZS QIOWD
4839         DPB R,[121000,,QIOWD]
4840         LDB E,[100300,,R]       ;MA15-17
4841         TRC E,7
4842         DPB E,[410300,,QIOWD]   ;SET UP HIGH ADDR BITS.
4843         MOVE TT,QIOWD
4844         SOS TT
4845         HRRM TT,QIOWD
4846         SETZM QIOWD+1
4847         MOVEM Q,QSDU
4848         MOVE E,QSGL(C)
4849         PUSHJ P,QPOSR
4850         IORM E,QCHPRG
4851 QOVR:   CONSZ DPC,20
4852          JRST QOVR
4853         SKIPGE Q,QSDU
4854          BUG
4855         CONO DPC,175700+DSKCHN
4856 IFN QRDCMP,[
4857         SETZM RDCPHS            ;ASSUME NO READ-COMPARE WANTED
4858         SKIPE QRCSW
4859          SETOM RDCPHS           ;REMEMBER TO READ-COMPARE LATER
4860 ];QRDCMP
4861         MOVEI TT,QIOWD
4862         HRRZM TT,QICWA
4863         MOVE E,QCHPRG
4864         LDB TT,[DCYL E]
4865         TRNE E,.BM DCYLXB
4866          ADDI TT,400
4867         CAME TT,QPOS(Q)
4868          BUG                    ;DONT DO ANYTHING IF NOT WHERE YOU SHOULD BE
4869         SETZM QICWA+1
4870         DATAO DPC,QCHPRG        ;ENTRY ON OVERRUN
4871         MOVE A,TIME
4872         MOVEM A,LQTM
4873         MOVEM Q,QSDU
4874         CAILE C,NQCHN
4875          JRST .+5
4876           SKIPL B
4877            AOSA NRXFR
4878             AOS NWXFR
4879           JRST QINTX
4880         SKIPL B
4881          AOSA NSRXFR
4882           AOS NSWXFR
4883 QINTX:  JRST DSKEX
4884
4885 QHUNG:  CONO DPC,DCLEAR+20+DSKCHN       ;DISK NOTICED TO BE HUNG, RESET IT
4886         SETOM QHUNGF                    ;TELL P.I. LEVEL TO RETRY OPERATION
4887         MOVE Q,QSDU
4888         AOS NTQHNG(Q)
4889         BUG INFO,[DSK: HUNG ON UNIT ],DEC,QSDU,[QCHPRG=],OCT,QCHPRG
4890         POPJ P,
4891 ]
4892 \f;READ - DROPS IN
4893
4894 IFN RH11P,[
4895         MOVEI T,%HMRED
4896 QINT6A: MOVEM T,QCHPRG
4897         MOVEM Q,QSDU
4898         LSH R,1                 ; Set up Unibus map for RH11 to point at
4899         TRO R,%UQVAL+%UQFST     ;  the block in question.
4900         IOWRQ R,UBAPAG+QUBPG_1
4901         ADDI R,1
4902         IOWRQ R,UBAPAG+QUBPG_1+1
4903         MOVE E,[-4000,,QUBPG_14]
4904         MOVEM E,QIOWD
4905         MOVE E,QSGL(C)
4906         PUSHJ P,QPOSR
4907         MOVEM E,QCHPGA
4908 QOVR:   IORDQ TT,%HRCS1         ; Enter here to recover from PI level lossage
4909         TRNN TT,%HXRDY
4910          JRST QOVR
4911         SKIPGE Q,QSDU
4912          BUG
4913 QECCX:  ;; Enter here from ECC correction code
4914         PUSHJ P,RHCLRC          ; Clear controller errors and select drive
4915         HLRZ TT,QCHPGA
4916         CAME TT,QPOS(Q)
4917          JRST DSKEX             ; Punt if not positioned in right place
4918         IOWRQ TT,%HRCYL         ; Store cylinder in drive
4919         HRRZ TT,QCHPGA
4920         IOWRQ TT,%HRADR         ; Store track and sector
4921         HLRZ TT,QIOWD
4922         IOWRQ TT,%HRWC          ; Store halfword count
4923         HRRZ TT,QIOWD
4924         IOWRQ TT,%HRBA          ; Store Unibus base address
4925         MOVE A,QCHPRG
4926         PUSHJ P,RHCMD           ; Go!
4927         MOVE A,TIME
4928         MOVEM A,LQTM
4929         CAILE C,NQCHN
4930          JRST .+5
4931           SKIPL B
4932            AOSA NRXFR
4933             AOS NWXFR
4934           JRST QINTX
4935         SKIPL B
4936          AOSA NSRXFR
4937           AOS NSWXFR
4938 QINTX:  JRST DSKEX
4939
4940 QHUNG:  MOVEI A,%HYCLR          ; Sock controller in jaw
4941         IOWRQ A,%HRCS2
4942         MOVE Q,QSDU
4943         PUSHJ P,RHSLCT          ; Select drive
4944         PUSHJ P,RHCLRD          ; Redundantly clear drive
4945         SETOM QHUNGF
4946         AOS NTQHNG(Q)
4947         BUG INFO,[DSK: HUNG ON UNIT #],DEC,QSDU,[ADDR=],OCT,QCHPGA
4948         POPJ P,
4949
4950 ] ;RH11P
4951 \f;READ - DROPS IN
4952
4953 IFN RH10P,[
4954         MOVEI T,%HMRED
4955 QINT6A: IORI T,QICWA_6  .SEE $HCICWA
4956         TLO T,%HRCTL(Q)
4957         MOVEM T,QCHPRG
4958         MOVEM Q,QSDU
4959         LSH R,10.               ;ASSEMBLE DF10-C CONTROL WORD
4960         SUBI R,1
4961         MOVNI E,2000
4962         DPB E,[$DFWC R]
4963         MOVEM R,QIOWD
4964         SETZM QIOWD+1
4965         MOVE E,QSGL(C)
4966         PUSHJ P,QPOSR
4967         MOVEM E,QCHPGA
4968 QOVR:   CONSZ DSK,20            ;ENTER HERE FOR RECOVER FROM PI HALT, OVERRUN
4969          JRST QOVR
4970         SKIPGE Q,QSDU
4971          BUG
4972         MOVEI TT,QIOWD
4973         HRRZM TT,QICWA
4974 QECCX:  SETZM QICWA+1           ;ENTER HERE FROM ECC CORRECTION CODE
4975         CONO DSK,%HOCLR+%HORAE+%HOATN+DSKCHN
4976         HLRZ TT,QCHPGA
4977         CAME TT,QPOS(Q)
4978          JRST DSKEX             ;DONT DO ANYTHING IF NOT WHERE YOU SHOULD BE
4979         MOVSI A,%HRCYL(Q)       ;STORE ADDRESS IN DRIVE
4980         HLR A,QCHPGA
4981         PUSHJ P,RHSET
4982         MOVSI A,%HRADR(Q)
4983         HRR A,QCHPGA
4984         PUSHJ P,RHSET
4985         MOVE A,QCHPRG
4986         PUSHJ P,RHSET
4987 IFN QRDCMP,[
4988         SETZM RDCPHS            ;ASSUME NO READ-COMPARE WANTED
4989         SKIPE QRCSW
4990          SETOM RDCPHS           ;REMEMBER TO READ-COMPARE LATER
4991 ];QRDCMP
4992         MOVE A,TIME
4993         MOVEM A,LQTM
4994         CAILE C,NQCHN
4995          JRST .+5
4996           SKIPL B
4997            AOSA NRXFR
4998             AOS NWXFR
4999           JRST QINTX
5000         SKIPL B
5001          AOSA NSRXFR
5002           AOS NSWXFR
5003 QINTX:  JRST DSKEX
5004
5005 QHUNG:  CONO DSK,%HOCLR+%HORST+%HOSTP+DSKCHN    ;HUNG, CLEAR CONTROLLER
5006         SETOM QHUNGF
5007         MOVE Q,QSDU
5008         AOS NTQHNG(Q)
5009         MOVSI A,%HRDCL(Q)
5010         HRRI A,%HMCLR           ;CLEAR DRIVE
5011         PUSHJ P,RHSET
5012         BUG INFO,[DSK: HUNG ON UNIT ],DEC,QSDU,[ADDR=],OCT,QCHPGA
5013         POPJ P,
5014 ]
5015 \f;READ - DROPS IN
5016 IFN DC10P,[
5017         MOVSI T,(DREAD)
5018 QINT6A: MOVEM T,QCHPRG
5019         MOVEM Q,QSDU
5020         DPB R,[DCBN+QCHPR2]     ;MEM BLOCK #
5021         DPB R,[DCBN+QCHPR3]     ;FOR POSSIBLE READ COMPARE
5022         MOVE E,QSGL(C)
5023         PUSHJ P,QPOSR   ;QPOSR ALSO STORES MAPPED UNIT IN QCHPRG
5024         IORB E,QCHPRG
5025         CLEARM QCHPR4   ;STORE DHALT FOR NO RCC
5026         CAILE C,NQCHN
5027          JRST QINT6S    ;SWAPPING CHNL
5028         SKIPL B
5029          AOSA NRXFR
5030           AOS NWXFR
5031         CAIE C,NQCHN    ;ALWAYS R COMPARE DIR WRITES
5032          SKIPLE QRCSW   ;SKIP ON NOT READ COMP EVERYTHING
5033           JRST QINT6B   ;RCC
5034         SKIPL QRCSW
5035          JUMPL B,QINT6B ;RCC WRITES
5036         HRRZ D,QSRAC(C)
5037         CAIL D,%QMUDR
5038         CAILE D,%QMTTR
5039          JRST QINT6C    ;NOT DIR READ
5040 QINT6B: TLZ E,340000    ;CHANGE TO READ COMPARE
5041         MOVEM E,QCHPR4
5042 QINT6C: SETOM QERS1     ;ERR VERIFY IND
5043 QOVR:   CONSZ DC0,DSSRUN+DSSACT
5044          JRST QOVR
5045         DATAO DC0,[DJMP QCHPRG] ;ENTRY ON OVERRUN
5046 QOVR1:  CONO DC0,DCSET+DCIENB+DSKCHN    ;INTERRUPT WHEN DONE
5047         MOVE A,TIME
5048         MOVEM A,LQTM
5049 QINTX:  JRST DSKEX
5050
5051 QINT6S: SKIPL B
5052          AOSA NSRXFR
5053           AOS NSWXFR
5054         JUMPL B,QINT6B  ;RCC WRITES
5055         JRST QINT6C     ;NOT READS
5056
5057 QHUNG:  CONO DC0,DCCSET+DSKCHN  ;HUNG, CLEAR CONTROLLER
5058         SETOM QHUNGF
5059         MOVE Q,QSDU
5060         AOS NTQHNG(Q)
5061         BUG INFO,[DSK: HUNG ON UNIT ],DEC,QSDU,[QCHPRG=],OCT,QCHPRG
5062         POPJ P,
5063 ]
5064
5065 QINT6W:IFE DMDSK,[
5066         MOVE T,[QXWDS-1,,QXWDS]
5067         BLT T,QXWDS+3
5068         CAIL C,NQCHN
5069          JRST QNT6W2    ;SWAP OR DIR WRITE
5070         MOVE A,QUDPR(C)
5071         MOVE T,QSNUD(A)
5072         MOVEM T,QXWDS+XWSYSN
5073         HRRZ A,QSNLCN(A)
5074         ADD A,QUDFPR(C)
5075         MOVE T,UNFN1(A)
5076         MOVEM T,QXWDS+XWFN1
5077         MOVE T,UNFN2(A)
5078         MOVEM T,QXWDS+XWFN2
5079         MOVE T,QSLBLK(C)
5080         DPB T,[XWBLK+QXWDS]
5081         LDB T,[MWC,,MEMBLT(R)]
5082         DPB T,[XWAWC+QXWDS]
5083 QNT6W2:
5084 ]
5085 IFN DC10P,      MOVSI T,(DWRITE)
5086 IFN RP10P,      MOVSI T,(DWRITC)
5087 IFN RH10P,      MOVEI T,%HMWRT
5088 IFN RH11P,      MOVEI T,%HMWRT
5089         JRST QINT6A
5090 \f
5091 IFN T300P,[
5092 T3IO:   MOVEM C,QSDCH1          ;THIS IS MORE OR LESS QINT6A FOR T-300
5093         MOVEM Q,QSDU1
5094         MOVEI A,%DMRED
5095         SKIPGE B,QSCRW(C)
5096          MOVEI A,%DMWRT
5097 T3IO1:  MOVE R,QSCABN(C)        ;RE-ENTER HERE TO RETRY WITH COMMAND IN A
5098         LSH R,10.               ;FIRST ADDRESS IN TRANSFER
5099         TLO R,730000            ;12-BIT BYTES, START WITH FIRST BYTE IN WORD
5100         MOVSI E,-4              ;SET UP BYTE POINTERS
5101         MOVEM R,DSCPNT(E)
5102         ADDI R,400
5103         AOBJN E,.-2
5104         MOVE D,QSGL(C)          ;DO LIKE QPOSR
5105         CAIL D,NBLKS1
5106          BUG
5107         IDIVI D,NBLKC1
5108         MOVEM D,DSCCYL
5109         IMULI E,SECBL1
5110         IDIVI E,NSECS1
5111         MOVEM E,DSCHED
5112         MOVEM TT,DSCSEC
5113         PUSHJ P,T3CMD
5114         CAILE C,NQCHN
5115          JRST .+5
5116           SKIPL B
5117            AOSA NRXFR1
5118             AOS NWXFR1
5119           JRST QINTX
5120         SKIPL B
5121          AOSA NSRXF1
5122           AOS NSWXF1
5123         JRST QINTX
5124
5125 ;START T-300, COMMAND IN A, DRIVE IN Q
5126 T3CMD:  MOVEI TT,2561
5127         MOVEM TT,DSCCHK
5128         MOVE TT,TIME
5129         MOVEM TT,LQTM1
5130         MOVEI TT,-T300P(Q)
5131         MOVEM TT,DSCDRV
5132         HRRZM A,DSCCMD
5133         SETZM DSCDON
5134         MOVEI T,1
5135         MOVEM T,DSCREQ
5136         CONO DLC,100040+TTYCHN  ;INTERRUPT 11
5137         POPJ P,
5138
5139 QHUNG1: MOVE Q,QSDU1
5140         AOS NTQHNG(Q)
5141         BUG INFO,[DSK: HUNG ON T-300 UNIT ],DEC,QSDU
5142         MOVEI TT,5*60.*30.      ;SHUT UP FOR FIVE MINUTES
5143         ADDM TT,LQTM1
5144         POPJ P,
5145 ];T300P
5146 \f
5147 QDE:    MOVE C,QSDCH
5148 IFN RP10P, PUSHJ P,QERSOFT
5149 IFN DC10P, AOSE PKIDM
5150          SKIPGE Q,QSDU
5151           BUG
5152 IFN DC10P,[
5153         TRNE TT,DCKSER
5154          JRST .+3       ;GET CKS ERR
5155           TRNE TT,DRCER
5156            AOS NQCMPE(Q) ;# COMPARE ERRORS [WITH NO OTHER ERROR]
5157 ];DC10P
5158 IFN T300P,T3DE:         ;ENTER HERE FOR ERROR ON T-300
5159         AOS NQDE(Q)
5160         SKIPL R,QSCRW(C)
5161          AOSA NQRDE(Q)
5162           AOS NQWDE(Q)
5163 IFN DC10P,      JUMPL R,QERV1   ;DO ANOTHER RD/COMP TO SEE IF OK ON DSK (IF WRITE)
5164 QERV2:  AOS R,QERRS(C)
5165         TRNN R,10       ;TRY 8 TIMES BEFORE AND AFTER REPOSITION
5166          JRST QDE1
5167         TRNN R,1000
5168          JRST QDE2      ;TRY REPOSITION ONCE
5169 QERV3:  MOVE D,QSRAC(C)
5170         TRNE D,-%QMMAX
5171          BUG
5172         XCT .+1(D)      ;INVOKE IRRECOV ERROR HANDLER
5173 QERV:   OFFSET -.
5174 %QMIDL::JRST 4,QERV+.   ;IDLE CHANNELS SHOULDN'T GET HERE
5175 %QMRD:: JRST QPE2D      ;USER DATA
5176 %QMWRT::JRST QDE1       ;WRITE KEEP TRYING
5177 %QMWOV::JRST QDE1       ;..
5178 %QMRD1::JRST QPE2D
5179         JRST 4,QERV+.   ;ILL CODE
5180 %QMUDR::JRST QUDER1
5181 %QMMDR::JRST QDE1
5182 %QMTTR::JRST QDE1
5183 %QMUDW::JRST QDE1
5184 %QMMDW::JRST QDE1
5185 %QMTTW::JRST QDE1
5186 %QMSWP::JRST QSWPER
5187         JRST 4,QERV+.   ;ILL CODE
5188         JRST 4,QERV+.   ;ILL CODE
5189         JRST 4,QERV+.   ;ILL CODE
5190 %QMMAX::OFFSET 0
5191
5192 QSWPER: SKIPGE CIRPSW           ;TRY XFER AGAIN IF CIRPSW NOT AVAILABLE
5193         SKIPGE QSCRW(C)
5194          JRST QDE1              ;DON'T TRY TO DO ANYTHING ABOUT WRITE ERRORS
5195         MOVE A,QSCABN(C)        ;READ - GIVE ALL USERS OF PAGE PARITY ERR
5196         PUSH P,C
5197         PUSH P,Q
5198         MOVE C,[2200,,MEMPNT(A)]
5199         PUSHJ P,UCPRL
5200           400000,,QSWER1
5201         LDB Q,[2200,,MEMPNT(A)]
5202         DPB Q,C                 ;REMOVE MEM FROM LOOP
5203         PUSHJ P,IMEMR           ;AND GIVE BACK MEM
5204         POP P,Q                 ;ALTERNATIVELY, COULD LEAVE THE MEM BUT SET MMPBAD
5205         POP P,C                 ;TO INDICATE THAT THAT MEM COPY OF THE PAGE IS NO GOOD.
5206         MOVEI D,2
5207         DPB D,[410200,,@QSMMP(Q)]       ;PAGE IS OUT
5208         JRST QPE2D
5209
5210 QSWER1: PUSH P,T
5211         MOVSI T,%PJPAR
5212         IORM T,PIRQC(U)
5213         JRST POPTJ
5214 \f
5215 IFN DC10P,[
5216 QERV1:  SKIPN QCHPR4
5217          JRST QERV2     ;NOT SET FOR RCC
5218         CLEARM QERS1
5219 QERL2:  CONSZ DC0,DSSRUN+DSSACT
5220          JRST .-1
5221         DATAO DC0,[DJMP QCHPR4]
5222         JRST QOVR1
5223
5224 QERL1:  AOS Q,QERS1
5225         CAIGE Q,50.
5226          JRST QERL2
5227         AOSA NQWIRE
5228 QEROK:   AOS NQWRE
5229         MOVE C,QSDCH
5230         MOVE Q,QSDU
5231         SETOM QERS1
5232         JRST QERV2
5233 ]
5234 QDE2:   MOVEI R,1000
5235         MOVEM R,QERRS(C)        ;CLOBBER QERRS
5236         JRST QREC               ;AND TRY REPOSITIONING
5237
5238 IFN RP10P,[
5239 QERSOFT:LDB A,[DCYL+QCHPRG]     ;PARSE STARTING DISK ADDRESS
5240         LDB B,[DCYLXB+QCHPRG]
5241         LSH B,8
5242         IOR A,B
5243         LDB B,[DSURF+QCHPRG]
5244         LDB D,[DSECT+QCHPRG]
5245         SKIPN QERRS(C)          ;PRINT ONLY ONCE, NOT ON RETRIES
5246          BUG INFO,[DSK: SOFT ERR UNIT ],DEC,Q,[CYL ],DEC,A,[STARTING HEAD ],DEC,B,[SEC ],DEC,D,[CONI=],OCT,QERST,[DATAI=],OCT,QERDTI
5247         POPJ P,
5248
5249 QRECAT: CONI DPC,A
5250         BUG INFO,[DSK: SEEK ERR DATAO=],OCT,QSEEK(Q),[CONI=],OCT,A,[DATAI=],OCT,E
5251         SETZM QSEEK(Q)
5252         JRST QREC
5253 ];RP10P
5254
5255 QHE:    MOVE C,QSDCH
5256 IFN RP10P, PUSHJ P,QERSOFT
5257         SKIPGE Q,QSDU
5258          BUG
5259 IFN T300P,T3HE:         ;ENTER HERE FOR ID ERROR ON T-300
5260         AOS NQHE(Q)
5261         AOS E,QERRS(C)
5262         CAIL E,5.
5263          JRST QHE2
5264 QREC:
5265 IFN T300P,[
5266         CAIL Q,T300P
5267          JRST [ SETOM QRCAL(Q)
5268                 MOVEI A,%DMREC
5269                 PUSHJ P,T3CMD
5270                 MOVEM Q,QSDU1   ;CONTROLLER IS TIED UP BY RECAL BECAUSE
5271                 JRST QINT1 ]    ;IT'S TOO DAMNED PSEUDO-INTELLIGENT
5272 ];T300P
5273 IFN DC10P,[
5274         MOVE TT,QTRAN(Q)
5275 QREC0:  DPB TT,[DUNFLD+QRECAL]
5276         SETOM QRCAL(TT)
5277         SETOM QSKT1(TT)
5278         CLEARM QSPPS(TT)
5279         CLEARM QPOSGL(TT)
5280         SETOM QPOS(TT)
5281         MOVEI T,10.             ;5-SECOND RECALIBRATE TIMEOUT
5282         MOVEM T,QRCTIM(TT)
5283         DATAO DC0,QRECAL
5284         CONO DC0,DCSET+DCATEB+DSKCHN    ;ENABLE ATTENTION
5285 ]
5286 IFN RP10P,[
5287         DPB Q,[DUNFLD+QRECAL]
5288         SETOM QPOS(Q)
5289         DATAO DPC,QRECAL
5290         CLEARM QSPPS(Q)
5291         SETOM QSKT1(Q)
5292         SETOM QRCAL(Q)  ;INDICATE RECALIBRATING THIS DISK
5293         CLEARM QPOSGL(Q)
5294 ]
5295 IFN RH11P,[
5296         PUSHJ P,RHSLCT          ; Select drive
5297         PUSHJ P,RHCLRD          ; Clear errors
5298         MOVEI A,%HMREC
5299         PUSHJ P,RHCMD           ; Recalibrate
5300         CLEARM QSPPS(Q)
5301         CLEARM QPOSGL(Q)
5302         SETOM QPOS(Q)
5303         SETOM QSKT1(Q)
5304         SETOM QRCAL(Q)
5305 ] ;RH11P
5306 IFN RH10P,[
5307         MOVSI A,%HRDCL(Q)
5308         HRRI A,%HMCLR
5309         PUSHJ P,RHSET           ;CLEAR ERROR OUT OF DRIVE.
5310         MOVSI A,%HRDCL(Q)
5311         HRRI A,%HMREC           ;RECALIBRATE
5312         PUSHJ P,RHSET           ;MAYBE SHOULD TRY OFFSET FIRST?
5313         CLEARM QSPPS(Q)
5314         CLEARM QPOSGL(Q)
5315         SETOM QPOS(Q)
5316         SETOM QSKT1(Q)
5317         SETOM QRCAL(Q)
5318 ]
5319         SETOM QSDU
5320         JRST QINT1      ;LOOK FOR SOME OTHER TRANSFER
5321 \f
5322 QHE2:   SKIPL QSCRW(C)  ;HANG UP OR POSITIONING ERR (AFTER 5 TRIES)
5323          JRST QERV3     ;IF READ, PERFORM RECOVERY
5324
5325 QPE2D:  MOVSI R,%QAPAR  ;IRRECOVERABLE ERROR
5326         IORM R,QSRAC(C)
5327         AOS QIRRCV
5328         MOVE D,QSGL(C)
5329         MOVEM D,QIRCBK  ;BLOCK # AT IRRCV ERR
5330         MOVEM Q,QIRUNT  ;SAVE UNIT TOO
5331         CAILE C,NQCHN
5332          AOS NIRSWE     ;# IRRCV SWAPPING ERRS
5333         MOVE I,Q
5334         SKIPGE QTUTO(I)
5335          JRST QPE2E     ;DON'T MESS WITH LOCKED TUT
5336         PUSHJ P,TUTPNT
5337         CAIN B,TUTLK    ;PRINT MESSAGE IF NOT YET LOCKED OUT
5338          JRST QINTI
5339         MOVEI B,TUTLK
5340         DPB B,D
5341 QPE2E:  BUG INFO,[DSK: IRREC DATA ERR #],DEC,QIRRCV,[UNIT=],DEC,QIRUNT,[BLK=],OCT,QIRCBK
5342         JRST QINTI
5343
5344 QUDER1: MOVEI R,1(Q)    ;TRY TO READ DIR FROM OTHER DISKS
5345 QUDER2: CAIL R,NQS
5346          MOVEI R,0
5347         CAME R,QDSKN(C)
5348          JRST QUDER4
5349         JRST QDE1       ;NO OTHER DISK AVAIL TO READ FROM, TRY AGAIN
5350
5351 QUDER4: SKIPGE QACT(R)
5352          AOJA R,QUDER2
5353         HRRZM R,QDSKN(C)        ;TRY THIS DISK
5354 IFN T300P,[
5355         CAIL Q,T300P
5356          JRST [ SETOM QSDU1     ;FREE DRIVE FORMERLY HACKING
5357                 SETOM QTUNT1
5358                 JRST T3UDE4 ]
5359 ];T300P
5360 IFE DC10P, SETOM QSKT1(Q)       ;FREE DRIVE FORMERLY HACKING
5361 IFN DC10P,[
5362         MOVE TT,QTRAN(Q)
5363         SETOM QSKT1(TT)
5364 ]
5365         SETOM QSDU
5366         SETOM QTUNT
5367 IFN T300P,T3UDE4:
5368         MOVE E,QSGL(C)
5369         MOVE Q,QDSKN(C)
5370         SETZM QERRS(C)
5371         JRST QINT5
5372 \f
5373 QIDRCH: MOVE TT,QDIRP(C)        ;CHNL IN C PNTR TO QSNUD IN J LOAD NEXT CHR INTO A
5374         AOS QDIRP(C)            ;ALSO RET BYTE PNTR IN TT
5375         IDIVI TT,UFDBPW
5376         HLL TT,QBTBL(I)
5377         HRRZ I,QSNLCN(J)
5378         ADDI TT,UDDESC(I)
5379         LDB A,TT
5380         POPJ P,
5381
5382 QMPDCH: MOVE TT,QDIRP(A)        ;CHNL IN A PNTR TO QSNUD IN H LOADS NEXT CHR IN R
5383         AOS QDIRP(A)            ;USED AT M.P. LEVEL
5384 QMPDC1: IDIVI TT,UFDBPW         ;ALSO RETN BYTE PNTR IN TT
5385         HLL TT,QBTBL(I)
5386         HRRZ I,QSNLCN(H)
5387         ADDI TT,UDDESC(I)
5388         LDB R,TT
5389         POPJ P,
5390
5391 ;REACHED EOF ON READ
5392 QEOF:   SOS QDIRP(C)            ;AVOID GC UNHAPPINESS
5393         MOVSI I,%QAEFR
5394         IORM I,QSRAC(C)
5395         HLLZS QSRAC(C) .SEE %QMIDL ;IDLE THE CHANNEL
5396         AOS QSBFS(C)            ;TO UNHANG M.P. WHICH IS WAITING FOR BUF TO APPEAR
5397         JRST QINT2C
5398
5399 QINT4C:
5400 ; 8/20/90 DM "funny" bit no longer supported.  Allows for huge RP07 block
5401 ; numbers.  Commenting this out means that %QAFNY can no longer get set
5402 ; under any circumstances, so I am leaving a certain amount of dead code in
5403 ; other places.
5404 ; IFN DMDSK,[
5405 ;       MOVSI E,%QAFNY
5406 ;       ANDCAM E,QSRAC(C)
5407 ;       TRZE A,20       ; FUNNY FILE BLOCK
5408 ;        IORM E,QSRAC(C); INDICATE SO
5409 ; ]
5410         MOVEI E,0
5411         DPB A,[140500,,E]
5412         PUSHJ P,QIDRCH
5413         DPB A,[060600,,E]
5414         PUSHJ P,QIDRCH
5415         DPB A,[0600,,E]
5416         MOVEM E,QSLGL(C)
5417         JRST QINT4G
5418
5419 ;DECODE UNBYTE SPEC IN D.
5420 ;RETURNS BYTE SIZE IN D, NUMBER OF UNUSED BYTES IN LAST WORD IN E.
5421 QBDCD:  TRZE D,400
5422          JRST [ IDIVI D,100 ? POPJ P, ]
5423         TRZE D,200
5424          JRST [ IDIVI D,20 ? POPJ P, ]
5425         SUBI D,44
5426         JUMPGE D,[ IDIVI D,4 ? POPJ P, ]
5427         MOVNS D
5428         SETZ E,
5429         POPJ P,
5430
5431 ;ENCODE BYTE SIZE IN Q AND RESIDUE IN R INTO UNBYTE SPEC IN RH(Q)
5432 QBENC:  CAIG Q,3
5433          JRST [ IMULI Q,100 ? ADDI Q,400(R) ? POPJ P, ]
5434         CAIG Q,7
5435          JRST [ IMULI Q,20 ? ADDI Q,200(R) ? POPJ P, ]
5436         CAIG Q,18.
5437          JRST [ IMULI Q,4 ? ADDI Q,44(R) ? POPJ P, ]
5438         MOVNI Q,-44(Q)
5439         POPJ P,
5440 \f
5441 QINT3:  SKIPL DWUSR
5442          JRST QINT3X    ;DIR CHNL IN USE
5443 IFN T300P,[
5444         SKIPGE QSDU     ;DON'T GET PAST HERE UNLESS BOTH CONTROLLERS ARE IDLE
5445          SKIPL QSDU1
5446           JRST QINT3X
5447 ];T300P
5448         AOSL QDWFAR
5449          JRST [ MOVNI H,10.
5450                 MOVEM H,QDWFAR
5451                 JRST .+3 ]
5452            SKIPG QACTTM ;LAST ACTIVITY TOO RECENT
5453             JRST QUDW
5454         SKIPGE H,QMDRO
5455          JRST QTDW
5456         MOVE J,QACTB
5457         TDNN J,H
5458          JRST QTDW
5459         MOVSI Q,-NQS
5460 QMDW:   SKIPGE QACT(Q)
5461          JRST QMDWA     ;UNIT NOT ACTIVE
5462         MOVE J,DCHBT(Q)
5463         TDNN J,QMDRO
5464          JRST QMDWA
5465         HRLI Q,(SETZ)   ;INDICATE MFD WRITE IN PROGRESS
5466         MOVEM Q,QDWIP
5467         HRRZM Q,DWSKN
5468         MOVEI TT,%QMMDW
5469         HRRZM TT,QSRAC+NQCHN
5470         MOVSI TT,(SETZ)
5471         IORB TT,QMDRO
5472         MOVE C,MDCHK(TT)
5473         CAME C,[SIXBIT /M.F.D./]
5474          BUG HALT,[MFD CLOBBERED]
5475         HRRZ C,Q
5476         CAMN C,MDSK
5477          AOSA C,QAMDNO
5478           MOVE C,QAMDNO
5479         MOVEM C,MDNUM(TT)
5480         SETZM DWUSR
5481         MOVEI TT,MFDBLK
5482         MOVEM TT,QSGL+NQCHN
5483         HRRZ TT,QMDRO
5484         LSH TT,-10.
5485         MOVEM TT,QSCABN+NQCHN
5486         JRST QINT1
5487
5488 QMDWA:  AOBJN Q,QMDW
5489 QTDW:   SKIPG QACTTM
5490          JRST QUDW
5491         MOVSI Q,-NQS
5492 QTDW1:  SKIPGE QACT(Q)
5493          JRST QTDWA
5494         MOVE J,DCHBT(Q)
5495         SKIPL QTUTO(Q)
5496         TDNN J,QTUTO(Q)
5497          JRST QTDWA
5498         MOVSI H,240000
5499         TDNE H,QTUTO(Q)
5500          JRST QTDWA1
5501         MOVE TT,TIME            ;DON'T WRITE TUTS TOO OFTEN
5502         SUB TT,QTWRTM(Q)        ;BECAUSE THE TUT IS LOCKED WHILE IT'S BEING WRITTEN
5503         CAIGE TT,100.
5504          JRST QTDWA
5505         ADDM TT,QTWRTM(Q)
5506         HRLI Q,200000
5507         MOVEM Q,QDWIP
5508         HRRZM Q,DWSKN
5509         MOVEI TT,%QMTTW
5510         HRRZM TT,QSRAC+NQCHN
5511         MOVSI TT,(SETZ)
5512         IORB TT,QTUTO(Q)
5513         MOVE H,QPKNM(Q)         ;VERIFY THAT TUT IS NOT BEING CLOBBERED
5514         MOVE C,QPKID(Q)
5515         CAMN H,QPAKID(TT)
5516          CAME C,QPKNUM(TT)
5517           BUG HALT,[TUT ],DEC,Q,[CLOBBERED]
5518         SETZM DWUSR
5519         MOVEI TT,MFDBLK         ;INITIATE WRITING OF FIRST BLOCK OF TUT
5520         SUB TT,NTBL(Q)
5521         MOVEM TT,QSGL+NQCHN
5522         LDB TT,[121000,,QTUTO(Q)]
5523         MOVEM TT,QSCABN+NQCHN
5524         JRST QINT1
5525 \f
5526 QTDWA1: ANDCAM J,QTUTO(Q)
5527 QTDWA:  AOBJN Q,QTDW1
5528 QUDW:   MOVSI C,-QNUD
5529 QDW4A:  MOVE J,QACTB    ;BITS CORRESP TO ACTIVE DISKS
5530 QDW4:   SKIPE TT,QSNUD(C)
5531         SKIPGE QSNLCN(C)
5532          JRST QDW3      ;SLOT VACANT OR LOCKED
5533         TDNE J,QSNLCN(C)
5534          JRST QUDW1     ;NEEDS TO BE WRITTEN ON SOME UNIT
5535 QDW3:   AOBJN C,QDW4A
5536 QINT3X: ;HERE IF DISK GOING IDLE.  CLEAR DONE FLAG.
5537         ;IN 2-CONTROLLER CASE, MAKE SURE WE ONLY DO IT TO THE RIGHT CONTROLLER.
5538 IFN T300P,[
5539         SKIPL QSDU
5540          JRST DSKEX     ;STUFF NEEDS TO BE DONE BUT CANT NOW
5541 ] ;T300P
5542 IFN DC10P, CONO DC0,DCCLR+DCIENB+DSKCHN
5543 IFN RP10P, CONO DPC,177710+DSKCHN       ;MUST CLEAR "DONE"
5544 IFN RH10P, CONO DSK,%HOCLR+%HOATN+%HORAE+DSKCHN
5545 IFN RH11P, ;; RH11 doesn't need this?
5546         JRST DSKEX      ;STUFF NEEDS TO BE DONE BUT CANT NOW
5547
5548 QUDW1:  MOVSI J,%QUDWM  ;WRITE RIGHT AWAY IF %QUDWM IS ON
5549         TDNN J,QSNLCN(C)
5550          SKIPE QSFBT(C) ;OR DISK BLOCKS (AND CORE) WAITING TO BE FREED
5551           JRST QUDW6
5552         SKIPG QACTTM    ; ACTIVITY TOO RECENT
5553          SKIPN QSNNR(C) ; THEN ONLY WRITE IF NOTHING POINTING TO DIRECTORY
5554           SKIPA
5555            JRST QDW3
5556         MOVSI Q,-NQS
5557 QUDW4:  SKIPGE QACT(Q)
5558          JRST QUDW3
5559         MOVE J,DCHBT(Q)
5560         TDNE J,QSNLCN(C)
5561          JRST QUDW2
5562 QUDW3:  AOBJN Q,QUDW4
5563         JRST QDW3
5564
5565 QUDW6:  ANDCAM J,QSNLCN(C)      ;TURN OFF %QUDWM
5566         MOVE Q,MDSK             ;AND WRITE ON MASTER DISK (ASSUME MDSK IS ACTIVE AND BIT IN QSNLCN IS SET)
5567
5568 QUDW2:  MOVE I,QMDRO
5569         TLNE I,40000    ;IS THIS CODE OBSOLETE? LEFT FROM DAYS OF 1 MFD PER DRIVE?
5570          JRST QUDW2B    ;MASTER DIR NOT IN
5571         HRRZS Q
5572         CAMN Q,MDSK     ;SKIP IF NOT WRITING ON MASTER DISK
5573          PUSHJ P,QDIRCK ;BLESS THIS UFD!!!
5574         MOVSI TT,(SETZ)
5575         IORB TT,QSNLCN(C)       ;LOCK USER DIRECTORY
5576         MOVEI J,%QMUDW
5577         HRRZM J,QSRAC+NQCHN
5578         MOVE A,1(TT)            ;NAME AREA PTR
5579         MOVE J,QSNUD(C)
5580         CAMN J,UDNAME(TT)       ;MAKE SURE NOT ABOUT TO WRITE BAD DIRECTORY
5581          CAILE A,2000
5582           JSP TT,QUDCLB
5583         SUBI A,11.
5584         IMULI A,6
5585         SKIPL J,(TT)
5586         CAMLE J,A       ;FS PTR BAD?
5587          JSP TT,QUDCLB
5588         CLEARM DWUSR
5589         MOVEM Q,DWSKN
5590         MOVE TT,QSNMI(C)
5591         MOVEM TT,QSGL+NQCHN
5592         HRRZ TT,QSNLCN(C)
5593         LSH TT,-10.
5594         MOVEM TT,QSCABN+NQCHN
5595         HRRZM C,QDWIP
5596         CLEARM QERRS+NQCHN
5597         JRST QINT1
5598
5599 QUDW2B: ANDCAM J,QSNLCN(C)      ;CLEAR BIT + GO AWAY
5600         JRST QUDW3
5601
5602 ;GENERALLY GET HERE BY JSP TT,
5603 QUDCLB: BUG HALT,[DIR ],OCT,C,SIXBIT,QSNUD(C),[CLOBBERED]
5604 \f
5605 QDIRCK: PUSH P,TT       ;CHECKS FILES FOR REASONABLE DESCRIPTORS -
5606                         ; PRECEDING BYTE =0, FIRST BYTE NOT=0
5607         HRRZ A,QSNLCN(C)
5608         MOVEI B,1777(A) ;END OF NAMES
5609         ADD A,1(A)      ;BEGIN NAMES
5610 QDIRC1: CAMG B,A
5611          JRST POPTTJ    ;DONE
5612         SKIPN (A)
5613          JRST QDIRC2    ;0 NAME=NO FILE
5614         LDB TT,[1500,,UNRNDM(A)]        ;DESC PTR
5615         SOS TT          ;TRICK - IF DESC PTR = 0 LDB BELOW GETS 0 BECAUSE P FIELD = 44
5616         IDIVI TT,6
5617         HLL TT,SBTBL(I) ;BYTE POINTER
5618         ADDI TT,UDDESC-1777(B)
5619         LDB I,TT
5620         JUMPN I,QUDCLB
5621         ILDB I,TT
5622         JUMPE I,QUDCLB
5623 QDIRC2: ADDI A,LUNBLK
5624         JRST QDIRC1
5625
5626 IFN RP10P,[
5627 QPOSR:  CAIL E,MBLKS
5628          BUG                    ;TOO BIG EVEN FOR RP03
5629 IFN DMDSK,[
5630         IMULI E,SECBLK
5631         IDIVI E,NSECS
5632         SETZM D
5633         DPB TT,[DSECT+D]
5634         IDIVI E,NHEDS
5635         DPB TT,[DSURF+D]
5636         DPB E,[DCYL+D]
5637         MOVEM E,QSPPS(Q)
5638         LSH E,-8
5639         DPB E,[DCYLXB+D]
5640         DPB Q,[DUNFLD+D]
5641 ]
5642 IFE DMDSK,[
5643         MOVEI D,0
5644         IDIVI E,NBLKSC
5645         DPB E,[DCYL+D]
5646         MOVEM E,QSPPS(Q)
5647         LSH E,-8
5648         DPB E,[DCYLXB+D]
5649         MOVE E,TT
5650         IMULI E,NSSECS
5651         IDIVI E,NHSECS
5652         DPB E,[DSURF+D]
5653         DPB TT,[DSECT+D]
5654         DPB Q,[DUNFLD+D]
5655 ]
5656         MOVE E,D
5657         POPJ P,
5658 ]
5659 IFN RH10P+RH11P,[
5660 IFE DMDSK, .ERR CHANGE QPOSR FOR 9-SECTOR BLOCKS!
5661 QPOSR:  CAIL E,NBLKS
5662          BUG
5663         IDIVI E,NBLKSC
5664         HRLZ D,E                ;CYLINDER IN LH
5665         MOVEM E,QSPPS(Q)
5666         MOVE E,TT
5667         IMULI E,SECBLK
5668         IDIVI E,NSECS
5669         LSH E,8
5670         IOR E,D                 ;SURFACE IN 1.9-2.4
5671         IOR E,TT                ;SECTOR IN 1.1-1.5
5672         POPJ P,
5673 ] ;RH10P+RH11P
5674 \f
5675 IFN DC10P,[
5676 QPOSR:  CAIL E,NBLKS
5677          BUG
5678         IDIVI E,NSECS
5679         MOVSI D,(DUNENB)
5680         DPB TT,[DSECT+D]
5681         IDIVI E,NHEDS
5682         DPB TT,[DSURF+D]
5683         SKIPGE TT,QTRAN(Q)
5684          ADDI E,NCYLS+XCYLS
5685         DPB E,[DCYL+D]
5686         MOVEM E,QSPPS(TT)
5687         MOVE E,D
5688         DPB TT,[DUNFLD+E]
5689         DPB TT,[DUNFLD+QCHPRG]
5690         SKIPGE TT,QPKID(Q)
5691          JRST QPOSRI
5692         DPB TT,[DPKID+E]
5693         POPJ P,
5694
5695 QPOSRI: MOVE TT,QTRAN(Q)        ;NEED PACK ID BEFORE PROCEEDING
5696         DPB TT,[DUNFLD+GPKID]
5697         SETOM QSKT1(TT)
5698         MOVEI A,TUTCYL
5699         SKIPGE QTRAN(Q)
5700          ADDI A,NCYLS+XCYLS
5701         DPB A,[DCYL+GPKID]
5702         MOVEM A,QPOS(TT)        ;WILL SEEK TO HERE AUTOMATICALLY
5703         MOVEM A,QPOSGL(TT)
5704         DATAO DC0,[DJMP GPKID]
5705         MOVEM Q,QSDU
5706         SETOM PKIDM
5707         JRST QINTX
5708
5709 QSPKID: CONSZ DC1,1777
5710          BUG            ;ERRORS
5711         LDB TT,[DPKID+RPKID]
5712         MOVEM TT,QPKID(Q)
5713         SETOM QSDU
5714         JRST QINT1
5715 ]
5716 \f
5717 SUBTTL DISK IOT ROUTINES
5718
5719 OVHMTR UUO      ;MORE RANDOM UUOS
5720
5721 ;BECAUSE .ACCESS MERELY DROPS ITS ARG IN A VARIABLE AND SETS %QAACC,
5722 ;ALL IOT ROUTINES MUST TEST %QAACC AND DO THE REAL WORK OF CHANGING
5723 ;THE ACCESS POINTER IF NECESSARY.
5724
5725 QBO:    MOVEI T,BLKT
5726         JRST QUO1
5727
5728         SKIPA T,[SIOKT]
5729 QUIO:
5730 QUAO:    MOVEI T,CHRKT
5731 QUO1:   PUSH P,T
5732         PUSH P,TT
5733         PUSH P,D
5734         MOVE T,QSRAC(A)
5735         TLNE T,%QAACC+%QALNK
5736          PUSHJ P,QBWRA1 ;RANDOM ACCESS MODE HACK
5737         POP P,D
5738         POP P,TT
5739         MOVE E,QSBYTE(A)
5740         JSP B,CPOPJ     ;TRANSFER TO CHRKT, SIOKT, OR BLKT
5741 QBOV:   SETZ QSMPRP(A)
5742         QSMPRC(A)
5743         QSBWG
5744         SETZ QSBWW
5745         JRST QOCL
5746         TRNA
5747
5748 QBI:    MOVEI T,BLKT
5749         JRST QUI1
5750
5751         SKIPA T,[SIOKT]
5752 QUII:
5753 QUAI:    MOVEI T,CHRKTI
5754 QUI1:   PUSH P,T
5755         PUSH P,TT
5756         MOVE T,QSRAC(A)
5757         TLNE T,%QAACC+%QALNK
5758          PUSHJ P,QBRRA1
5759         POP P,TT
5760         MOVE E,QSBYTE(A)
5761         JSP B,CPOPJ             ;TRANSFER TO CHRKTI, SIOKT, OR BLKT
5762 QBIV:   QSMPRP(A)
5763         QSMPRC(A)
5764         QSBGB
5765         QSBRB
5766         JRST QICL
5767         SKIPG QSBFS(A)
5768 \f
5769 QBWRA1: TLNE T,%QALNK
5770          JRST IOCR10
5771         LDB T,[$QAMOD,,QSRAC(A)]        ;SET RANDOM ACCESS PNTRS ON WRITE
5772         SOJN T,QBWRA2           ;IN ORDINARY WRITE MODE
5773         SKIPGE QSCRW(A)         ;WAIT FOR CHANNEL TO BECOME IDLE OR HANG UP IN READ
5774          PUSHJ P,UFLS           ; WAITING FOR %QAACC TO TURN OFF
5775         SKIPL QSGL(A)
5776          PUSHJ P,UFLS
5777         SKIPGE QSMDN(A)
5778          JRST QBWRA2
5779         MOVE T,QRADAD(A)        ;DESIRED ADDRESS
5780         SUB T,QFBLNO(A)         ;ACTUAL ADDRESS OF BEG OF CURRENT BUFFER
5781         JUMPL T,QBWRA2          ;XFER ON BEFORE CURRENT BLOCK
5782         MOVE Q,T
5783         SUB T,QMPBSZ(A)         ;SIZE OF CURRENT BUFFER IN BYTES
5784         JUMPL T,QBWRA3          ;SAME BLOCK AS NOW
5785 QBWRA2: PUSH P,R
5786         PUSH P,I
5787         PUSH P,C
5788         PUSHJ P,QSOCL5          ;CLEAR ANY CURRENT BUFFERS ETC
5789         PUSHJ P,QUDULK
5790         MOVE Q,QRADAD(A)
5791         PUSHJ P,QFNTR           ;LOCKS DIR IF SKIPS
5792          JRST QBWRA4            ;OFF END OF FILE
5793 QBWRA5: PUSHJ P,QUDULK
5794 QBWRA9: POP P,C
5795         POP P,I
5796         POP P,R
5797         CLEARM QSCRW(A)         ;SWITCH TO WRITE OVER MODE
5798         MOVSI Q,%QAMPU+%QAMWO   ;SET UPDATE ADR AND WRITE OVER
5799         IORM Q,QSRAC(A)
5800         CLEARM QSMPRC(A)
5801         MOVSI Q,%QAEFR+%QAEFW+%QAACC    ;CLEAR EOF, WRITE EOF, AND ACCESS FLAGS
5802         ANDCAM Q,QSRAC(A)
5803         MOVEI Q,%QMRD1          ;AND READ IN THE CURRENT BLOCK
5804         HRRM Q,QSRAC(A)
5805         POPJ P,
5806
5807 QBWRA4: JUMPE Q,QBWRA0
5808         CAME J,Q                ;MIGHT BE ADDING TO END OF FULL BLOCK
5809          JRST IOCER2
5810         JRST QBWRA9
5811
5812 QBWRA0: PUSHJ P,QLWO            ;OFF END OF FILE AND WAS ACCESSING WD 0
5813         MOVSI C,%QAACC          ;SO SWITCH TO NORMAL WRITE MODE AND
5814         ANDCAM C,QSRAC(A)       ;TURN OFF RANDOM ACCESS BIT
5815         POP P,C
5816         POP P,I
5817         POP P,R
5818         POPJ P,
5819 \f
5820 QBWRA3: SKIPGE TT,QSMDN(A)
5821          BUG                    ;NO BUFFER REALLY ACTIVE AT M.P.
5822         MOVSI J,%QAWOV
5823         TDNN J,QSRAC(A)
5824          JRST QBWRA7
5825         ANDCAM J,QSRAC(A)       ;WAS WRITING IN LAST BLK PAST EOF,
5826         MOVN D,QSMPRC(A)        ; UPDATE ACTIVE BYTE COUNT
5827         ADDM D,QMPBSZ(A)        ;DECREASE SIZE OF BUFFER TO AMT ACTUALLY WRITTEN
5828 QBWRA7: LSH TT,10.              ;ADDRESS OF BUFFER
5829         MOVE T,Q                ;SAVE RELATIVE BYTE ADDR WITHIN BUFFER
5830         IDIVI Q,@QSBYTE(A)      ;Q = WDS, J = BYTES
5831         ADD TT,Q                ;ADDRESS OF DESIRED WORD
5832         HLL TT,QSBYTE(A)        ;BYTE POINTER TO FIRST BYTE IN THAT WORD
5833         JUMPE J,.+3             ;ADVANCE TO APPROPRIATE BYTE
5834          IBP TT
5835          SOJG J,.-1
5836         MOVEM TT,QSMPRP(A)
5837         SUB T,QMPBSZ(A)         ;MINUS # BYTES LEFT IN BLOCK
5838         MOVNM T,QSMPRC(A)
5839 QBRRA4: MOVSI Q,%QAACC
5840         ANDCAM Q,QSRAC(A)
5841         POPJ P,
5842
5843 QSKFRC: MOVN B,QSMPRC(A)
5844         ADD B,QMPBSZ(A)         ;NUMBER OF BYTES WRITTEN IN BLOCK
5845         MOVE C,QSRAC(A)
5846         TLNE C,%QAMWO
5847          TLNE C,%QAWOV
5848           JRST [MOVEM B,QMPBSZ(A)       ;IS LAST BLOCK, CHANGE LENGTH
5849                 PUSHJ P,QOCLPD  ;AND PAD IT (GUARANTEED NO-OP IF WORD MODE CHNL)
5850                 JRST .+1 ]
5851         SETZM QSMPRC(A)         ;BUFFER WILL BE DISPOSED OF
5852         MOVSI E,%QUDWM
5853         SKIPGE QSMDN(A)
5854          SETZB B,E              ;NO BUFFER AFTER ALL
5855         ADD B,QFBLNO(A)         ;CURRENT POSITION IN FILE
5856         MOVSI C,%QAACC
5857         TDNN C,QSRAC(A)
5858          MOVEM B,QRADAD(A)      ;ACCESS BACK ON NEXT IOT
5859         IORB C,QSRAC(A)
5860         PUSHJ P,[TLNE C,%QAWOV  ;WRITE OUT THE BUFFER
5861                   JUMPN E,QSBWO2
5862                  JRST QSBWW ]
5863         SKIPE QMPTC(A)
5864          MOVSI E,%QUDWM
5865         PUSHJ P,QOCL2           ;STORE QMPTC IF NECESSARY
5866         IORM E,QSNLCN(H)        ;WRITE OUT DIR FAST IF CHANGED
5867         PUSHJ P,QUDULK
5868         JRST POPJ1
5869
5870 ;.CALL FINISH ON DISK OUTPUT CHANNEL
5871 QSKFIN: HRRZ T,QSRAC(A)
5872         CAIN T,%QMWOV           ;IF WRITE-OVER MODE
5873          JRST [ SKIPE QSCRW(A)  ;THEN WAIT FOR IT TO SWITCH TO READ MODE
5874                  PUSHJ P,UFLS
5875                 JRST QSKFIN ]
5876         CAIN T,%QMWRT           ;IF WRITE MODE
5877          JRST [ SKIPE QSBFS(A)  ;THEN WAIT FOR ALL BUFFERS TO GET WRITTEN
5878                  PUSHJ P,UFLS
5879                 JRST .+1 ]
5880         MOVE H,QUDPR(A)
5881         MOVE T,MDSK             ;HAS THE DIR BEEN CHANGED AND NOT WRITTEN
5882         MOVE T,DCHBT(T)         ;YET TO THE MASTER DISK?
5883         TDNN T,QSNLCN(H)
5884          JRST POPJ1
5885         MOVSI TT,%QUDWM         ;YES, WRITE IT OUT IMMEDIATELY
5886         IORM TT,QSNLCN(H)       ;AND DON'T RETURN UNTIL IT IS WRITTEN
5887         TDNE T,QSNLCN(H)
5888          PUSHJ P,UFLS
5889         JRST POPJ1
5890 \f
5891 QBRRA1: TLNE T,%QALNK
5892          JRST IOCR10
5893         SKIPGE QSMDN(A)
5894          JRST QBRRA2            ;NO MAIN PRGM BUFFER
5895         MOVE T,QRADAD(A)
5896         SUB T,QFBLNO(A)
5897         JUMPL T,QBRRA2
5898         MOVE Q,T
5899         SUB T,QMPBSZ(A)         ;SIZE OF CURRENT BUFFER
5900         JUMPL T,QBRRA3          ;SAME BLOCK AS NOW
5901 QBRRA2: PUSH P,R
5902         PUSH P,I
5903         PUSH P,C
5904         PUSHJ P,QICLW1          ;STOP THE CHANNEL AND FLUSH CURRENT BUFFERS
5905         MOVE A,D
5906         CLEARM QSBFS(A)         ;FLUSH POSSIBLE EXTRA AOSES WHEN PI HIT EOF
5907         MOVE Q,QRADAD(A)
5908         PUSHJ P,QFNTR
5909          JRST QBRRA5            ;OFF END OF FILE (DIR ALREADY UNLOCKED)
5910         POP P,C
5911         POP P,I
5912         POP P,R
5913         CLEARM QSMPRC(A)
5914         MOVSI Q,%QAMPU
5915         IORM Q,QSRAC(A)         ;SET FLAG TO SET QSMPRP AND QSMPRC ON NEXT BUFFER LOAD
5916         MOVSI Q,%QAEFR+%QAACC   ;CLEAR EOF AND .ACCESS FLAGS
5917         ANDCAM Q,QSRAC(A)
5918         MOVEI Q,%QMRD           ;START READING AGAIN
5919         HRRM Q,QSRAC(A)
5920         JRST QUDULK
5921
5922 QBRRA5: POP P,C
5923         POP P,I
5924         POP P,R
5925         CAME J,Q
5926          JRST IOCER2            ;ACCESS OFF END OF FILE IS ERROR
5927         MOVSI TT,%QAEFR         ;BUT ACCESS TO EXACTLY EOF IS OK
5928         IORM TT,QSRAC(A)        ;IMITATES WHAT QEOF DOES
5929         AOS QSBFS(A)
5930         SETZM QSMPRC(A)         ;AND READS ZERO WORDS
5931         JRST QBRRA4
5932
5933 QBRRA3: SKIPGE TT,QSMDN(A)
5934          JRST QBRRA2
5935         JRST QBWRA7
5936 \f
5937 ;BLKT-SIOKT-CHRKT GET BUFFER ROUTINE FOR WRITE-OVER MODE.
5938 QWOG1:  SKIPGE QSCRW(A) ;FETCH BLOCK WRITEOVER MODE
5939          JRST QWOG2     ;STILL WRITING PREVIOUS ONE, WAIT
5940         MOVEI Q,%QMRD1  ;SWITCH INTO READ MODE
5941         SKIPG QSBFS(A)  ;IF A BUFFER HAS TO BE READ
5942          HRRM Q,QSRAC(A)
5943         SKIPG QSBFS(A)
5944          PUSHJ P,UFLS
5945         POP P,A
5946 ;BLKT-SIOKT-CHRKT GET-BUFFER ROUTINE FOR DISK INPUT.
5947 QSBGB:  MOVSI Q,%QAPAR
5948         TDNE Q,QSRAC(A)
5949          JRST QSBGB2
5950         CONO PI,UTCOFF
5951         HRRZ Q,QBFP(A)
5952         JUMPE Q,[MOVSI J,%QAEFR ;SAID TO BE BUFFERS, BUT NONE THERE
5953                  TDNN J,QSRAC(A)
5954                   BUG           ;SHOULDN'T HAPPEN EXCEPT AT EOF
5955                  JRST QSBGB5 ]
5956         LDB J,[MLO,,MEMBLT(Q)]
5957         HRRM J,QBFP(A)
5958         SKIPN J
5959          SETZM QBFP(A)          ;LAST BLOCK, LIST NOW EMPTY
5960         HRRZ J,MEMPNT(Q)        ;GET SIZE OF BUFFER IN BYTES
5961         MOVEM J,QMPBSZ(A)
5962         LDB TT,[$QAMOD,,QSRAC(A)]
5963         SKIPN TT                ;DONT SOS IF IN WRITE OVER MODE
5964          SOS QSBFS(A)
5965 QSBWG4: MOVE TT,Q
5966         LSH TT,10.              ;RETURN ADDR OF BUFFER
5967         MOVEM Q,QSMDN(A)
5968         CONO PI,UTCON
5969         HLL TT,QSBYTE(A)
5970         MOVSI Q,%QAMPU
5971         TDNN Q,QSRAC(A)
5972          JRST SIOBG2
5973         MOVE Q,QRADAD(A)        ;DIDDLE PNTRS TO TAKE CARE OF RANDOM ACCESS WITHIN BLOCK
5974         SUB Q,QFBLNO(A)         ;DESIRED OFFSET WITHIN BLOCK
5975         SUB J,Q
5976         JUMPL J,IOCER2          ;OFF END OF FILE
5977         JUMPL Q,IOCER2          ;OFF FRONT OF FILE (NEGATIVE .ACCESS PNTR)
5978         PUSH P,J
5979         IDIVI Q,@QSBYTE(A)
5980         ADD TT,Q                ;ADJUST BYTE POINTER
5981         JUMPE J,.+3
5982          IBP TT
5983          SOJG J,.-1
5984         POP P,J
5985         MOVSI Q,%QAMPU          ;NOW IS SAFE TO TURN OFF FLAG
5986         ANDCAM Q,QSRAC(A)
5987         JRST SIOBG2
5988
5989 ;GET-BUFFER DETECTED EOF ON INPUT OR WRITE-OVER.
5990 QSBGB5: CONO PI,UTCON
5991         MOVE Q,QSRAC(A)
5992         TLNE Q,%QALNK
5993          JRST IOCR10
5994         LDB Q,[$QAMOD,,QSRAC(A)]
5995         SOJN Q,POPJ2    ;ON INPUT, SKIP TWICE TO SIGNAL EOF.
5996         PUSHJ P,QLWO    ;LEAVE WRITE OVER MODE
5997         JRST QSBWG      ;START NORMAL WRITE
5998
5999 QWOG2:  SKIPGE QSCRW(A)         ;WAIT FOR WRITE TO FINISH
6000          PUSHJ P,UFLS
6001         JRST POPAJ              ;NOW RECYCLE AND WAIT FOR READ
6002 \f
6003 ;LEAVE WRITE OVER MODE
6004 QLWO:   MOVE H,QUDPR(A)
6005         PUSHJ P,QUDLK
6006         CONO PI,UTCOFF
6007         SETZM QBFP(A)           ;WRITEOVER MODE EXTEND FILE (SWITCH TO NORMAL MODE)
6008         CLEARM QSBFS(A)
6009         SETOM QSCRW(A)
6010         MOVE Q,QSLGL(A)
6011         HRRZM Q,QMPTN(A)        ;STORE BASE TRACK
6012         MOVSI Q,%QAEFR+%QAMWO   ;CLEAR EOF AND WRITEOVER
6013         ANDCAM Q,QSRAC(A)
6014         MOVEI Q,%QMWRT          ;NORMAL WRITE MODE
6015         HRRM Q,QSRAC(A)
6016         CLEARM QMPTC(A)         ;TRACK COUNT FOR TAKE N
6017         SETOM QMTTR(A)          ;NO TRACK RESERVED
6018         SETOM QMFTP(A)          ;GET NEW DECADE RESERVATION
6019         CONO PI,UTCON
6020         MOVE TT,QDIRP(A)        ;SEE IF GARBAGE COLLECTION NEEDED
6021         PUSH P,R
6022         PUSH P,I
6023         PUSHJ P,QMPDC1          ;CONV CHAR ADR TO BYTE PNTR (AND LDB IN R)
6024         POP P,I
6025         SKIPE R
6026          BUG
6027         MOVE R,QDIRP(A)
6028         ADDI R,NXLBYT+2
6029         CAMGE R,@QSNLCN(H)
6030          JRST QLWO1             ;DON'T NEED TO EXPAND F.S.
6031         MOVEI R,LUNBLK(TT)
6032         MOVE Q,QSNLCN(H)
6033         SUBI R,(Q)
6034         CAML R,UDNAMP(Q)
6035          JRST QSBWG7            ;DON'T HAVE ROOM.  GC
6036         MOVEI R,3*6             ;HAVE ROOM
6037         ADDM R,(Q)
6038 QLWO1:
6039 REPEAT NXLBYT+2,[
6040         ILDB R,TT
6041         JUMPN R,QSBWG7
6042 ]
6043         JRST QSBWG8             ;OK
6044
6045 QSBWG7: MOVSI R,%QAFUL          ;NO ROOM, GC BEFORE COMMITTING NEXT TRACK
6046         IORM R,QSRAC(A)
6047 QSBWG8: POP P,R
6048         JRST QUDULK
6049
6050 QSBGB2: ANDCAM Q,QSRAC(A)       ;DISK READ ERROR
6051         JRST IOCER3             ;TELL USER
6052 \f
6053 ;DISK OUTPUT GET-BUFFER ROUTINE.  PRESERVES D FOR BENEFIT OF PDUMP.
6054 QSBWG:  MOVE Q,QSRAC(A)
6055         TLNE Q,%QALNK+%QAACC    ;DON'T WRITE TO LINK, DON'T LET PDUMP GET
6056          JRST IOCR10            ; FAKED OUT BY USE FORCE OR ACCESS
6057         PUSH P,A
6058         TLNE Q,%QAMWO
6059          JRST QWOG1             ;JUMP IF WRITE OVER MODE
6060         HRRZ Q,QBFP(A)          ;NORMAL MODE
6061         JUMPE Q,QSBWG1          ;CAN ALWAYS HAVE ONE BUFFER
6062         MOVE Q,QWBUFS
6063         CAML Q,QWBFMX
6064          JRST POPAJ             ;TOO MANY WRITE BUFFERS QUEUED
6065 QSBWG1: PUSHJ P,QSTWG
6066         PUSHJ P,TCALL
6067           JRST IOMQ
6068          JRST QSBWG5            ;MEM FROZE OR NOT AVAILABLE
6069         MOVE Q,(P)              ;DISK CHNL #
6070         DPB Q,[MNUMB,,MEMBLT(A)]
6071         MOVEI Q,MU23B
6072         DPB Q,[MUR,,MEMBLT(A)]
6073         MOVE Q,A
6074         POP P,A
6075         AOS QSBFS(A)
6076         AOS QWBUFS
6077         HRRZ J,QSBYTE(A)
6078         IMULI J,2000
6079         MOVEM J,QMPBSZ(A)       ;FRESH BLOCK SIZE
6080         JRST QSBWG4
6081
6082 QSTWG:  MOVSI Q,%QAFUL
6083         TDNE Q,QSRAC(A)         ;ROUTINE TO COMMIT A TRACK
6084          JRST QSTWG1            ;DIR FULL, NEED GC BEFORE GROWING FILE
6085         MOVE H,QUDPR(A)         ;IF THIS DIRECTORY HAS AN ALLOCATION
6086         MOVE Q,QSNLCN(H)        ; ENFORCE IT
6087 IFN QRSRVP,[
6088         HRRZ J,UDALLO(Q)
6089         JUMPE J,QSTWG0          ;NO ALLOCATION
6090         HRRZ H,UDBLKS(Q)        ;GET BLOCKS USED
6091         CAML H,J
6092          JRST IOCR13            ;HAS ALLOCATION AND USER IS TRYING TO EXCEED IT
6093 ]
6094 QSTWG0: MOVE J,QDSKN(A)
6095         SOSL QSFT(J)            ;RESERVE A TRACK
6096          POPJ P,
6097         AOS QSFT(J)             ;DISK FULL, GIVE BACK THE TRACK
6098         SKIPE QFBTS             ;WAIT FOR ANY PENDING FILE DELETIONS
6099          PUSHJ P,UFLS           ; TO COMPLETE AND FREE THEIR BLOCKS
6100         SOSL QSFT(J)            ;GOT SPACE NOW?
6101          POPJ P,
6102         AOS QSFT(J)             ;NO, GIVE UP AND ERR OUT
6103         JRST IOCER9
6104
6105 QSTWG1: MOVE H,QUDPR(A)
6106         PUSHJ P,QUDLK
6107         PUSHJ P,QGC
6108          JRST IOCR12            ;DIR FULL
6109         PUSHJ P,QUDULK
6110         ANDCAM Q,QSRAC(A) .SEE %QAFUL
6111         JRST QSTWG
6112
6113 QSBWG5: POP P,A                 ;GET BACK QSK CHANNEL #
6114         MOVE J,QDSKN(A)
6115         AOS QSFT(J)             ;NO MEMORY; GIVE EVERYTHING BACK
6116         POPJ P,
6117 \f
6118 ;DISK OUTPUT RELEASE-BUFFER ROUTINE FOR BLKT, SIOKT, CHRKT.
6119 QSBWW:  SKIPGE QSMDN(A)         ;WRITE BUFFER FROM MN PROG TO CHAIN FOR PI
6120          POPJ P,                ;NO WRITE BUFFER ACTIVE
6121         LDB TT,[$QAMOD,,QSRAC(A)]
6122         SOJE TT,QSBWO1          ;WRITE OVER MODE
6123         SKIPL D,QMTTR(A)
6124          JRST QTG1              ;TRACK ALREADY RESERVED
6125         PUSH P,I
6126         MOVE I,QDSKN(A)
6127         PUSHJ P,QGTRK           ;GET A TRACK
6128         POP P,I
6129         MOVEM D,QMTTR(A)
6130 QTG1:   MOVE H,QUDPR(A)         ;TRACK IN D
6131         PUSHJ P,QUDLK
6132         MOVE TT,QSNLCN(H)
6133         AOS UDBLKS(TT)
6134         MOVE TT,QMPTN(A)        ;GET PREVIOUS TRACK#
6135         CAIN D,1(TT)
6136          JRST QTG2              ;THIS TRACK IS CONSECUTIVE
6137         SKIPN QMPTC(A)          ;THIS TRACK NOT CONSEC CHECK COUNT OF PREV CONSEC BLOCKS
6138          JRST QTG3
6139         PUSH P,D                ;NON-ZERO SO STORE IN USER DIRECTORY
6140         MOVE D,QMPTC(A)
6141         CLEARM QMPTC(A)
6142         PUSHJ P,QUDS
6143         POP P,D
6144 QTG3:   MOVE J,QMTTR(A)         ;DESCRIPTOR WILL BE STORED
6145         MOVEM J,QMPTN(A)
6146         SUB D,QMPTN(A)          ;CAN TRACK BE SKIPPED TO?
6147         SOJL D,QTG4             ;CAN'T BE SKIPPED TO (NOTE QMPTN HAS NOT BEEN AOS'D)
6148         CAILE D,UDWPH-UDTKMX-1
6149          JRST QTG4              ;ALSO NO
6150         ADDI D,UDTKMX           ;NEXT BLOCK WITHIN N
6151         PUSHJ P,QUDS            ;STORE APPROPRIATE SKIP
6152 QTG5A:
6153 QTG5:   MOVE Q,QSMDN(A)         ;CORE BLOCK NUM BEING WRITTEN
6154         MOVE D,QMPTN(A)         ;TRACK NUM OF BLOCK ADDING TO FILE
6155         HRLZM D,MEMPNT(Q)       ;STORE TRACK NUM
6156         SETOM QMTTR(A)          ;INDICATE TRACK USED
6157         MOVE J,QMPBSZ(A)        ;LENGTH OF THIS BLOCK
6158         ADDM J,QFBLNO(A)        ;INCR BYTE ADR OF START OF CURRENT BLOCK IN FILE
6159         HRRM J,MEMPNT(Q)        ;SAVE BYTE COUNT
6160         PUSH P,R
6161         IDIVI J,@QSBYTE(A)      ;CONVERT TO WORD COUNT
6162         JUMPE R,QTG7            ;EXACT MULTIPLE OF WORD
6163         AOS J
6164         MOVNS R
6165         ADDI R,@QSBYTE(A)       ;# BYTES RESIDUE IN LAST WORD
6166 QTG7:   DPB J,[MWC,,MEMBLT(Q)]  ;STORE ACTIVE WORD COUNT
6167         MOVE D,QSRAC(A)
6168         LDB TT,[$QAMOD,,QSRAC(A)]
6169         TLNN D,%QALBK           ;LAST BLOCK OF WRITE OVER POSSIBLY
6170          SOJE TT,QTG6           ;WRITEOVER MODE AND NOT LAST BLOCK, DONT UPDATE LAST BLOCK WORD COUNT
6171         MOVE H,QUDPR(A)         ;SET UP DIRECTORY CHANNEL
6172         MOVE D,QUDFPR(A)
6173         ADD D,QSNLCN(H)
6174         DPB J,[UNWRDC+UNRNDM(D)] ;SET WORD COUNT OF LAST BLOCK
6175         LDB Q,[QSBSIZ(A)]
6176         PUSHJ P,QBENC           ;ENCODE BYTE CRUFT
6177         DPB Q,[UNBYTE+UNREF(D)]
6178         MOVE J,QACTB
6179         IORM J,QSNLCN(H)
6180 QTG6:   POP P,R
6181         PUSHJ P,QUDULK
6182         MOVE Q,QSMDN(A)
6183         MOVEI J,.BM MLO
6184         ANDCAM J,MEMBLT(Q)      ;SET END OF LIST INDICATOR IN MEMORY BLOCK
6185         CONO PI,UTCOFF
6186         HLRZ J,QBFP(A)          ;STORE MEMORY BLOCK IN OUTPUT LIST
6187         JUMPE J,QSBWW1
6188         DPB Q,[MLO,,MEMBLT(J)]
6189 QSBWW2: HRLM Q,QBFP(A)
6190         CONO PI,UTCON
6191         SETOM QSMDN(A)          ;MN PROG BUFFER NOW WRITTEN
6192         JRST QSTRTR             ;START ACTION IF 2311 IDLE AND RETURN
6193 \f
6194 QSBWO1: MOVE Q,QSRAC(A)         ;PUT BUFFER IN WRITE-OVER MODE
6195         TLNE Q,%QALBK           ;IF NOT HACKING LAST BLOCK
6196          TLNE Q,%QAEFW          ;OR HACKING CLOSE
6197           JRST QSBWO2           ;THEN JUST WRITE IT
6198         HRRZ D,QSBYTE(A)
6199         IMULI D,2000
6200         SUB D,QMPBSZ(A)
6201         JUMPE D,QSBWO2          ;BLOCK REALLY FULL
6202         TLNE Q,%QAMPU           ;DID WE IOCER2 AT QSBWG4?
6203          JRST IOCER2            ;YES, QSMPRP NOT SET UP, DON'T WRITE ANYTHING
6204         MOVEM D,QSMPRC(A)       ;LAST BLOCK NOT REALLY USED UP ("SPRUNG BACK TO LIFE")
6205         ADDM D,QMPBSZ(A)        ;EXTRA ROOM IN LAST BLOCK TO FILL UP
6206         MOVSI D,%QAWOV
6207         IORM D,QSRAC(A)         ;FILLING LAST BLK PAST ORIG EOF
6208         POPJ P,                 ;FINISH OUT BLOCK
6209
6210 QSBWO2: MOVSI D,%QAWOV
6211         ANDCAM D,QSRAC(A)
6212         MOVE D,QSLGL(A)         ;WRITE TRACK BACK WHERE IT CAME FROM
6213         MOVEM D,QMPTN(A)        ;PUT TRACK NO WHERE QTG5 CAN FIND IT
6214         MOVE H,QUDPR(A)
6215         PUSHJ P,QUDLK
6216         SETOM QSCRW(A)          ;SWITCH TO WRITE MODE
6217         MOVEI Q,%QMWOV
6218         HRRM Q,QSRAC(A)
6219         JRST QTG5
6220
6221
6222 QTG4:   LDB D,[140500,,QMTTR(A)] ;WRITE LOAD ADDRESS
6223         IORI D,40
6224         PUSHJ P,QUDS
6225         LDB D,[060600,,QMTTR(A)]
6226         PUSHJ P,QUDS
6227         LDB D,[0600,,QMTTR(A)]
6228         PUSHJ P,QUDS
6229         JRST QTG5A
6230 \f
6231 QGTRK:  PUSHJ P,QTLOCK          ;GET TRK CHNL IN A DSK IN I RET IN D CLOBBERS E,TT,Q,J,B
6232 QGTK4:  PUSH P,R                ;ENTER HERE FROM SWAP OUT WITH UTCOFF
6233         PUSH P,B
6234         PUSH P,E
6235         HRRZ R,QTUTO(I)
6236 QGTK4A: SKIPGE Q,QMFTP(A)
6237          JRST QGTK3A            ;FIRST TRACK
6238         IDIVI Q,DECADE
6239         HRREI J,-DECADE(J)      ;COMPUTE TRACKS REMAINING IN DECADE
6240         MOVE D,QMFTP(A)
6241         PUSHJ P,TUTPNT
6242         ADD D,[TUTBYT_14,,]     ;MAKE INTO ILDB-TYPE POINTER
6243         MOVE TT,QMFTP(A)
6244         EXCH D,TT
6245 QGTK3:  CAML D,QLASTB(R)
6246          JRST QGTK3A            ;REACHED END OF DISK
6247         ILDB Q,TT
6248         JUMPE Q,QGTK2
6249         AOJGE J,QGTK3A          ;DECADE OUT
6250         AOJA D,QGTK3
6251
6252 QGTK3A: CAILE A,NQCHN
6253          JRST QGTK3C            ;SWAP CHANNEL
6254 QGTK3D: MOVEI Q,DECADE
6255         ADDB Q,QTUTP(R)
6256 QGTK3B: MOVEM Q,QMFTP(A)
6257         CAMGE Q,QLASTB(R)
6258          JRST QGTK4A
6259         MOVE Q,QSWAPA(R)        ;REACHED END OF DSK, RESET TO END OF SWAPPING AREA
6260         ADDI Q,DECADE-1         ;ROUND UP TO A MULTIPLE OF A DECADE
6261         IDIVI Q,DECADE
6262         IMULI Q,DECADE
6263         MOVEM Q,QTUTP(R)
6264         JRST QGTK3B
6265
6266 QGTK2:  MOVEI B,1
6267         DPB B,TT
6268         MOVEM D,QMFTP(A)
6269         MOVE J,DCHBT(I)
6270         IORM J,QTUTO(I)
6271         POP P,E
6272         POP P,B
6273         POP P,R
6274         CAILE A,NQCHN
6275          POPJ P,                ;CALLED FROM SWAP OUT
6276         JRST QTULK
6277
6278 QGTK3C: CAML D,QSWAPA(R)
6279          JRST QGTK3D            ;IN NON-SWAP AREA
6280         AOS D
6281         CAMN D,QSWAPA(R)
6282          MOVEI D,NUDSL
6283         MOVEM D,QMFTP(A)
6284         JRST QGTK4A
6285 \f;STORE CHR IN D CHNL IN A USER DIR PNTR IN H
6286 ;CANNOT PCLSR NOR GC
6287
6288 QUDS:   PUSH P,I
6289         PUSH P,Q
6290         MOVE I,QDIRP(A)
6291         CAIGE I,2000*UFDBPW
6292         CAML I,@QSNLCN(H)       ;UDESCP
6293          BUG                    ;WRITING ABOVE F.S. PNTR?
6294         AOS QDIRP(A)
6295         IDIVI I,UFDBPW
6296         MOVE Q,QBTBL(Q)
6297         ADD Q,I
6298         SKIPL I,QSNLCN(H)
6299          BUG                    ;UFD WAS NOT LOCKED
6300         ADDI Q,UDDESC(I)
6301         LDB I,Q
6302         CAIE I,UDWPH            ;OK TO CLOBBER UDWPH (NORMALLY DOES AT START OF FILE)
6303          JUMPN I,[JRST 4,.]     ;ABOUT TO CLOBBER SOMETHING IN UFD
6304         DPB D,Q
6305         ILDB I,Q                ;MAKE SURE FILE DESC WILL ALWAYS BE FOLLOWED BY ZERO
6306         SKIPE I
6307          BUG
6308 REPEAT NXLBYT+2,[               ;MAKE SURE THERE'S ROOM FOR ONE MORE TRACK
6309         ILDB I,Q
6310         JUMPN I,QUDS1
6311 ]
6312         MOVE I,QDIRP(A)
6313         ADDI I,NXLBYT+2
6314         CAMGE I,@QSNLCN(H)      ;UDESCP
6315          JRST QUDSX             ;DESC AREA NOT COLLIDING WITH LIM OF DESC SPACE
6316         MOVEI Q,LUNBLK(Q)
6317         MOVE I,QSNLCN(H)
6318         SUBI Q,(I)
6319         CAML Q,UDNAMP(I)
6320          JRST QUDS1             ;NO ROOM.
6321         MOVEI Q,3*UFDBPW        ;EXPAND DESC AREA
6322         ADDM Q,UDESCP(I)
6323         JRST QUDSX
6324
6325 QUDS1:  MOVSI Q,%QAFUL          ;NEED GC BEFORE STARTING ON NEXT TRACK
6326         IORM Q,QSRAC(A)
6327 QUDSX:  MOVE Q,QACTB
6328         IORM Q,QSNLCN(H)        ;SET DIRECTORY CHANGED
6329         POP P,Q
6330         POP P,I
6331         POPJ P,
6332
6333 QSBWW1: HRRM Q,QBFP(A)
6334         JRST QSBWW2
6335
6336 QSBRB1: MOVE A,D
6337 QSBRB:  PUSH P,A
6338         SKIPGE A,QSMDN(A)
6339          JRST POPAJ
6340         PUSHJ P,MEMR
6341         POP P,A
6342         HRRZ TT,QMPBSZ(A)
6343         ADDM TT,QFBLNO(A)       ;INCREMENT BYTE ADR IN FILE OF BEG OF NEXT BLOCK
6344         SETOM QSMDN(A)
6345         JRST QSTRTR
6346
6347 QTG2:   MOVE J,QMTTR(A)         ;INDICATE WE WILL STORE DESCRIPTOR FOR NEXT TRACK.
6348         MOVEM J,QMPTN(A)
6349         AOS D,QMPTC(A)          ;NEXT BLOCK IS CONSECUTIVE
6350         CAIGE D,UDTKMX
6351          JRST QTG5A
6352         SETZM QMPTC(A)          ;MAX # CONSECUTIVE BLOCKS, STORE DESC NOW
6353         PUSHJ P,QUDS
6354         JRST QTG5A
6355 \f
6356 SUBTTL  DIRHNG DEVICE
6357
6358 ;WHENEVER THE DIRECTORY SPECIFIED AS THE SNAME WHEN DIRHNG IS OPENED
6359 ;IS MODIFIED, YOU GET AN INTERRUPT ON THE DIRHNG DEVICE CHANNEL.
6360
6361 ;HERE TO OPEN THE DIRHNG DEVICE.  IOCHNM ADDR IN R, SNAME IN USYSN1(U).
6362 DIRHO:  MOVE C,USYSN1(U)
6363         PUSHJ P,QFL     ;LOOK UP THIS DIRECTORY
6364          JRST OPNL20    ;CALL FAILS IF DIRECTORY DOES NOT EXIST.
6365         HRRZM J,IOCHST-IOCHNM(R)        ;DIR EXISTS;  STORE TRACK NUMBER IN IOCHST.
6366 DIRHP1: CONO PI,CLKOFF
6367         HLLZ A,DIRHNG   ;ADD THIS CHANNEL'S IOCHNM TO THE LIST OF DIRHNG CHANNELS.
6368         HRRI A,DNDIRH
6369         MOVEM A,(R)     ;SET UP THE IOCHNM WITH IOTTB INDEX AND LIST CHAIN.
6370         HRLZM R,DIRHNG
6371         JRST CLKOJ1
6372
6373 ;CLOSE A DIRHNG DEVICE CHANNEL.
6374 DIRHCL: PUSHJ P,DIRHPS  ;REMOVE IT FROM THE LIST, AND
6375         SETZM (R)       ;MARK IT CLOSED.
6376         POPJ P,
6377
6378 ;IOPUSH A DIRHNG DEVICE CHANNEL.  REMOVE IT FROM THE LIST OF ALL SUCH.
6379 DIRHPS: MOVEI A,DIRHNG
6380         CONO PI,CLKOFF
6381 ;FIND THE PLACE THAT POINTS AT THIS IOCHNM WORD.
6382 DIRHC1: HLRZ B,(A)
6383         CAIN B,(R)
6384          JRST DIRHC2
6385         SKIPN A,B       ;END OF LIST REACHED =>
6386          BUG            ;THIS IOCHNM ISN'T IN THE LIST.  BUT IT IS SUPPOSED TO BE!
6387         JRST DIRHC1
6388
6389 ;A POINTS AT IOCHNM THAT POINTS AT THIS ONE.  PATCH THIS ONE OUT OF LIST.
6390 DIRHC2: HLRZ B,(B)      ;THE ONE AFTER THIS ONE
6391         HRLM B,(A)
6392         JRST CLKONJ
6393
6394 ;IOPUSH OR IOPOP THE DIRHNG CHANNEL WITH R -> IOCHNM WORD.  I SAYS WHICH OPERATION.
6395 DIRHIP: JUMPE I,DIRHPS  ;IOPUSH REMOVES CHANNEL FROM LIST OF ALL DIRHNG CHANNELS.
6396
6397 ;IOPOP A DIRHNG DEVICE CHANNEL.  JUST LIKE OPENING IT EXCEPT THAT
6398 ;THE DIRECTORY TRACK NUMBER IS ALREADY IN THE IOCHST.
6399 ;ALSO, WE SHOULD GIVE AN INTERRUPT NOW,
6400 ;IN CASE THE DIRECTORY WAS WRITTEN IN WHILE THE CHANNEL WAS PUSHED.
6401 DIRHPP: PUSHJ P,DIRHP1          ;FIRST, REOPEN THE CHANNEL.  LINK IT INTO THE DIRHNG LIST.
6402          BUG
6403         MOVE A,R
6404         SUBI A,IOCHNM(U)        ;COMPUTE CHANNEL NUMBER FROM IOCHNM WORD ADDRESS.
6405         MOVE A,CHNBIT(A)        ;GET BIT CORRESPONDING TO CHANNEL.
6406         AND A,MSKST2(U)         ;GIVE THE INT IF THE INT IS ENABLED.
6407         IORM A,IFPIR(U)
6408         POPJ P,
6409
6410 ;HERE WITH A/ DIRECTORY'S TRACK NUMBER (AS RETURNED BY QFL)
6411 ;TO SIGNAL A WRITE IN THAT DIRECTORY TO ALL DIRHNG DEVICES THAT ARE LOOKING.
6412 ;CLOBBERS B, C, D.
6413 DIRSIG: CONO PI,CLKOFF
6414         MOVEI B,DIRHNG
6415 DIRSI0: HLRZ B,(B)      ;GET IOCHNM ADDR OF NEXT DIRHNG DEVICE.
6416         JUMPE B,CLKONJ
6417         HRRZ C,IOCHST-IOCHNM(B)
6418         CAIE C,(A)      ;DOES IT LOOK AT THIS DIRECTORY?
6419          JRST DIRSI0
6420         MOVEI C,-IOCHNM(B)      ;YES => FIGURE OUT USER INDEX OF JOB IT BELONGS TO.
6421         IDIVI C,LUBLK
6422         IMULI C,LUBLK   ;C NOW HAS USER INDEX.
6423         MOVNI D,IOCHNM(C)
6424         ADD D,B         ;D GETS CHANNEL NUMBER
6425         MOVE D,CHNBIT(D)
6426         AND D,MSKST2(C) ;INTERRUPT THE USER ON THAT CHANNEL, IF IT'S ENABLED.
6427         IORM D,IFPIR(C)
6428         JRST DIRSI0