system/utape.952

   1 ;;; Copyright (c) 1999 Massachusetts Institute of Technology
   2 ;;;
   3 ;;; This program is free software; you can redistribute it and/or
   4 ;;; modify it under the terms of the GNU General Public License as
   5 ;;; published by the Free Software Foundation; either version 3 of the
   6 ;;; License, or (at your option) any later version.
   7 ;;;
   8 ;;; This program is distributed in the hope that it will be useful,
   9 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11 ;;; General Public License for more details.
  12 ;;;
  13 ;;; You should have received a copy of the GNU General Public License
  14 ;;; along with this program; if not, write to the Free Software
  15 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16
  17 ; I T S UTAPE SERVICE ROUTINE
  18
  19 UTBLKS==3
  20
  21 ;UT CHANNEL STORAGE
  22
  23 EBLK
  24 UTCHNT: ;BEG FOR GETSYS (UTAPE)
  25 UTBFP:  REPEAT NUTIC+NUTOC,400000,,377  ;L H BUFFER LINK PTR (INPUT PI)
  26                 ;RH  "   "  OUTPUT MAIN PROG
  27 UTUSR:          ;USER OR -1 IF FREE (LH)
  28 UTUL:   REPEAT NUTIC+NUTOC,-1   ;LINK TO CHANNEL ON SAME UTAPE OR -1(RH)
  29 UTDIRP: BLOCK NUTIC+NUTOC       ;BYTE POINTER TO UTDIR
  30 UTDBC:  BLOCK NUTIC+NUTOC       ;RH BLCK COUNT CORRESP WITH UTDIRP
  31                 ;L H 3.1 3.5 READ FILE NO  4.9  ERROR  4.5 4.8 ERROR CNT
  32         ;3.6 =0 FORD EXT =1 BACK EXT 3.7 4.2 PUT FILE NO
  33         ;4.4 DELETE ON READ CLOSE
  34 UTBFS:  BLOCK NUTIC+NUTOC       ;BUFFERS IN USE
  35 UTLSTM: BLOCK NUTIC+NUTOC       ; TIME LAST BUF TAKEN BY PROG
  36 UTMBN:  BLOCK NUTIC+NUTOC       ; MN PROG ACTIVE BFFR NO OR -1,IF NO BUFFER ACIVE (LH)
  37 UTRAC:  BLOCK NUTIC+NUTOC+1     ;ACTIVE  BUFFER NO PI  RH
  38                         ;FLAG TO MAIN PROG TP FULL (WRITE) RH
  39                 ;SIGN SET =>CHANNEL LOCKED
  40                 ;4.8 READ EOF REACHED AT PILEVEL OR CHNL CLOSED
  41                 ;EXTRA WORD FOR FILE DIR CHNL
  42                 ;4.7 DONT RELOAD AT PI
  43 UTN1=.-NUTIC+1
  44         BLOCK NUTOC
  45 UTN2=.-NUTIC+1
  46         BLOCK NUTOC     ;NAME OF FILE BEING WRITTEN
  47 UTBKNP=.-NUTIC+1
  48         BLOCK NUTOC
  49 MPRP:   BLOCK NUTIC+NUTOC       ;MAIN PRGM BUFFER PNTR
  50 MPRC:   BLOCK NUTIC+NUTOC       ;CNT REMAINING
  51 UTTNO:  BLOCK NUTOC+NUTIC       ;TAPE NO (RH)
  52                         ;LH CLOSE FLAG WRITE ORG FILE NO READ
  53 UTEOF:  BLOCK NUTIC     ;END OF FILE CHR
  54
  55 UTLDD:  BLOCK NUTIC+NUTOC+1     ;IF -1, DC IS ACTUALLY SET UP AND TRANSFER CAN
  56                                 ;BE EXPECTED IN LESS TAH 100 MS.
  57                                 ;IF D CHANNEL LOCKED FLAG(4.9 UTRAC) WELL BE CHECKED
  58                                 ;BEFORE GOING TO THE -1 STATE
  59                                 ;EXTRA WORD FOR DIR CHNL
  60 UTDERR: BLOCK NUTIC+NUTOC+1     ;4.9 ERROR 4.8 ABORT 4.7 UTAPE FULL
  61
  62 NUTCA:  0       ;NUMBER UTAPE CHANNELS ACTIVE
  63 NUWCA:  0       ;# WRITE CHNLS ACT
  64
  65 UPCHFS: 0       ;FAIR SHARE BFS PER CHNL
  66
  67 LUTWBF==40              ;LENGTH OF BLK # PASSING LIST
  68 UTWBF:  REPEAT LUTWBF,.+1       ;LIST FOR PASSING BLK NOS FROM M.P. TO PI ON WRITE (INIT FS)
  69         0               ;TERMINATOR FOR FS LIST
  70 UTWBFS: UTWBF           ;FS PNTR
  71
  72 IFNDEF MXUTBF,MXUTBF==40 ;MAX BUFFERS FOR AN INPUT CHANNEL.
  73 \f
  74 ;TABLE AREAS
  75
  76 DEFINE TAG A
  77 IRPS TAGX,,A
  78 BBLK
  79 TAGX:   0
  80 EBLK
  81 TERMIN
  82 TERMIN
  83
  84 UTCH:   ;BEG FOR GETSYS (UTAPE)
  85 TAG ULCTM:,     REPEAT NUNITS,-1        ;LAST TIME EUPOS RECOMPUTED
  86         ;IF DG2=0.E. 0 THEN ACT POS =EUPOS+<TIME-ULCTM>*UDIR
  87 TAG DRTM:,      REPEAT NUNITS,177777,,-1        ;177777,,-1 => NO TIMING OP
  88                         ;N => DEAD RECKON UNTIL T=N
  89
  90 TAG UDIR:,      BLOCK NUNITS    ;0=>STOP -1=>BACK 1=>FORW
  91 IFN NEWDTP,     TAG OUDIR:,     BLOCK NUNITS    ;DIR OF LAST OP
  92 TAG UGOAL:,     REPEAT NUNITS,-1;POSIT GOAL OR -1 IF UNIT FREE
  93 TAG EUPOS:,     BLOCK NUNITS    ;ESTIMATED UNIT POSITION
  94                         ;SEE ULCTM IF DGW .NE. 1
  95 TAG DCHNT:,     REPEAT NUNITS,-1;HEAD CHANNEL LIST OF UT OR -1 IF NO CHN ACT
  96 TAG UMEMAD:,    IFE NEWDTP,REPEAT NUNITS, BLKO DC,      ;GOAL MEMADR-1
  97                 IFN NEWDTP,REPEAT NUNITS,BLKO DTC,
  98 TAG URDWR:,     BLOCK NUNITS    ;0 READ -1 WRITE(LOADED OPERATION)
  99 TAG DG2:,       REPEAT NUNITS,-1;+ => ACCURATE
 100                         ;0 => EUPOS FAIRLY ACCURATE
 101                         ;-1 => DO NOT DEAD RECKON WITHOUT UTC
 102 TAG UTASS:,     REPEAT NUNITS,0 ;0 IF NOT ASSIGNED, SYSTEM NAME IF ASSIGNED
 103 TAG UDIRO:,     REPEAT NUNITS,-1;ORGIN OF DIRECTORY
 104 ;OR -1 DIR NOT LOADED OR 4.9 DIR LOCKED OR 4.8+4.9 DIR DOUB LOCKED
 105 ;4.7 DIR CHANGED
 106 ;IF DIR LOCKED, IT MAY BE REFERENCED BUT NOT CHANGED
 107 ;4.5=0 => DIR AT LEAST ON WAY IN
 108 ;4.4=1 => TAPE IN UBLAT MODE
 109
 110
 111 TAG UFLAPF:,    BLOCK NUNITS    ;4.9 FLAPPING RQSTED OR IN PROGRESS
 112                         ;4.8 RQ TO ABORT FLAPPING
 113                         ;4.7 DRIVE ACTUALLY ON THE WAY
 114                         ;4.6 (TD10 ONLY) 0 PHASE 1 STOP   1 PHASE 1 STOP DONE
 115                         ;RH TIME TO STOP AFTER FLAPPED
 116
 117 TAG ULDCH:,     BLOCK NUNITS    ;NUMBER OF LOADED CHANNEL IN LH
 118                                 ;BUFFER NO OF DIR (INDEX INTO IOBFT) IN RH
 119                         ;LH 4.9 = LOW PRIORITY POSIT
 120
 121
 122 TAG UDPWF:,     REPEAT NUNITS,-1        ;DIRECTORY PAWED OVER FLAG
 123
 124 TAG UMNFB:,     BLOCK NUNITS    ;MAIN PRGM FREE BLOCKS ON TAPE
 125
 126 TAG UTERP:,     BLOCK NUNITS    ;LH ERROR CODE (CONI UTS,) RH # ERRORS
 127
 128 TAG UMNTR:,     BLOCK NUNITS    ;UNAME OF LAST JOB TO READ IN DIRECTORY
 129 \f
 130 SUNIT:  0       ;SELECTED UNIT OR 0
 131 IFE NEWDTP,     SUNITL: 0       ;SAME _ 3
 132 SMODE:  -1      ;-1 POSIT 0 DATA
 133 UIDLE:  -1      ;-1 UTAPES COMPLETELY IDLE
 134
 135 IFN NEWDTP,     CUINT:  0       ;-1 CLK HAS CAUSED BREAK
 136 WRITE:  0       ;0 READ -1 WRITE
 137 TAPCNT: 0
 138 TAP1:   0
 139 TAP2:   0
 140 TAP3:   0
 141 UTTM1:  0       ;UNIT COULD START IN SEARCH LOOP
 142 UTTM2:  0       ;MOST PRESSING UNIT SO FAR
 143 UTTM3:  0       ;TIME FOR ABOVE OR -1 IF NONEî
 144 UTTM4:  0       ;TAPE TO START FLAPPING (FLAG FLAP IN PROG IF NEWDTP=1)
 145 IFE NEWDTP,[
 146 UTTM5:  0       ;TAPE TO STOP FLAPPING
 147 FLPUNT: 0
 148 ]
 149 UTENB:  0
 150 LUTOTM: 0       ;TIME OF LAST UT OPER
 151 UTHERR: 0       ;UT HANGUP ERR
 152 USTSW:  0       ;UT START SWITCH
 153 UDCC:   0       ;-1 IF UTAPE HAVE DC FOR BLK CYCLE
 154 UTCHE==.-1      ;END FOR GETSYS (UTAPE)
 155
 156 BBLK
 157
 158 ;UTAPE CONTINUOUS NON-FILE IO
 159
 160 AUBL2:  CONO PI,UTCON   ;DIRECTORY LOCKED, MAYBE ITS BEING FLAPPED
 161         PUSHJ P,UDELAY
 162 AUBLAT: XCTR XRW,[SKIPLE I,(J)] ;GET TAPE NUM, C(AC), SKIP IF NEG OR ZERO
 163         CAIG I,NUNITS   ;SKIP IF TOO BIG
 164          PUSHJ P,UTSNMK ;DON'T ALLOW UTAPE HACKERY UNLESS ASSIGNED
 165           POPJ P,       ;ERR EXIT, BAD TAPE NUM
 166         CONO PI,UTCOFF
 167         MOVE B,UDIRO(I)
 168         AOJE B,AUBL1    ;DIR NOT IN
 169         TLNN B,10000
 170         JRST UTCONJ     ;NOT IN UBLAT MODE
 171         JUMPL B,AUBL2
 172 AUBL1:  MOVSI B,10000
 173         MOVEM B,UDIRO(I)
 174         CONO PI,UTCON
 175         JRST POPJ1
 176
 177 ;.ASSIGN - ASSIGN A DECTAPE UNIT.
 178 AASSIGN:XCTR XR,[MOVE I,(J)]
 179         CAILE I,NUNITS
 180          POPJ P,
 181         JUMPLE I,CPOPJ
 182         MOVE A,UNAME(U)
 183         CONO PI,CLKOFF
 184         CAMN A,UTASS(I)
 185          JRST CLKOJ1
 186         SKIPE UTASS(I)
 187          JRST CLKONJ
 188         MOVEM A,UTASS(I)
 189         JRST CLKOJ1
 190
 191 ADESIGN:XCTR XR,[MOVE I,(J)]    ;DEASSIGN UTAPE
 192         CAILE I,NUNITS
 193         POPJ P,
 194         JUMPLE I,CPOPJ
 195         SKIPN A,UTASS(I)
 196         JRST POPJ1
 197         CAME A,UNAME(U)
 198         POPJ P,
 199         SETZM UTASS(I)
 200         JRST POPJ1
 201 \f
 202 ;SET UTAPE NAME ;.UTNAM AC,     ;LH(AC)=6BIT NAME, RH(AC)=TAPE #
 203
 204 AUTNAM: XCTR XR,[MOVE Q,(J)]
 205         HRRZ I,Q        ;GET TAPE #
 206         JUMPE I,CPOPJ   ;TOO SMALL
 207         CAIG I,NUNITS   ;TOO LARGE?
 208          PUSHJ P,UTSNMK ;ASSIGNED TO SOMEONE ELSE?
 209           POPJ P,       ;YES, LOSE
 210         TLO D,1         ;SET FLAG TO EXIT FROM OPEN ROUTINE
 211         PUSHJ P,UTO0    ;GET DIR IN CORE, LOCK, ETC.
 212         TLNE TT,210000  ;CHECK FOR DIRECTORY NOT READ IN, UBLAT MODE
 213          JRST LSWPOP    ;JUMP ON LOSSAGE
 214         HLRZ A,Q        ;GET TAPE NAME
 215         AOSN UDPWF(I)   ;DIRECTORY PAWED OVER YET?
 216          PUSHJ P,UDPW   ;NO, GO DO IT
 217         MOVE J,UDIRO(I) ;GET POINTER TO DIR
 218         XOR A,177(J)    ;GET DIFF BETWEEN OLD & NEW NAMES
 219         TRNN A,-1       ;IS THERE ANY?
 220          JRST AUTN2     ;NO, SKIP SOME CRUFT
 221         TLZ A,-1        ;IGNORE DIFFERENCES IN LH
 222         XORM A,177(J)   ;MODIFY NAME TO NEW NAME
 223         TLO J,100000    ;SET DIR CHANGED BIT
 224 AUTN2:  MOVEM J,UDIRO(I)        ;STORE MODIFIED POINTER
 225         JRST LSWPJ1
 226
 227 UDPW:   HRRZ J,UDIRO(I)
 228         MOVEI TT,37
 229         DPB TT,[370500,,177(J)]
 230         ADD J,[500,,23.*2-1]
 231         MOVEI TT,0
 232 UDPW2:  ILDB Q,J
 233         SKIPN Q
 234          AOS TT
 235         CAIE Q,37
 236          JRST UDPW2
 237         MOVEM TT,UMNFB(I)
 238         POPJ P,
 239
 240 ;INITIALIZE UTAPE DIRECTORY     ;.UINIT AC,     ;C(AC)=TAPE #
 241 ;TAPE MUST BE ASSIGNED
 242
 243 AUINIT: XCTR XRW,[SKIPLE I,(J)] ;TAPE # TOO LOW?
 244          CAILE I,NUNITS ;OR HIGH?
 245           POPJ P,       ;YES
 246         PUSHJ P,UTSNMK  ;OR NOT ASSIGNED TO THIS USER
 247          POPJ P,
 248         TLO D,1         ;SET EXIT FLAG FOR OPEN ROUTINE
 249         PUSHJ P,UTO0    ;GET DIR, LOCK IT, ETC.
 250         TLNE TT,210000  ;CHECK FOR UBLAT MODE, DIRECTORY NOT READ (TT=UDIRO(I))
 251          JRST LSWPOP
 252         SETZM (TT)      ;CLEAR FIRST LOC
 253         HRLI A,(TT)     ;SET UP LH OF BLT POINTER
 254         HRRI A,1(TT)    ;& RH
 255         BLT A,177(TT)   ;ZAP
 256         MOVE A,[757367573674]   ;GET WORD OF 7 5-BIT BYTES VALUE 36
 257         MOVEM A,56(TT)  ;INDICATE FIRST 7 BLOCKS RESERVED
 258         MOVSI A,660000  ;ONE 5-BIT BYTE, VALUE 33
 259         MOVEM A,67(TT)  ;MARK FILE DIRECTORY BLOCK
 260         HRROS 177(TT)   ;MARK END OF DIR
 261         SETZM UDPWF(I)  ;INDICATE DIR PAWED OVER
 262         MOVEI A,559.    ;# OF FREE BLOCKS IN EMPTY TAPE
 263         MOVEM A,UMNFB(I)        ;STORE FOR FUTURE REFERENCE
 264         TLO TT,100000   ;INDICATE CHANGED
 265         MOVEM TT,UDIRO(I)       ;UPDATE POINTER
 266         JRST LSWPJ1
 267 \f
 268 ;UTAPE DISMOUNT
 269
 270 AUDISM: XCTR XRW,[MOVE A,(J)]   ;OPER 22
 271 NFLAP:  JUMPLE A,CPOPJ
 272         CAILE A,NUNITS
 273         POPJ P,
 274         MOVSI C,-NUTIC-NUTOC
 275         CONO PI,UTCOFF
 276 AUTDM1: SKIPGE UTUSR(C)
 277         JRST AUTDM2
 278         HRRZ D,UTTNO(C)
 279         CAMN A,D
 280         JRST UTCONJ     ;SOME ONE USING TAPE
 281 AUTDM2: AOBJN C,AUTDM1
 282         CONO PI,UTCON
 283         MOVSI C,(SETZ)
 284         IORM C,UFLAPF(A)
 285         JRST POPJ1
 286
 287 ;ATTEMPTED DIRECTORY READ GOT FLUSHED
 288 UTOLOS: TLNE D,1        ;CHECK EXIT FLAG
 289         JRST NULSET     ;NOT .OPEN, SEIZE NOTHING AND RETURN
 290         JRST OPNL7      ;.OPEN, SIGNAL DEVICE NOT READY
 291
 292 UTOF1:  MOVSI TT,200000
 293         IORM TT,UFLAPF(I)       ;RQEST ABORT OF FLAP
 294         CONO PI,UTCON
 295         SKIPGE UFLAPF(I)
 296         PUSHJ P,UFLS    ;HOPE FOR BEST
 297 UTO:    PUSHJ P,UTSNMK  ;MUST BE ASSIGNED
 298          JRST NCA
 299         JUMPE I,OPNL1   ;UTAPE OPEN
 300         CAILE I,NUNITS
 301         JRST OPNL1
 302 UTO0:   CONO PI,UTCOFF
 303         SKIPGE UFLAPF(I)
 304         JRST UTOF1      ;FLAPPING IN PROGRESS
 305         SKIPGE TT,UDIRO(I)
 306         AOSE TT
 307         JRST UTO4       ;FILE DIR IN OR ON THE WAY
 308         MOVEI TT,200000
 309         MOVEM TT,DCHNT(I)
 310         MOVE TT,UNAME(U)
 311         MOVEM TT,UMNTR(I)       ;TELL WHO FIRST CAUSED DIR TO BE READ IN
 312         MOVSI TT,20000
 313         ANDCAM TT,UDIRO(I)
 314 UTO4:   CONO PI,UTCON
 315         MOVSI TT,400000
 316         MOVNI T,1
 317         PUSHJ P,LWAIT
 318         CAMLE T,UDIRO(I)        ;WAIT FOR DIRECTORY TO COME IN OR GO OUT
 319         IORB TT,UDIRO(I)        ;IF IN THEN LOCK IT
 320         CONO PI,UTCON
 321         CAMN TT,[-1]
 322         JRST UTOLOS     ;DIDN'T GET READ IN
 323         PUSHJ P,SGNSET  ;MAKE SUURE DIRECTORY GETS UNLOCKED ON PCLSR
 324         UDIRO(I)
 325         TLNE D,1        ;CHECK SPECIAL EXIT FLAG
 326         POPJ P,         ;EXIT
 327         TLNE TT,10000
 328         JRST UTOBL1     ;IN UBLAT MODE
 329         AOSN UDPWF(I)
 330         PUSHJ P,UDPW
 331 UDPW1:  TRNE D,200000
 332         JRST UTDEL1     ;DELETE OR RENAME
 333         JUMPL D,UTOW1   ;WRITE
 334         PUSHJ P,FLDRCK
 335         JRST UTO5B      ;NORMAL FILE WANTED
 336         MOVEI J,0       ;UTAPE DIRECTORY WANTED
 337         PUSHJ P,LSWPOP
 338         JRST LISTFE     ;JOIN DIRECTORY CODE FOR OTHER DEVICES
 339 \f
 340 UTOBL1: CAIN W,4
 341         JRST OPNL4      ;DELETE ILLEGAL IN UBLAT MODE
 342         CLEARB A,B
 343         JRST UTO8
 344
 345 UTO5B:  PUSHJ P,UTLK3   ;MUST NOT CLOBBER TT
 346         JUMPE B,OPNL4
 347 UTOW2:UTO8:     CONO PI,UTCON
 348         MOVSI TT,-NUTIC
 349         TLNE C,1
 350         MOVE TT,[-NUTOC,,NUTIC]
 351         SKIPL UTUSR(TT)
 352         AOBJN TT,.-1
 353         JUMPG TT,UNCA   ;NO CHANNEL AVAILABLE
 354         CONO PI,UTCOFF
 355         SKIPL UTUSR(TT)
 356         JRST UTO8
 357         MOVEI J,DCHNT-UTUL(I)
 358         JRST .+2
 359 UTO2:   MOVE J,Q
 360         HRRE Q,UTUL(J)
 361         JUMPGE Q,UTO2   ;INSERT CHNL ONTO LIST FOR TAPE
 362         HRLOM U,UTUSR(TT)
 363         HRRM TT,UTUL(J)
 364         HRRZM I,UTTNO(TT)
 365         HRRZ J,UDIRO(I)
 366         ADD J,A
 367         MOVE Q,133(J)
 368         MOVEI J,EOFCH
 369         TRNN Q,1
 370         MOVEI J,141
 371         MOVEM J,UTEOF(TT)       ;STORE EOF CHR
 372         SETZM UTDBC(TT)
 373         DPB A,[300500,,UTDBC(TT)]
 374         JUMPL D,UTOW3   ;WRITE
 375         DPB A,[220500,,UTDBC(TT)]
 376 UTOW4:  HRLM A,UTTNO(TT)
 377         HRRZ J,UDIRO(I)
 378         ADD J,[500,,23.*2-1]
 379         MOVEM J,UTDIRP(TT)
 380         MOVE J,[SETZ 377]
 381         MOVEM J,UTBFP(TT)
 382         CLEARM UTBFS(TT)
 383         MOVE J,TIME
 384         MOVEM J,UTLSTM(TT)
 385         HRROS UTMBN(TT)
 386         HLLOS UTRAC(TT)
 387         HRRZS UTRAC(TT)
 388         CONO PI,UTCON
 389         CLEARM MPRC(TT)
 390         AOS NUTCA
 391         PUSHJ P,FSCMP
 392         HRRZS UTRAC(TT)
 393         PUSHJ P,LSWPOP  ;RELEASE FILE DIR
 394         MOVSS C
 395         HRL A,TT
 396         JSP Q,OPSLC7
 397         DNUACII,,DNUACCO        ;ASCII UNITS INPUT ;ASCII UNITS OUTPUT
 398         DNUBKI,,DNUBKO  ;BLOCK INPUT ;BLOCK OUTPUT
 399         DNUDTI,,DNUDTO  ;WORD INPUT ;WORD OUTPUT
 400         DNUBKI,,DNUBKO  ;BLOCK INPUT ;BLOCK OUTPUT
 401 \f
 402 UTOW1:  SKIPN UMNFB(I)
 403          JRST OPNL6     ;FULL
 404         PUSH P,B
 405         PUSH P,A
 406         PUSHJ P,UTSNMK
 407          JRST UTWNA     ;NOT ASSIGNED
 408         SETZB A,B
 409         PUSHJ P,UTLK3
 410         JUMPE B,UFILDF  ;FILE DIR FULL
 411         JRST UTOW2
 412
 413 UTSNMK: SKIPN T,UTASS(I)        ;TAPE MUST BE ASSIGNED TO THIS LOSER
 414          POPJ P,
 415         CAME T,UNAME(U)
 416         CAMN T,USYSN1(U)
 417          AOS (P)
 418         POPJ P,
 419
 420 UTOW3:  HRROM TT,1(B)   ;RESERVE FILE NAME
 421         POP P,UTN1(TT)  ;STORE NAMES
 422         POP P,UTN2(TT)
 423         MOVSI J,100000
 424         IORM J,UDIRO(I) ;SET FILE DIR MODIFYED
 425         MOVSI J,UTBKNP(TT)      ;GET LIST PNTR PNTR
 426         MOVEM J,UTBKNP(TT)      ;MAKE LH SELF-REFERENT SO INIT LINK WILL GO IN RH
 427         AOS NUWCA       ;INCR # ACT UWRITE CHNLS
 428         JRST UTOW4
 429
 430 UNCA:   JUMPGE D,NCA
 431 UTWNA:  SUB P,[2,,2]
 432 NCA:    JRST OPNL10
 433
 434 UFILDF: SUB P,[2,,2]
 435 FILDF:  JRST OPNL5
 436
 437 S1NL14: SUB P,[1,,1]
 438         JRST OPNL14
 439
 440 UDATAI: SKIPA E,[444400,,1]
 441 UASCII:  MOVE E,[440700,,5]
 442         MOVEI B,UBLKI2
 443         JRST CHRKTI
 444
 445 UBLKI:  MOVE E,[444400,,1]
 446         JSP B,BLKT
 447 UBLKI2: MPRP(A)
 448         MPRC(A)
 449         UTBGB   ;4.9 = 0 UTAPE 1 DISK
 450         UTBRB
 451         JRST 4,.
 452         SKIPG UTBFS(A)
 453 \f
 454 ;INPUT BLK BUFFER-GET RTN
 455
 456 UTBGB:  LDB Q,[IOLO,,UTBFP(A)]
 457         CAIN Q,377
 458          JRST 4,.       ;PNTRS OUT OF PHASE
 459         CAIN Q,376
 460          JRST POPJ2     ;END OF FILE
 461         CONO PI,UTCOFF
 462         SKIPL UTRAC(A)
 463          SKIPGE IOBFT(Q)
 464           JRST UTBGB1
 465         LDB J,[IOLO,,IOBFT(Q)]
 466         HRRM J,UTBFP(A)
 467         MOVEI TT,(SETZ)
 468         CAIL J,376
 469          HRLM TT,UTBFP(A)
 470         CONO PI,UTCON
 471         SOS UTBFS(A)
 472 UTBWG4: MOVE J,TIME
 473         MOVEM J,UTLSTM(A)
 474         MOVEI J,-3
 475         DPB J,[IOLO,,IOBFT(Q)]
 476         LDB TT,[IOSA,,IOBFT(Q)]
 477         LSH TT,6
 478         HLL TT,E
 479         MOVEM TT,MPRP(A)
 480         MOVEI TT,200
 481         IMULI TT,(E)
 482         MOVEM TT,MPRC(A)
 483         HRLM Q,UTMBN(A)
 484         JRST POPJ1
 485
 486 UTBGB1: CONO PI,UTCON
 487         SKIPL IOBFT(Q)
 488          SKIPGE UTRAC(A)
 489           PUSHJ P,UFLS          ;REALLY?
 490         JRST UTBGB
 491
 492 UBLKO:  MOVE E,[444400,,1]
 493         JSP B,BLKT
 494 UBLKO2: SETZ MPRP(A)
 495         MPRC(A)
 496         UTBWG
 497         UTBWW
 498         JRST 4,.
 499         TRNA
 500
 501 UASCCO: SKIPA E,[440700,,5]
 502 UDATAO:  MOVE E,[444400,,1]
 503         MOVEI B,UBLKO2
 504         JRST CHRKTO
 505 \f
 506 ;OUTPUT BLKT BUFFER-GET RTN
 507
 508 UTBWG:  MOVE Q,UTBFS(A) ;GET # BUFS IN CHNL
 509         IMUL Q,NUWCA    ;SCALE TO # ACT UWRITE CHNLS
 510         CAIL Q,LUTWBF   ;IF BEING TOO GREEDY WITH BLOCK LIST SPACE
 511         POPJ P,         ;LOSE
 512         PUSH P,A
 513         PUSH P,B
 514         MOVE D,A
 515         HRRZ Q,UTBFP(D)
 516         CAIL Q,376
 517         JRST UTBWG1     ;NO BUFS NOW RELOAD
 518         SKIPGE UTDBC(D)
 519         JRST POPBAJ     ;CHNL IN ERR
 520
 521 UTBWG2: HRRZ J,UTBFS(D)
 522         CAMG J,UPCHFS
 523         JRST UTBWG1
 524         PUSHJ P,TCALL
 525         JRST UIMRQ
 526         JRST POPBAJ
 527         PUSHJ P,TCALL
 528         JRST UTMGB
 529         JRST UTBWG2
 530
 531 UTBWG1: HRRZ Q,UTTNO(D)
 532         SOSGE UMNFB(Q)
 533         JRST UTBWG5
 534         PUSHJ P,AOSSET
 535         UMNFB(Q)
 536         PUSHJ P,LSWTL   ;WAIT FOR
 537         UDIRO(Q)        ;DIR TO UNLOCK
 538         PUSH P,E        ;SAVE E
 539         PUSHJ P,TCALL
 540         JRST IUTCONS
 541         JRST UTBWG6
 542         PUSH P,A        ;SAVE A
 543         PUSH P,B
 544         PUSH P,C
 545         MOVE C,Q
 546         MOVE B,UDIRO(C)
 547         MOVEI E,0       ;INDICATE ADVANCE TO UDIRAD
 548         PUSHJ P,UDOUT2  ;ADV DIR PNTRS (SKIP LOCK CHECK IN UDIRAD)
 549         JRST 4,.        ;SHOULDN'T GET HERE
 550         JRST UTPFUL     ;NO ROOM FOR EXT
 551         PUSHJ P,LSWPOP  ;UNLOCK DIR
 552         PUSHJ P,LSWDEL  ;UNHACK UTFAOS
 553         POP P,C
 554         POP P,B
 555         POP P,Q         ;GET BACK BUF #
 556         POP P,E         ;RESTORE E
 557         POP P,B
 558         POP P,A
 559         AOS UTBFS(A)
 560         JRST UTBWG4
 561 \f
 562 UTBWG5: AOS UMNFB(Q)
 563         JRST IOCER9
 564
 565 UTBWG6: PUSHJ P,LSWCLR  ;UNLOCK DIR & ADJ BLK CNT
 566         POP P,E
 567         JRST POPBAJ
 568
 569 UTPFUL: SUB P,[2,,2]
 570         POP P,A         ;GET BACK BUF #
 571         PUSHJ P,BRTN    ;RETURN BUF
 572         JRST IOCER9     ;BARF ABOUT TAPE FULL
 573
 574 UTBWW:  HLRE Q,UTMBN(A)
 575         JUMPL Q,CPOPJ
 576         PUSHJ P,LWAIT   ;WAIT FOR
 577         SKIPN UTWBFS    ;SPACE IN BLK LIST & GET PNTR
 578         MOVE J,UTWBFS   ;(DO NOT COMBINE WITH PRECEDING INST)
 579         HRRZ H,(J)      ;GET PNTR TO NEXT FREE WD
 580         MOVEM H,UTWBFS  ;UPDATE FS PNTR
 581         CONO PI,UTCON   ;TURN ON UTC NOW TO MINIMIZE OFF TIME EVEN THOUGH OFF AGAIN LATER
 582         HRRZ D,UTDBC(A) ;GET NEXT BLK #
 583         MOVSM D,(J)     ;PUT IN NEW WD
 584         HLRZ D,UTBKNP(A)        ;GET PNTR TO LAST WD IN LIST
 585         HRRM J,(D)      ;STORE LINK IN END OF LIST
 586         HRLM J,UTBKNP(A)        ;UPDATE END PNTR
 587         MOVEI J,377
 588         IORM J,IOBFT(Q)
 589         SKIPGE UTTNO(A)
 590          SOS IOBFT(Q)   ;CHANGE TO EOF
 591         CONO PI,UTCOFF
 592         HLRE J,UTBFP(A)
 593         JUMPL J,UTBWW1
 594         DPB Q,[IOLO,,IOBFT(J)]
 595
 596 UTBWW2: HRLM Q,UTBFP(A)
 597         CONO PI,UTCON
 598         HRROS UTMBN(A)
 599         POPJ P,
 600
 601 UTBWW1: HRRM Q,UTBFP(A)
 602         JRST UTBWW2
 603
 604 UTOCL:  MOVSI Q,(SETZ)
 605         IORM Q,UTTNO(A)
 606         LDB E,[300600,,MPRP(A)] ;NOW FILL OUT BLOCK WITH EOF CHARS
 607         CAIN E,7
 608          JRST UTOCL6
 609 UTOCL1: HRROI C,[EOFWRD]
 610         SKIPG MPRC(A)
 611          JRST UTOCL2
 612         PUSHJ P,UDATAO
 613         JRST UTOCL1
 614
 615 UTOCL6: HRROI C,UTEOF(A)
 616         SKIPG MPRC(A)
 617          JRST UTOCL2
 618         PUSHJ P,UASCCO
 619         JRST UTOCL6
 620 \f
 621 UTOCL2: SKIPG MPRC(A)
 622         PUSHJ P,UTBWW   ;MAKE SURE BUFFER WRITTEN OUT SINCE MAYBE GOT
 623                         ;PCLSRED FROM UTBWW DURING .IOT THAT JUST FILLED BUFFER
 624         PUSH P,R
 625         MOVE D,A
 626         SKIPE UTBFS(D)
 627         PUSHJ P,UFLS
 628         HRRZ C,UTTNO(D)
 629         PUSHJ P,LSWTL
 630         UDIRO(C)
 631         HRRZ Q,UTBFP(D)
 632         CAIL Q,376
 633         JRST UTOCL4     ;NORMAL CLOSE
 634         MOVEI Q,%PIIOC  ;ABORT WORKS
 635         IORM Q,PIRQC(U)
 636         MOVEI A,0
 637         HRROI B,(D)
 638         PUSHJ P,UDELETE
 639 UTOCL5: PUSHJ P,LSWPOP
 640         POP P,R
 641         SOS NUWCA       ;DECR # ACT UWRITE CHNLS
 642         JRST UTOCL3
 643
 644 UTOCL4: MOVE A,UTN1(D)
 645         MOVE B,UTN2(D)
 646         PUSHJ P,UDELETE
 647         LDB Q,[220500,,UTTNO(D)]
 648         LSH Q,1
 649         ADD Q,UDIRO(C)
 650         MOVE A,UTN1(D)
 651         MOVE B,UTN2(D)
 652         MOVEM A,-2(Q)
 653         MOVEM B,-1(Q)
 654         LDB Q,[220500,,UTTNO(D)]
 655         ADD Q,UDIRO(C)
 656         MOVEI A,1
 657         IORM A,133(Q)
 658         JRST UTOCL5
 659
 660
 661 UTDEL1: MOVE C,I        ;DELETE
 662         SKIPE SRN3(U)
 663         JRST UTRN1      ;RENAME
 664         PUSHJ P,UTSNMK
 665         JRST NCA
 666         PUSHJ P,UDELETE
 667         JUMPE TT,OPNL4
 668         JRST LSWPJ1
 669
 670 \f
 671 UTRN1:  JUMPE A,UTRN3   ;RENAME OF OPEN FILE
 672         PUSHJ P,UTSNMK  ;ALLOW RENAME OF OPEN FILE
 673         JRST NCA
 674         PUSHJ P,UTLOOK
 675         JUMPE B,OPNL14
 676         PUSH P,Q
 677         MOVE A,SRN3(U)
 678         MOVE B,SRN4(U)
 679         PUSHJ P,UTLOOK
 680         POP P,Q
 681         JUMPN B,OPNL13
 682         MOVE A,SRN3(U)
 683         MOVE B,SRN4(U)
 684         MOVEM A,0(Q)
 685         MOVEM B,1(Q)
 686 UTRN4:  MOVSI A,100000
 687         IORM A,UDIRO(C)
 688         JRST LSWPJ1
 689
 690 UTRN3:  ADDI B,IOCHNM(U)
 691         HLRZ TT,(B)
 692         MOVE A,SRN3(U)
 693         MOVE B,SRN4(U)
 694         MOVEM A,UTN1(TT)
 695         MOVEM B,UTN2(TT)
 696         JRST UTRN4
 697 \f
 698 UDELETE:        MOVEI TT,0      ;TT=0 IF NOTHING DELETED + OTHERWISE
 699 UDELA:  PUSHJ P,UTLOOK
 700         JUMPE B,CPOPJ   ;TAPE NO IN C,FILE NAME IN A,B
 701         MOVEI E,NUTIC-1
 702 UDELE4: HRRZ J,UTTNO(E)
 703         SKIPL UTUSR(E)
 704         CAME J,C
 705         JRST UDELE3
 706         HLRZ J,UTTNO(E)
 707         CAME J,A
 708         JRST UDELE3
 709         MOVSI J,10000
 710         TDNE J,UTDBC(E)
 711         JRST UDELE3     ;THIS IS LOSER WHO IS CLOSING FILE
 712         IORM J,UTDBC(E)
 713         CLEARM (Q)
 714         SETOM 1(Q)
 715         AOJA TT,CPOPJ
 716
 717 UDELE3: SOJGE E,UDELE4
 718 UDELE1: CLEARM (Q)
 719         CLEARM 1(Q)
 720         MOVE J,A
 721         ADD J,UDIRO(C)
 722         MOVEI B,1
 723         ANDCAM B,133(J)
 724         MOVSI J,100000
 725         IORM J,UDIRO(C)
 726 UDELE6: HRRZ B,UDIRO(C)
 727         ADD B,[500,,23.*2-1]
 728         MOVEI J,0
 729 UDELE2: ILDB E,B
 730         CAMN E,A
 731         AOS UMNFB(C)
 732         CAMN E,A
 733         DPB J,B
 734         CAIE E,37
 735         JRST UDELE2
 736         MOVE B,A
 737         MOVEI A,0
 738         AOJA TT,UDELA
 739
 740 \f
 741 UTICL:  PUSH P,R
 742         MOVE D,A
 743         MOVSI C,200000
 744         IORM C,UTRAC(D) ;SET EOF
 745         MOVEI T,400000
 746         TDNN T,UTRAC(D)
 747         PUSHJ P,UFLS    ;WAIT FOR ACTIVE BUFFER TO TRANSFER
 748         PUSHJ P,UTBRB1  ;RETURN ACTIVE BUFFER MAIN PROG
 749         HLRZ A,UTTNO(D)
 750         MOVE B,UTDBC(D)
 751         TLNE B,10000
 752         PUSHJ P,UDELE5  ;FINISH FILE DELETE
 753         POP P,R
 754 UTOCL3: HRRZ A,UTBFP(D)
 755 UTICL2: CAIL A,376
 756         JRST UTICL3
 757         LDB C,[IOLO,,IOBFT(A)]
 758         PUSHJ P,BRTN
 759         MOVE A,C
 760         JRST UTICL2
 761
 762 UTICL3: PUSHJ P,UCPAT0  ;UT CHANNEL PATCH OUT
 763         CLEARM UTDIRP(D)
 764         SETOM UTUSR(D)
 765         CLEARM (R)
 766         POPJ P,
 767
 768
 769 \f
 770 UCPAT0: HRRZ B,UTTNO(D) ;PATCH OUT CHANNEL
 771         MOVEI C,DCHNT-UTUL(B)
 772         CONO PI,UTCOFF
 773 UCPAT2: HRRE E,UTUL(C)
 774         JUMPL E,UTCOP
 775         CAMN E,D
 776         JRST UCPAT1
 777         MOVE C,E
 778         JRST UCPAT2
 779
 780 UCPAT1: HRRZ E,UTUL(E)
 781         HRRM E,UTUL(C)
 782         SOS NUTCA
 783 UTCOP:  JRST UTCONJ
 784
 785 UDELE5: HRRZ C,UTTNO(D)
 786         PUSHJ P,LSWTL
 787         UDIRO(C)
 788         HLRZ Q,UTTNO(D)
 789         MOVE A,Q
 790         LSH Q,1
 791         ADD Q,UDIRO(C)
 792         SUBI Q,2
 793         PUSHJ P,UDELE1
 794         JRST LSWPOP
 795
 796 UTBRB1: MOVE A,D
 797 UTBRB:  PUSH P,A
 798         HLRE A,UTMBN(A)
 799         JUMPL A,POPAJ
 800         PUSHJ P,BRTN
 801         POP P,A
 802         HRROS UTMBN(A)
 803         POPJ P,
 804 \f
 805 UTRL1:  JUMPE B,UTRLDR
 806         HRRZ B,UTBFP(D)
 807         CAIE B,377
 808         JRST JDB6C
 809 UTRLDR: LDB R,[270100,,UTDBC(D)]
 810         JUMPN R,UTRLD1
 811         SKIPL R,UDIRO(C)        ;SPECIAL KLUDGE TO RUN FAST
 812         TLNE R,10000    ;SKIPN ON NOT IN UBLAT MODE
 813         JRST UTRLD1
 814         LDB TT,[220500,,UTDBC(D)]
 815         ILDB B,UTDIRP(D)
 816         AOS UTDBC(D)
 817         CAME B,TT
 818         JRST UTRLD2
 819 UTRLD3: PUSHJ P,IUTCONS ;RTN BUFFER NO IN A
 820         JRST UTRLR1     ;MEM LOCKED (OR SOMETHING)
 821         CLEARM URDWR(C)
 822         HRRZ B,UTDBC(D) ;GET BLK # TO READ
 823         JRST UTRLD
 824
 825 UTRLD2: CAIN B,37
 826         PUSHJ P,UAR
 827
 828 UTRLD1: PUSHJ P,UDIRAD
 829         JRST JDB6C2     ;DIR DOUBLE LOCKED
 830         JRST UTREOF
 831         JRST UTRLD3
 832
 833 \f
 834 JDDTA:  HLRZ D,ULDCH(C) ;FINISHED DATA TRANS TAPE IN C GET CHNL NO
 835         CLEARM UTLDD(D)
 836         SETOM SMODE
 837 IFE NEWDTP,     CONSZ DC,7
 838 IFN NEWDTP,     CONSO DTS,100000
 839         JRST UDATER     ;DC STILL ENABLED => ERROR
 840         SETOM UGOAL(C)
 841         CAIL D,NUTIC
 842         JRST JDDT1      ;WRITE OR FILE DIRECTORY
 843         MOVE E,UTRAC(D)
 844         HLLOS UTRAC(D)
 845         MOVEI B,377
 846         IORM B,IOBFT(E)
 847         HLRE B,UTBFP(D)
 848         JUMPL B,JDDT5
 849         DPB E,[IOLO,,IOBFT(B)]
 850 JDDT6:  HRLM E,UTBFP(D)
 851         AOS UTBFS(D)
 852
 853
 854 JDDT2:  PUSHJ P,JDB6W
 855         JRST JDDT3      ;SAME TAPE CAN RELOAD, DONT CHECK OTHERS
 856 JDDT4:  HRRZS ULDCH(C)
 857 IFE NEWDTP,     JRST JDB4A      ;UNIT NOW IDLE STOP IT
 858 IFN NEWDTP,[
 859         PUSHJ P,JDSTP
 860         JRST JDB3
 861 ]
 862
 863 JDDT1:  CAIL D,NUTIC+NUTOC
 864         JRST UDRDD3     ;FILE DIR IN OR OUT
 865         HRRZ A,UTRAC(D)
 866         PUSHJ P,IBRTN
 867         HLLOS UTRAC(D)
 868         SOS UTBFS(D)
 869         JRST JDDT2
 870
 871
 872 JDDT5:  HRRM E,UTBFP(D)
 873         JRST JDDT6
 874 \fUTREOF:        MOVSI E,200000
 875         IORM E,UTRAC(D)
 876         HLRE E,UTBFP(D)
 877         SKIPL E
 878         SOSA IOBFT(E)   ;TURN END OF LIST TO END OF FILE
 879         SOS UTBFP(D)
 880         AOS UTBFS(D)    ;TO START MAIN PROG
 881         JRST JDB6C
 882
 883 JDB6W:  HRRE D,DCHNT(C)
 884         JUMPL D,JDB6W1  ;NO CHANNELS ACTIVE
 885         CAIN D,200000
 886         JRST UDRDD      ;READ FILE DIR
 887 JDB6C1: SKIPL E,UTRAC(D)
 888          TLNE E,300000
 889           JRST JDB6C2   ;CHANNEL LOCKED
 890         CAIL D,NUTIC
 891          JRST JDB6A     ;WRITE CHANNEL
 892         HRRZ B,UTBFS(D)
 893         CAILE B,MXUTBF  ;READ CHANNEL; SHOULDN'T LET IT GET TOO MANY BUFFERS.
 894          JRST JDB6C
 895         HRRZ B,UTFS
 896         CAIN B,377
 897          JRST JDB6E     ;TRY TO GET MORE MEMORY
 898         MOVE B,UTBFS(D)
 899         SOJLE B,UTRL1   ;RELOAD CHANNEL WITH ONE OR NO BUFFERS
 900         MOVE B,UTLSTM(D)
 901         SUB B,TIME
 902         CAMG B,[-300.]
 903          JRST JDB6C2    ;NO RELOAD
 904 JDB6F:  HRRZ B,UTBFS(D) ;NUMBER BUFS THIS CHANNEL HAS
 905         CAMGE B,UPCHFS
 906          JRST UTRLDR
 907 JDB6E:  PUSHJ P,UIMRQ   ;TRY TO GET MORE MEMORY (IO)
 908          JRST JDB6C2    ;NOT AVAIL
 909         PUSHJ P,UTMGB   ;ADD TO MEM ALLOC UTAPE
 910         JRST JDB6F
 911
 912 UTRLR1: PUSHJ P,UDIRR   ;BACK UP
 913          JRST 4,.
 914         JRST 4,.        ;LOSSAGE
 915 JDB6C2:
 916 JDB6C:  HRRE D,UTUL(D)
 917         JUMPGE D,JDB6C1
 918         JRST POPJ1
 919
 920 JDB6W1: LDB D,[410300,,UDIRO(C)]
 921         SOJN D,POPJ1    ;DIR CHANGED AND NOT LOCKED
 922         HRRZ D,UDIRO(C)
 923         LDB D,[370500,,177(D)]
 924         CAIE D,37
 925         JRST 4,.        ;DIRECTORY CLOBBERED SINCE READ IN
 926         MOVEI D,100     ;INITIATE FILE DIR WRITE
 927         SKIPL ULDCH(C)  ;SKIPN ON ALREADY LOW PRIORITY POSIT
 928         PUSHJ P,ILLP    ;INITIATE  LOW PRIOR POSIT
 929         JRST POPJ1
 930
 931 ULLP1:  SKIPGE UDIRO(C)
 932         POPJ P,
 933         SETOM URDWR(C)  ;SET FILE DIR WRITE CYCLE FROM LOW PRIORITY CYCLE
 934         MOVSI D,400000  ;LOCK DIR
 935         IORM D,UDIRO(C)
 936         MOVEI D,NUTIC+NUTOC
 937         HRRZ A,ULDCH(C) ;BUFFER NO OF DIRECTORY
 938         JRST JDB6W2
 939 \f
 940
 941 JDB6A:  HRRZ A,UTBFP(D)
 942         CAIGE A,376
 943         SKIPGE IOBFT(A)
 944         JRST JDB6C2     ;LOCKED OUT SNIFFLE
 945         MOVE E,UTBKNP(D)        ;GET BLK LIST PNTR
 946         MOVE J,UTWBFS
 947         EXCH J,(E)
 948         HRRZM E,UTWBFS
 949         HLRZ B,J        ;GET BLK # FROM HEAD OF LIST
 950         HRR E,J         ;SET LINK TO NEXT WD IN LIST
 951         TRNN E,-1       ;IF LIST EMPTY
 952         MOVSI E,UTBKNP(D)       ;SET END PNTR TO PNTR SO NEXT LINK WILL GO HERE
 953         MOVEM E,UTBKNP(D)       ;UPDATE PNTR
 954         SETOM URDWR(C)
 955         HRRZ A,UTBFP(D)
 956         LDB E,[IOLO,,IOBFT(A)]
 957         HRRM E,UTBFP(D)
 958         MOVEI J,(SETZ)
 959         CAIL E,376
 960         HRLM J,UTBFP(D)
 961
 962 UTRLD:  HRRM A,UTRAC(D)
 963 UDRR2:  MOVEM B,UGOAL(C)
 964         MOVEI B,-4
 965         DPB B,[IOLO,,IOBFT(A)]
 966         LDB B,[IOSA,,IOBFT(A)]
 967         LSH B,6
 968         SOS B
 969         HRRM B,UMEMAD(C)
 970         HRLM D,ULDCH(C)
 971         MOVE B,TIME
 972         MOVEM B,DRTM(C)
 973         POPJ P,
 974
 975 JDB6:   PUSHJ P,JDB6W
 976         JRST JDBRK7     ;SUCCESFUL RELOAD
 977         SKIPL ULDCH(C)
 978 IFE NEWDTP,[
 979         JRST JDBRK4     ;CAN NOT RELOAD
 980         JRST JDF2A
 981 ]
 982 IFN NEWDTP,[
 983         JRST JDBRK6
 984         JRST JDS1
 985 ]
 986 \f
 987 UDRDD:  MOVE D,UDIRO(C) ;TAPE WANTS FILE DIRECTORY READ
 988         TLO D,20000     ;OK FOR 4.5 CLEAR
 989         AOSE D          ;REST SHOULD BE -1
 990          JRST 4,.       ;FILE DIRECTORY READ REQUEST WHEN ALREAD IN
 991         MOVEI D,NUTIC+NUTOC     ;GET DIRECTORY CHANNEL NUMBER IN D
 992         PUSHJ P,IUTCONS
 993          JRST POPJ1     ;NO MEM
 994         LDB B,[IOSA,,IOBFT(A)]  ;GET ORIGIN _ -6
 995         LSH B,6
 996         TLO B,600000    ;SET LOCK, DOUBLE LOCK BITS
 997         MOVEM B,UDIRO(C)        ;STORE ORIGIN
 998         HLLOS DCHNT(C)  ;NO CHANNEL ACTIVE THIS UNIT YET
 999         CLEARM URDWR(C) ;SIGNAL WANT READ
