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