1000         HRRM A,ULDCH(C) ;STORE BUFFER NUMBER
1001 JDB6W2: MOVEI B,100     ;DIRECTORY BLOCK NUMBER
1002         JRST UDRR2
1003
1004 UDRDD3: HRRZ D,ULDCH(C) ;FILE DIR IN OR OUT
1005         HRRZS UDIRO(C)  ;UNLOCK DIRECTORY
1006         DPB C,[IOLO,,IOBFT(D)]
1007         HRRZS ULDCH(C)
1008         JRST JDDT2
1009 \fUDIRAD:        TDZA E,E        ;ADVANCE DIR PNTRS OF CHANNEL IN D
1010 UDIRR:  MOVEI E,1       ;REV DIR PNTRS THIS WINS FOR READS ONLY HA HA
1011         SKIPGE B,UDIRO(C)
1012         JRST UDOUT3
1013 UDOUT2: TLNE B,10000
1014         JRST UDBL1      ;UBLAT MODE
1015 UDOUT7: LDB R,[270100,,UTDBC(D)]
1016         XOR R,E
1017         MOVEI Q,0
1018         CAIL D,NUTIC
1019         MOVEI Q,UTBLKS
1020         LDB TT,[220500,,UTDBC(D)]
1021
1022 UDIR1:  PUSHJ P,UITAB(R)
1023         TRNE J,-1       ;BLK NO RTN IN RH J
1024         CAIN B,37
1025         JRST UDOUT      ;END OF EXTENSION
1026         CAME B,TT
1027         SOJA Q,UDIR1
1028         SOJG Q,.-1
1029         LDB B,[300500,,UTDBC(D)]
1030         DPB B,UTDIRP(D)
1031 UDARET: JRST POPJ2
1032
1033 UDBL1:  AOS A,UTDBC(D)
1034         CAILE A,1101
1035         JRST POPJ1      ;EOF
1036         JRST POPJ2
1037
1038 UDOUT:  JUMPN E,UDOUT5
1039         CAIL D,NUTIC
1040         JRST UDOUT1
1041         MOVEI A,0       ;READ
1042         MOVE B,TT
1043         PUSHJ P,UTLOOK  ;TAP NO IN C NAME IN A,B
1044         JUMPE B,POPJ1   ;EOF OR ADR OF FIRST WD
1045 UDOUT6: DPB A,[220500,,UTDBC(D)]        ;FILE NO
1046 UDOUT4: DPB A,[300500,,UTDBC(D)]
1047         MOVSI A,1_5
1048         XORM A,UTDBC(D)
1049         JRST UDOUT7
1050
1051
1052 UDOUT3: TLNN B,200000   ;DIRECTORY DOUBLE LOCKED
1053         CAIL D,NUTIC
1054         POPJ P,
1055         JRST UDOUT2
1056 \f
1057 UDOUT1: SETZB A,B
1058         PUSHJ P,UTLOOK
1059         JUMPE B,UDOUT8  ; FILE DIR FULL
1060         LDB J,[300500,,UTDBC(D)]
1061         MOVEM J,1(B)
1062         JRST UDOUT4
1063
1064 UDOUT8: XORI R,1        ;REVERSE DIR
1065         AOS (P) ;SKIPN ONCE
1066         JRST UITAB(R)   ;BACK UP PNTRS AND RETURN
1067
1068 UDOUT5: LDB A,[220500,,UTDBC(D)]
1069         LSH A,1
1070         ADD A,UDIRO(C)
1071         SKIPE -2(A)
1072         JRST UDARET
1073         MOVE A,-1(A)
1074         JRST UDOUT6
1075
1076 UTLK3:  SKIPA Q,UDIRO(I)
1077 UTLOOK: MOVE Q,UDIRO(C) ;B=0 => NOT FOUND
1078         HRLI Q,-23.
1079         PUSH P,[1]
1080 UTLK2:  CAMN A,(Q)
1081         CAME B,1(Q)
1082         AOJA Q,UTLK1
1083         MOVE B,Q
1084         JRST POPAJ
1085
1086 UTLK1:  AOS(P)
1087         AOBJN Q,UTLK2
1088         MOVEI B,0
1089         JRST POPAJ
1090
1091 UITAB:  AOSA J,UTDBC(D)
1092         JRST UAR
1093
1094 UAF:    ILDB B,UTDIRP(D)
1095         POPJ P,
1096
1097 UAR:    MOVSI B,50000
1098         ADD B,UTDIRP(D)
1099         SKIPGE B
1100         SUB B,[430000,,1]
1101         MOVEM B,UTDIRP(D)
1102         LDB B,B
1103         SOS J,UTDBC(D)
1104         POPJ P,
1105
1106 EBLK
1107 \fIFN NEWDTP,{
1108 ; T S UTAPE ROUTINES PI SERV (NEW UTAPE CONTROL)
1109
1110 TAPE:   0
1111 UTP1:   0       ;JRST PIPOS OR DATAI DC, OR JRST UTP3
1112
1113 BBLK
1114
1115         SOS .-1
1116         AOSGE TAPCNT
1117         JRST 12,@TAPE
1118
1119 UTP3:   CONO DTS,770001
1120         JRST 12,@TAPE
1121
1122 PIPOS:  MOVEM A,TAP1
1123         MOVEM B,TAP2
1124         MOVEM C,TAP3
1125         MOVE C,SUNIT
1126         DATAI DTC,B
1127         TDZE B,[1777#-1]
1128         JRST PIPOS7
1129         MOVEM B, EUPOS(C)
1130         HRRZM C, DG2(C)
1131         SKIPGE UGOAL(C)
1132         JRST PIPF1
1133         SUB B,UGOAL(C)
1134         JUMPE B,PIPOS2
1135         ADD B,UDIR(C)
1136         MOVMM B,UTENB
1137         SKIPGE ULDCH(C)
1138         JRST PIPOS3
1139         JUMPN B,PIPOS3
1140 PIPOSL: MOVEI A,40000+DCCHN_3
1141         DPB C,[110300,,A]       ;SET SELECTED UNIT CONO DTC,FOO(A)
1142         MOVE B,UDIR(C)
1143         XCT UTST2(B)
1144 PIPOS5: MOVE C,TAP3
1145         MOVE B,TAP2
1146         MOVE A,TAP1
1147         JRST 12,@TAPE
1148
1149 PIPOS7: AOS BDBLKC
1150         JRST PIPOSL
1151
1152 EBLK
1153
1154 BDBLKC: 0
1155 \fBBLK
1156
1157 PIPOS3: MOVE A,UDIR(C)
1158         LSH A,2
1159         SUB B,A
1160         XOR B,UDIR(C)
1161         MOVEI A,40000
1162         DPB C,[110300,,A]
1163         JUMPG B,PIPOS4  ;GOING WRONG DIR
1164 PIPOS6: MOVE B,TIME
1165         MOVEM B,ULCTM(C)
1166         ADD B,UTENB
1167         MOVEM B,DRTM(C)
1168 PIPF2:  MOVE B,UDIR(C)
1169         TRNN A,40000
1170         TRO A,30000
1171         XCT  UTST2(B)
1172 ;       CLEARM UDCC
1173 ;       SETOM DCFREE
1174         CONO DTS,770001 ;ENABLE ALL INTERUPTS AND SET FUNCTION STOP
1175         JRST PIPOS5
1176
1177 PIPF1:  MOVEI A,40000
1178         DPB C,[110300,,A]
1179         MOVE B,TIME
1180         MOVEM B,ULCTM(C)
1181         JRST PIPF2
1182 \fPIPOS4:        TRZ A,40000     ;TURN TAPE AROUND
1183         CLEARM DG2(C)
1184         MOVNS B,UDIR(C)
1185         MOVEM B,OUDIR(C)
1186         JRST PIPOS6
1187
1188 PIPOS2: HLRZ A,ULDCH(C)
1189         SKIPL ULDCH(C)
1190         SKIPGE UTRAC(A)
1191         JRST PIPOS3     ;CHANNEL LOCKED
1192         SETOM UTLDD(A)  ;CHANNEL ACTUALLY LOADED TRANSFER IMMINENT
1193         AOS SMODE
1194         MOVEI A,0
1195         MOVE B,UMEMAD(C)
1196         SKIPGE URDWR(C)
1197         TROA A,400      ;WRITE
1198         TLZ B,(BLKO-BLKI)
1199         SKIPL UDIR(C)
1200         JRST TAPFOR
1201         TRO A,100000
1202         ADD B,[DATAI-BLKI 200]
1203         MOVEM B,UTP1
1204         MOVNI B,200
1205         MOVEM B,TAPCNT
1206
1207 TAP4:   CONO DTC,300+DCCHN_3+UTCCHN(A)
1208         CONO DTS,770000
1209         MOVE B,URDWR(C)
1210         MOVEM B,WRITE
1211         MOVE C,TAP3
1212         MOVE B,TAP2
1213         MOVE A,TAP1
1214         JRST 12,@TAPE
1215
1216 TAPFOR: TRO A,200000
1217         HRRM B,TAPCNT
1218         HRRI B,TAPCNT
1219         MOVEM B,DCMLOC
1220         MOVE B,[-200,,UTP3]
1221         HRRM B,UTP1
1222         HLLM B,TAPCNT
1223         JRST TAP4
1224 \fUTERR: CONI DTS,E
1225         SKIPL SMODE
1226         JRST UDATER
1227 ;       SKIPGE UDCC
1228 ;       SETOM DCFREE
1229 UTER5:  SKIPN C,SUNIT
1230         JRST JDB3
1231         SETOM DG2(C)
1232         SKIPL UFLAPF(C)
1233         JRST UTER6
1234         CLEARM UFLAPF(C)
1235         CLEARM EUPOS(C)
1236         CLEARM UDIR(C)
1237         CLEARM OUDIR(C)
1238         CONO DTC,400000 ;STOP DRIVE
1239         JRST JDB3
1240
1241 UTER6:  AOS UTERP(C)
1242         HRLM E,UTERP(C)
1243         TRNN E,20000
1244         JRST JDB3       ;END ZONE
1245         MOVNS B,UDIR(C)
1246         MOVEI A,0
1247         SKIPGE B
1248         MOVEI A,1103
1249         MOVEM A,EUPOS(C)
1250         MOVE A,TIME
1251         MOVEM A,ULCTM(C)
1252         MOVEM A,DRTM(C)
1253         JRST JDB7
1254
1255 UDATER: CONO DTS,770001 ;ENABLE ALL INTERUPTS AND STOP FUNCTION
1256         SETOM SMODE
1257         HLRZ D,ULDCH(C)
1258         CLEARM UTLDD(D)
1259         JRST JDB3
1260 \fUTCB0: MOVE C,SUNIT
1261         AOSE CUINT      ;SKIP IF CLOCK CAUSED INTERUPT
1262         JRST JDBRK      ;NOT TIME FLAG
1263 UTCB1:  MOVE B,UDIR(C)
1264         AOSN UTHERR     ;HANG UP ERROR SENT FOR SLOW CLOCK ROUTINE
1265         JRST UTERR
1266         JRST JDB3
1267
1268 JDDT3:  MOVE A,EUPOS(C) ;AFTER DATA XFER
1269         SUB A,UGOAL(C)
1270         MOVMS E,A
1271         ADD A,TIME
1272         MOVEM A,DRTM(C)
1273         MOVE C,[-NUNITS,,1]
1274         MOVM B,DRTM(C)
1275         CAMGE B,TIME
1276         JRST JDB3       ;SOMETHING ELSE DUE
1277         AOBJN C,.-3
1278         MOVE C,SUNIT
1279         SOJLE E,JDB7    ;RELOADING FOR NEXT BLOCK
1280         JRST JDB3
1281 \fILLP:  MOVEM D,UGOAL(C)        ;LOW PRIORITY POSIT ENTRY
1282         MOVSI A,(SETZ)
1283         IORM A,ULDCH(C)
1284
1285 UTDC:   SKIPGE UGOAL(C)
1286         POPJ P, ;UNIT IDLE
1287         SKIPGE DG2(C)
1288         JRST UTDC3
1289 UTDC1:  MOVE A,EUPOS(C) ;ESTIMATE UNIT TIME AND UPDATE EUPOS
1290         SKIPG DG2(C)    ;SKIP ON EXACT POS KNOWN
1291         SKIPN UDIR(C)   ;SKIP ON UNIT RUNNING
1292         JRST UTDC4
1293         MOVE B,TIME
1294         SUBM B,ULCTM(C)
1295         EXCH B,ULCTM(C)
1296         IMUL B,UDIR(C)
1297         ADD A,B ;ACTUAL ESTIMATED POSITION
1298         MOVEM A,EUPOS(C)        ;UPDATE EUPOS
1299 UTDC4:  SUB A,UGOAL(C)
1300         MOVM B,A
1301         CAIG B,2
1302         JRST UTDC2
1303         ADD A,UDIR(C)
1304         MOVMS Aî
1305         CAMLE A,B
1306         SETZB A,B       ;GOING WRONG DIR
1307 UTDC2:  CAILE B,200.
1308         MOVEI B,200.    ;LIMIT LONGEST DEAD RECKON
1309         ADD B,TIME
1310         MOVEM B,DRTM(C)
1311         POPJ P,
1312
1313 UTDC3:  MOVEI B,0       ;NOT KNOWN EXACT POS REQUIRES IMMEDIATE ATTENTION
1314         JRST UTDC2
1315
1316 JDBRK:  CONSZ DTC,7
1317         CONSO DTS,2
1318         JRST POPRET
1319         CONSZ DTS,670300
1320         JRST UTERR
1321         CONSO DTS,100000
1322         JRST POPRET
1323         SKIPL SMODE
1324         JRST JDDTA      ;DATA MODE
1325 JDB3:
1326 ;       SKIPGE UDCC
1327 ;       SETOM DCFREE
1328         HRLOI B,177777
1329         MOVEM B,UTTM2
1330         SETZM UTTM4
1331         SETOM UTTM3     ;UNIT MOST URGENT
1332         CLEARM UTTM1    ;UNIT COULD START
1333         MOVE C,[-NUNITS,,1]
1334 \fJDBRK7:        SKIPGE B,UFLAPF(C)
1335         JRST JDF1       ;FLAPPING OP
1336 JDF2:   SKIPL ULDCH(C)  ;SKIP ON LOW PRIOR POSIT
1337         SKIPGE UGOAL(C)
1338         JRST JDB6       ;UNIT FREE
1339 JDS1:   SKIPE UDIR(C)
1340         JRST JDBRK4
1341         SKIPN UTTM1     ;UNIT TO START
1342         HRRZM C,UTTM1
1343         JRST JDBRK6
1344 JDBRK4: MOVE B,DRTM(C)
1345         SUB B,TIME
1346         MOVE E,B
1347         SUB E,UTTM2     ;TIME SOME OTHER UNIT NEEDS ATTN
1348         JUMPL B,JDCV1   ;ALREADY OVERDUE
1349         MOVM D,E
1350         CAIG B,20.      ;CONFLICT MORE THAN 20 BLKS AWAY
1351         CAIL D,20.      ;THEY ARE SEPARETED BY 20 BLKS
1352         JRST JDCV1
1353         HRRZS C ;RELIEVE CONFLICT BY STOPPING UNIT DUE LATEST
1354         CAMG B,UTTM2
1355         HRRZ C,UTTM3
1356 JDF5:   PUSHJ P,JDSTP   ;STOP UNIT
1357         JRST JDB3
1358
1359 JDCV1:  JUMPGE E,ULLP
1360         MOVEM B,UTTM2   ;UNIT DUE SOONEST
1361         HRRZM C,UTTM3
1362 ULLP:   SKIPL ULDCH(C)
1363         JRST JDBRK6
1364         MOVE B,TIME     ;LOW PRIORITY POSIT IN PROGRESS
1365         SUB B,ULCTM(C)
1366         IMUL B,UDIR(C)
1367         SKIPE DG2(C)
1368         MOVEI B,0
1369         ADD B,EUPOS(C)
1370         SUB B,UGOAL(C)
1371         MOVMS B
1372         CAIGE B,10.
1373         PUSHJ P,ULLP1   ;TERM LOW PRIORITY DIRECTORY POS (COMMIT TO ACTUAL WRITE)
1374 \fJDBRK6:        AOBJN C,JDBRK7
1375         MOVE C,UTTM3    ;MOST PRESSING RUNNING UNIT
1376         MOVE B,UTTM2
1377         CAIGE B,30.
1378         JRST JDB7       ;STAY WITH PRESSING UNIT
1379         SKIPE UTTM1
1380         JRST JDB5       ;START UNIT IF POSSIBLE
1381 JDF6A:  CAMG B,[10000000.]
1382         JRST JDB7
1383         AOSE UTTM4      ;DON'T IF FLAP OP STILL IN PROGRESS
1384         PUSHJ P,JDDS
1385         SETOM UIDLE
1386         JRST POPRET
1387
1388 JDF1:   MOVE E,UDIRO(C)
1389         AOJE E,JDF1A
1390         TLNE E,100000
1391         JRST JDF2
1392 JDF1A:  SKIPGE UGOAL(C) ;FLAPPING OP
1393         SKIPGE ULDCH(C)
1394         JRST JDF2
1395         SKIPE UDIR(C)
1396         SKIPG DG2(C)
1397         JRST .+2
1398         JRST JDF3A      ;HAVE JUST READ IN TAPE POS
1399         TLNN B,100000
1400         JRST JDF3       ;UNIT TO START FLAPPING (I.E. READ IN TAPE POS, THEN FLAP)
1401         LDB D,[4000,,B]
1402         TLNN B,100000
1403         JRST JDBRK6
1404         TLNN B,200000   ;ABORT FLAPPING
1405         CAMG D,TIME
1406         JRST JDF4       ;UNIT TO STOP FLAPPING
1407         SETOM UTTM4     ;INDICATE FLAP OP STILL ACTIVE
1408         JRST JDBRK6
1409
1410 JDDS:   CONO DTC,10000  ;DESELECT
1411         CLEARM SUNIT
1412         POPJ P,
1413
1414 JDSTP:  MOVEI A,430000
1415         SETZM UDIR(C)
1416         SETZM OUDIR(C)
1417 JDCNN:  HRRZS C
1418         CAME C,SUNIT    ;DIR CONO IN A TO UNIT IN C
1419         SKIPN SUNIT
1420         JRST JDSTP1
1421         PUSHJ P,JDDS
1422 JDSTP1: DPB C,[110300,,A]
1423         CONO DTC,(A)
1424         MOVEM C,SUNIT
1425         POPJ P,
1426 \f
1427 JDF3:   MOVE A,UDIRO(C) ;WANT TO FLAP
1428         AOJE A,JDF3A1   ;DIR NOT IN
1429         TLNE A,10000
1430         JRST JDF3A2     ;TAPE IN UBLAT MODE (COMMENT USED TO SAY DIR ON WAY IN) (??)
1431         HRRZ A,ULDCH(C)
1432         LDB Q,[IOCH,,IOBFT(A)]
1433         CAIE Q,NUTIC+NUTOC
1434         JRST 4,.
1435         LDB Q,[IOLO,,IOBFT(A)]
1436         CAIE Q,(C)
1437         JRST 4,.
1438         PUSHJ P,IBRTN   ;RETURN DIR BUFFER
1439 JDF3A2: SETOM UDIRO(C)
1440         SETZM UTASS(C)
1441 JDF3A1: SETOM UDPWF(C)
1442         SKIPGE DG2(C)
1443         JRST JDF6
1444 JDF3A:  SETOM DG2(C)    ;FLAP UNIT INC(KNOWING WHERE IT IS)
1445         MOVE E,EUPOS(C)
1446         IMULI E,50.     ;50 MS/BLOCK
1447         IDIVI E,33.     ;33 MS/(1/2 SEC)
1448         ADDI E,30.      ;15 SECS EXTRA
1449         ADD E,TIME      ;NET TIME TO STOP FLAPPING
1450         TLO E,100000
1451         DPB E,[4200,,UFLAPF(C)]
1452         LSH C,9.
1453         CONO DTC,130000(C)      ;GO REVERSE
1454         PUSHJ P,JDDS
1455         JRST JDB3
1456
1457 JDF6:   HRRZS C
1458         SETOM UDIR(C)
1459         JRST JDB7
1460
1461 JDF4:   TLNE B,40000
1462         JRST JDF4A
1463         MOVEI A,230000  ;A SHOT OF FOWARD
1464         PUSHJ P,JDCNN   ;REEL WILL STOP
1465         AND B,[700000,,]
1466         ADD B,[40000,,2]
1467         ADD B,TIME
1468         MOVEM B,UFLAPF(C)
1469         JRST JDB3
1470
1471 JDF4A:  PUSHJ P,JDSTP
1472         CLEARM UFLAPF(C)
1473         CLEARM EUPOS(C)
1474         SETOM DG2(C)
1475         JRST JDF5
1476 \fJDB5:  HRRZ C,UTTM1
1477         MOVE E,UGOAL(C)
1478         CAML E,EUPOS(C)
1479         SKIPA B,[1]
1480         MOVNI B,1
1481         MOVEM B,UDIR(C)
1482 JDB7:   SKIPN B,UDIR(C)
1483         JRST 4,.        ;NOT TRYING TO GO
1484         MOVEI A,DCCHN_3
1485         SKIPN SUNIT
1486         JRST DCGB1
1487         CAME C,SUNIT
1488         JRST DCGB2
1489         CAMN B,OUDIR(C)
1490         TRO A,40000     ;INHIBIT START DELAY (SAME UNIT, SAME DIRECTION)
1491 DCGB1:  MOVEM C,SUNIT
1492         MOVEM B,OUDIR(C)
1493         TRNN A,40000
1494         TRO A,30000
1495         DPB C,[110300,,A]
1496         XCT UTST2(B)
1497         CONO DTS,770000
1498         MOVE C,[JSR TAPE]
1499         MOVEM C,DCMLOC
1500         MOVEM C,DCMLOC+1
1501         MOVE C,[JRST PIPOS]
1502         MOVEM C,UTP1
1503         JRST POPRET
1504
1505 DCGB2:  PUSHJ P,JDDS
1506         JRST DCGB1
1507
1508         CONO DTC,130200+UTCCHN+<DCCHN_3>(A)
1509 UTST:   CONO DTC,430000+UTCCHN+<DCCHN_3>(A)
1510         CONO DTC,230200+UTCCHN+<DCCHN_3>(A)
1511
1512         CONO DTC,130200+UTCCHN(A)
1513 UTST1:  CONO DTC,430000+UTCCHN(A)
1514         CONO DTC,230200+UTCCHN(A)
1515
1516         CONO DTC,100200+UTCCHN(A)
1517 UTST2:  CONO DTC,400000+UTCCHN(A)
1518         CONO DTC,200200+UTCCHN(A)
1519 };IFN NEWDTP
1520 \fIFE NEWDTP,{
1521
1522 ; T S UTAPE ROUTINES PI SERV (OLD UTAPE CONTROL)
1523
1524 JDENB==40000    ;ENABLE JOB DONE (CONO UTC,)
1525 20MSEN==5000    ;20MS, ENABLED (")
1526
1527 TAPE:   0
1528 UTP1:   0       ;DATAI DC, OR JRST UTP3
1529
1530 BBLK
1531
1532         SOS .-1
1533         AOSGE TAPCNT
1534         JRST 12,@TAPE
1535
1536
1537 UTP3:   SKIPN WRITE
1538         CONO DC,0
1539         CONO DC,400000  ;CLEAR PIA
1540         JRST 12,@TAPE
1541
1542 PIPOS:  CONSO DC,1000
1543         JRST PIPX
1544         SKIPN C,SUNIT
1545         JRST PIPOS8     ;NO UNIT SELECTED?
1546         DATAI DC,B      ;UNIT SELECTED, GET BLOCK NUMBER
1547         TDZE B,[1777#-1]        ;CLEAR OUT GARBAGE IN BLOCK NUMBER WORD
1548         JRST PIPOS7     ;GARBAGE THERE, BAD BLOCK NUMBER
1549         MOVEM B,EUPOS(C)        ;STORE POSITION
1550         HRRZM C,DG2(C)  ;SIGNAL EUPOS IS ACCURATE
1551         SKIPGE UGOAL(C) ;GOING SOMEWHERE?
1552         JRST PIPF1      ;NO
1553         SUB B,UGOAL(C)  ;GET CURRENT - DESIRED
1554         JUMPE B,PIPOS2  ;JUMP IF THERE
1555         ADD B,UDIR(C)
1556         MOVMM B,UTENB
1557         SKIPGE ULDCH(C)
1558         JRST PIPOS3
1559         JUMPN B,PIPOS3
1560 PIPOSL: MOVE A,SUNITL   ;HOLD DC
1561         MOVE B,UDIR(C)
1562         XCT UTST(B)
1563         CONO DC,4010+UTCCHN
1564 PIPOS5: JRST PIPX
1565
1566 PIPOS7: AOS BDBLKC
1567         JRST PIPOSL
1568
1569 EBLK
1570
1571 BDBLKC: 0
1572 \f
1573 BBLK
1574
1575 PIPOS3: MOVE A,UDIR(C)
1576         LSH A,2
1577         SUB B,A
1578         XOR B,UDIR(C)
1579         MOVE A,SUNITL
1580         JUMPG B,PIPOS4  ;GOING WRONG DIR
1581 PIPF2:  TRO A,JDENB     ;ENB JD SO NEXT BREAK TO UTC ON BLOCK
1582 PIPOS6: MOVE B,TIME
1583         MOVEM B,ULCTM(C)
1584         ADD B,UTENB
1585         MOVEM B,DRTM(C)
1586         MOVE B,UDIR(C)
1587         XCT  UTST(B)
1588 PIPOS8: CONO DC,0
1589         JRST PIPOS5
1590
1591
1592
1593 PIPF1:  MOVE A,SUNITL
1594         JRST PIPF2
1595 \f
1596 PIPOS4: CLEARM DG2(C)
1597         MOVNS UDIR(C)
1598         TRO A,6000
1599         JRST PIPOS6
1600
1601 PIPOS2: HLRZ A,ULDCH(C) ;TAPE NOW POSITIONED
1602         SKIPL ULDCH(C)
1603         SKIPGE UTRAC(A)
1604         JRST PIPOS3     ;CHANNEL LOCKED
1605         SETOM UTLDD(A)  ;CHANNEL ACTUALLY LOADED TRANSFER IMMINENT
1606         AOS SMODE
1607         MOVE A,SUNITL
1608         MOVE B,UMEMAD(C)
1609         SKIPGE URDWR(C)
1610         TROA A,400
1611         TLZ B,(BLKO-BLKI)
1612         SKIPL UDIR(C)
1613         JRST TAPFOR
1614         TRO A,10000
1615         ADD B,[DATAI-BLKI 200]
1616         MOVEM B,UTP1
1617         MOVNI B,200
1618         MOVEM B,TAPCNT
1619
1620
1621 TAP4:   CONO UTC,360300+UTCCHN(A)
1622         MOVE B,URDWR(C)
1623         MOVEM B,WRITE
1624         CONO DC,400000+DCCHN    ;GIVE CHN FOR READ
1625         SKIPGE B
1626         CONO DC,3410+DCCHN
1627         JRST PIPX
1628
1629
1630 TAPFOR: HRRM B,TAPCNT
1631         HRRI B,TAPCNT
1632         MOVEM B,DCMLOC
1633         MOVE B,[-200,,UTP3]
1634         HRRM B,UTP1
1635         HLLM B,TAPCNT
1636         JRST TAP4
1637 \f
1638 UTERR:  CONSZ UTC,4000  ;CHECK TIME ENABLE
1639         CONSO UTS,20    ;CHECK TIME FLAG
1640         JRST .+2
1641         JRST UTCB1      ;ELIMINATE TIMING ERROR IF FLAG COMES ON
1642         CONI UTS,E
1643         SKIPL SMODE
1644         JRST UDATER     ;DATA ERROR
1645         CONO DC,0
1646         SKIPN C,SUNIT
1647         JRST JDB3       ;NO UNIT SELECTED, IGNORE ERROR
1648         SETOM DG2(C)
1649         SKIPL UFLAPF(C)
1650         JRST UTER6      ;NOT FLAPPING
1651         CLEARM UFLAPF(C)        ;ERROR WHILE FLAPPING, JUST FORGET ABOUT IT
1652         CLEARM EUPOS(C)
1653         CLEARM UDIR(C)
1654         JRST JDB3
1655 UTER6:  AOS UTERP(C)    ;INCREMENT ERROR COUNT
1656         HRLM E,UTERP(C) ;STORE UTS CONI
1657         MOVE B,UDIR(C)
1658         TRZ E,7650      ;CLEAR RANDOMNESS, WRITE, PARITY ERROR
1659         JUMPE E,JDB3    ;JUMP ON ONLY PARITY ERROR (IF ANYTHING), TRY AGAIN NOW
1660         TRNN E,2        ;CHECK EOT FLAG
1661         JRST UTER1      ;NOT SET
1662         MOVNS B,UDIR(C) ;EOT, WANT TO GO OTHER DIRECTION
1663         MOVEI A,0
1664         SKIPGE B
1665         MOVEI A,1103
1666         MOVEM A,EUPOS(C)        ;STORE NEW ESTIMATED POSIION
1667         MOVE A,TIME
1668         MOVEM A,ULCTM(C)
1669         MOVEM A,DRTM(C)
1670 UTER1:  JRST UTER3      ;GIVE MAX DELAY
1671
1672 UDATER: SETOM SMODE     ;DATA ERROR, TRY REPOSITIONING
1673         HLRZ D,ULDCH(C)
1674         CLEARM UTLDD(D)
1675         JRST JDB3
1676
1677 \fUTCB0: MOVE C,SUNIT
1678         CONSZ UTC,4000
1679         CONSO UTS,20
1680         JRST JDBRK      ;NOT TIME FLAG
1681 UTCB1:  MOVE A,SUNITL
1682         MOVE B,UDIR(C)
1683         AOSN UTHERR     ;HANG UP ERROR SENT FOR SLOW CLOCK ROUTINE
1684         JRST UTERR
1685         AOSN USTSW
1686         JRST DCGBL1
1687         AOSN USTPF
1688         JRST JDB7D
1689         MOVEI C,0
1690         EXCH C,FLPUNT
1691         JUMPN C,JDF8
1692         EXCH C,STPUNT
1693         JUMPN C,JDB4B
1694         JRST JDB3
1695
1696
1697 JDDT3:  MOVE A,EUPOS(C)
1698         SUB A,UGOAL(C)
1699         MOVMS E,A
1700         ADD A,TIME
1701         MOVEM A,DRTM(C)
1702         MOVE C,[-NUNITS,,1]
1703         MOVM B,DRTM(C)
1704         CAMGE B,TIME
1705         JRST JDB3       ;SOMETHING ELSE DUE
1706         AOBJN C,.-3
1707         MOVE C,SUNIT
1708         MOVE B,UDIR(C)
1709         MOVE A,SUNITL
1710         SOJLE E,DCGBL1  ;RELOADING FOR NEXT BLOCK
1711         JRST JDB3
1712
1713 \f
1714 ILLP:   MOVEM D,UGOAL(C)        ;LOW PRIORITY POSIT ENTRY
1715         MOVSI A,(SETZ)
1716         IORM A,ULDCH(C)
1717
1718 UTDC:   SKIPGE UGOAL(C)
1719         POPJ P, ;UNIT IDLE
1720         SKIPGE DG2(C)
1721         JRST UTDC3
1722         MOVE A,EUPOS(C) ;ESTIMATE UNIT TIME AND UPDATE EUPOS
1723         SKIPG DG2(C)    ;SKIP ON EXACT POS KNOWN
1724         SKIPN UDIR(C)   ;SKIP ON UNIT RUNNING
1725         JRST UTDC4
1726         MOVE B,TIME
1727         SUBM B,ULCTM(C)
1728         EXCH B,ULCTM(C)
1729         IMUL B,UDIR(C)
1730         ADD A,B ;ACTUAL ESTIMATED POSITION
1731         MOVEM A,EUPOS(C)        ;UPDATE EUPOS
1732 UTDC4:  SUB A,UGOAL(C)
1733         MOVM B,A
1734         CAIG B,2
1735         JRST UTDC2
1736         ADD A,UDIR(C)
1737         MOVMS Aî
1738         CAMLE A,B
1739         SETZB A,B       ;GOING WRONG DIR
1740 UTDC2:  CAILE B,200.
1741         MOVEI B,200.    ;LIMIT LONGEST DEAD RECKON
1742         ADD B,TIME
1743         MOVEM B,DRTM(C)
1744         POPJ P,
1745
1746 UTDC3:  MOVEI B,0       ;NOT KNOWN EXACT POS REQUIRES IMMEDIATE ATTENTION
1747         JRST UTDC2
1748
1749 JDBRK:  CONSZ UTS,16    ;CHECK PARITY ERROR, ILLOP, EOT
1750         JRST UTERR
1751 JDBK1:  CONSZ UTS,1     ;SKIP ON NO JOB DONE
1752         CONSZ DC,7
1753         JRST POPRET     ;NO ERRS + HAS DC CHNL, GO AWAY
1754         SKIPL SMODE
1755         JRST JDDTA      ;DATA MODE
1756         JUMPE C,JDB3    ;POSITIONING, JUMP ON NO UNIT SELECTED
1757         MOVE A,UDIR(C)
1758         ADDM A,EUPOS(C)
1759         MOVE A,TIME
1760         MOVEM A,ULCTM(C)
1761         PUSHJ P,UTDC    ;COMPUTE DELAY
1762
1763 \fJDB3:  CONO DC,0
1764         HRLOI B,177777
1765         MOVEM B,UTTM2
1766         SETOM UTTM3     ;UNIT MOST URGENT
1767         CLEARM UTTM1    ;UNIT COULD START
1768         SETOM UTTM4     ;TAPE TO START FLAPPING
1769         SETOM UTTM5     ;TAPE TO STOP FLAPPED
1770         MOVE C,[-NUNITS,,1]
1771 JDBRK7: SKIPGE B,UFLAPF(C)
1772         JRST JDF1       ;FLAPPING OP
1773 JDF2:   SKIPL ULDCH(C)  ;SKIP ON LOW PRIOR POSIT
1774         SKIPGE UGOAL(C)
1775         JRST JDB6       ;UNIT FREE
1776 JDF2A:  SKIPGE DG2(C)
1777         SKIPN UDIR(C)
1778         JRST JDS1
1779         MOVEM C,UTTM1   ;UNIT IS RUNNING BLIND (OR NOT RUNNING)
1780         JRST JDBRK6
1781 JDS1:   SKIPE UDIR(C)
1782         JRST JDBRK4
1783         SKIPN UTTM1
1784         HRRZM C,UTTM1
1785         JRST JDBRK6
1786 JDBRK4: SKIPN UDIR(C)
1787         JRST ULLP       ;TAPE MAY NOT BE RUNNING IF IDLE
1788         MOVE B,DRTM(C)
1789         SUB B,TIME
1790         MOVE E,B
1791         SUB E,UTTM2
1792         JUMPL B,JDCV1   ;ALREADY OVERDUE
1793         MOVM D,E
1794         CAIG B,20.      ;CONFLICT MORE THAN 20 BLKS AWAY
1795         CAIL D,20.      ;THEY ARE SEPARETED BY 20 BLKS
1796         JRST JDCV1
1797         HRRZS C ;RELIEVE CONFLICT BY STOPPING UNIT DUE LATEST
1798         CAMG B,UTTM2
1799         HRRZ C,UTTM3
1800 JDF5:   CAME C,SUNIT
1801         SKIPN SUNIT
1802         JRST JDB4B      ;STOP UNIT
1803         MOVEM C,STPUNT
1804         JRST JDB7D      ;DESLECT FIRST
1805 JDCV1:  JUMPGE E,ULLP
1806         MOVEM B,UTTM2
1807         HRRZM C,UTTM3
1808 ULLP:   SKIPL ULDCH(C)
1809         JRST JDBRK6
1810         MOVE B,TIME
1811         SUB B,ULCTM(C)
1812         IMUL B,UDIR(C)
1813         SKIPE DG2(C)
1814         MOVEI B,0
1815         ADD B,EUPOS(C)
1816         SUB B,UGOAL(C)
1817         MOVMS B
1818         CAIGE B,10.
1819         PUSHJ P,ULLP1   ;TERM LOW PRIORITY DIRECTORY POS (COMMIT TO ACTUAL WRITE)
1820
1821
1822 \f
1823 JDBRK6: AOBJN C,JDBRK7
1824         MOVE C,UTTM3    ;MOST PRESSING RUNNING UNIT
1825         MOVE B,UTTM2
1826         CAIGE B,30.
1827         JRST JDB7       ;STAY WITH PRESSING UNIT
1828         SKIPE UTTM1
1829         JRST JDB5       ;START UNIT IF POSSIBLE
1830         SKIPL D,UTTM4
1831         JRST JDF3
1832 JDF6A:  SKIPL D,UTTM5
1833         JRST JDF4
1834         CAMG B,[10000000.]      ;SKIP ON ALL TAPES IDLE
1835         JRST JDB7
1836         SKIPE SUNIT
1837         JRST JDB7D
1838         SETOM UIDLE     ;NO UNIT SELECTED
1839         CONO UTC,0
1840         JRST POPRET
1841
1842 JDF1:   MOVE E,UDIRO(C)
1843         AOJE E,JDF1A
1844         TLNE E,100000
1845         JRST JDF2       ;DONT FLAP IF DIR NOT WRITTEN
1846 JDF1A:  SKIPGE UGOAL(C)
1847         SKIPGE ULDCH(C)
1848         JRST JDF2       ;FILE DIR WRITE IN PROG
1849         SKIPE UDIR(C)
1850         SKIPG DG2(C)
1851         JRST .+2
1852         JRST JDF3A      ;JUST READ IN TAPE POS
1853         TLNN B,100000
1854         HRRZM C,UTTM4   ;UNIT TO START FLAPPING
1855         LDB D,[4100,,B]
1856         TLNN B,100000
1857         JRST JDBRK6
1858         TLNN B,200000   ;ABORT FLAPPING
1859         CAMG D,TIME
1860         HRRZM C,UTTM5   ;UNIT TO STOP FLAPPING
1861         JRST JDBRK6
1862
1863 \f
1864 JDF3:   MOVE C,D
1865         MOVE A,UDIRO(C)
1866         AOJE A,JDF3A1
1867         TLNE A,10000
1868         JRST JDF3A2
1869         HRRZ A,ULDCH(C)
1870         LDB Q,[IOCH,,IOBFT(A)]
1871         CAIE Q,NUTIC+NUTOC
1872         JRST 4,.
1873         LDB Q,[IOLO,,IOBFT(A)]
1874         CAIE Q,(C)
1875         JRST 4,.
1876         PUSHJ P,IBRTN
1877 JDF3A2: SETOM UDIRO(C)
1878         SETZM UTASS(C)
1879 JDF3A1: SETOM UDPWF(C)
1880         SKIPGE DG2(C)
1881         JRST JDF6
1882 JDF3A:  SETOM DG2(C)
1883         MOVE E,EUPOS(C)
1884         IMULI E,50.
1885         IDIVI E,33.
1886         ADDI E,30.
1887         ADD E,TIME
1888         DPB E,[4100,,UFLAPF(C)]
1889         MOVSI E,100000
1890         IORM E,UFLAPF(C)
1891         SKIPE SUNIT
1892         CAMN C,SUNIT
1893         JRST JDF8
1894         MOVEM C,FLPUNT
1895         JRST JDB7D
1896
1897 JDF8:   LSH C,3
1898         CONO UTC,235000+UTCCHN(C)
1899         JRST JDF9
1900
1901 JDF6:   SKIPE SUNIT
1902         CAMN C,SUNIT
1903         JRST .+2
1904         JRST JDB7D
1905         SETOB B,UDIR(C)
1906         MOVEM C,SUNIT
1907         DPB C,[30300,,SUNITL]
1908         JRST JDF6B
1909
1910 JDF4:   MOVE C,D
1911         CLEARM UFLAPF(C)
1912         CLEARM EUPOS(C)
1913         JRST JDF5
1914 \f
1915 JDB5:   HRRZ C,UTTM1
1916 JDB7:   EXCH C,SUNIT    ;SELECT UNIT IN C
1917         JUMPE C,JDB7A   ;NO UNIT SELECTED
1918         CAMN C,SUNIT
1919         JRST JDB7A
1920         PUSHJ P,URLS
1921         JUMPGE E,JDB7E  ;OK TO LEAVE IT ALONE, CLEAR SELECTION CYCLE
1922         SKIPN UDIR(C)
1923         JRST JDB7E
1924 JDB4B:  HRRZM C,SUNIT   ;ENTER UNIT STOPPING CYCLE
1925         DPB C,[30300,,SUNITL]
1926 JDB4A:  MOVE A,SUNITL
1927         SKIPG UDIR(C)
1928         TRO A,10000
1929         CONO UTC,205000+UTCCHN(A)       ;CLEAR GO BIT
1930         SKIPE DG2(C)
1931         JRST JDB4A1
1932         MOVE B,TIME
1933         SUB B,ULCTM(C)
1934         IMUL B,UDIR(C)
1935         ADDM B,EUPOS(C)
1936 JDB4A1: CLEARM UDIR(C)
1937         HRLOI B,177777
1938         MOVEM B,DRTM(C)
1939         SETOM DG2(C)
1940 JDF9:   SETOM USTPF     ;UNIT STOPPING CYCLE
1941         JRST POPRET
1942
1943 EBLK
1944
1945 USTPF:  0
1946 STPUNT: 0       ;UNIT TO STOP DUE TO CONFLICT
1947
1948 BBLK
1949
1950 JDB7E:  SKIPA A,C
1951 JDB7D:  MOVE A,SUNIT
1952         JUMPE A,JDB7D1
1953         SKIPLE DG2(A)
1954         CLEARM DG2(A)
1955 JDB7D1: CLEARM SUNIT    ;DESELECT CYCLE
1956         CONI UTC,A
1957         TRZ A,200070
1958         TRO A,5000
1959         CONO UTC,(A)
1960         JRST POPRET
1961
1962 \f
1963 JDB7A:  MOVE C,SUNIT
1964         MOVE A,EUPOS(C)
1965         SUB A,UDIR(C)
1966         SUB A,UDIR(C)
1967         MOVEI B,1
1968         CAML A,UGOAL(C)
1969         MOVNI B,1
1970         DPB C,[30300,,SUNITL]
1971         MOVE D,UDIR(C)
1972         MOVEM B,UDIR(C)
1973         CAME D,B
1974         JRST JDS4       ;CHANGING DIR (OR STARTING), ALLOW RELAY DLYS
1975 JDBK3A: MOVE E,DRTM(C)
1976         SUB E,TIME
1977 JDDT8:  MOVE A,SUNITL
1978 IFN IMXP,[
1979         SKIPL IMPXF
1980         SUBI E,2
1981 ]
1982         SKIPGE E
1983         MOVEI E,0
1984         SKIPL D,DG2(C)
1985         CAIG E,2
1986         JRST JDB3B
1987         CAIGE E,20
1988         JUMPE D,JDB3B   ;GETTING CLOSE READ BLOCK NO
1989 JDB3A:
1990 DCGBL2: TRO A,JDENB
1991 JDB8A:  XCT UTST(B)
1992         JRST POPRET
1993
1994 \f
1995
1996 JDB3B:
1997 DCGBL1: XCT UTST(B)
1998         MOVE C,[JSR TAPE]
1999         MOVEM C,DCMLOC
2000         MOVEM C,DCMLOC+1
2001         MOVE C,[JRST UTP1]
2002         MOVEM C,UTP1
2003         CONO DC,4010+UTCCHN
2004         JRST POPRET
2005
2006
2007
2008         CONO UTC,330200+UTCCHN(A)
2009 UTST:   CONO UTC,5000+UTCCHN(A)
2010         CONO UTC,320200+UTCCHN(A)
2011
2012
2013 JDS4:   JUMPN D,UTER3
2014         MOVE D,TIME
2015         MOVEM D,ULCTM(C)
2016 JDF6B:  SETOM USTSW     ;STARTING OUT
2017 UTER3:  MOVE A,SUNITL   ;PICK UP UNIT SELECT FIELD OF CONO
2018         TRO A,6000      ;SET FOR MAXIMUM DELAY
2019         JRST JDB8A
2020
2021 URLS:   SKIPE E,UDIR(C) ;SKIPN ON UNIT NOT RUNNING
2022         SKIPG E,DG2(C)  ;RELEASE UNIT IN C E HAS PREV STATE OF DG2
2023         POPJ P,
2024         JRST UTDC
2025 };IFE NEWDTP