system/salv.311

   1 ;;; -*- Mode: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 .SEE COPY       ;COPY BLOCK TO BLOCK
  19 .SEE DUP        ;DUPLICATE ENTIRE DISC PACK
  20 .SEE TRAN       ;LOAD FROM MAG TAPE UNIT 5
  21 .SEE UCOP       ;COPY UDIRS FROM DRIVE TO DRIVE
  22 .SEE ZAP        ;ZERO DIR BLOCKS, WRITE OUT EMPTY TUT,MFD, WRITE READIN BLOCK
  23 .SEE SPKID      ;SET PACK ID IN TUT
  24 .SEE DSKTST     ;SIMPLE DISK TEST (WRITE THEN READ)
  25 .SEE SEKTST     ;DISK TEST WHICH SEEKS BACK AND FORTH (DOES NO WRITING)
  26 .SEE MARK       ;FORMAT PACK
  27 .SEE MARK69     ;FINISH FORMATTING PACK
  28 .SEE MFDR       ;TRY TO RECONSTRUCT MFD FROM USER DIRS
  29 .SEE CHKR       ;SALVAGER
  30 .SEE GOGO       ;SALVAGER - (AUTO FOR ALL DRIVES)
  31 .SEE GETSTS     ;GET CONTROLLER AND CURRENT DRIVE STATUS
  32 .SEE RDHEAD     ;READ HEADER FROM TRACK
  33 .SEE LISTF      ;PRINT USER DIRECTORY ON LPTR
  34 .SEE UNLOCK     ;TEST & UNLOCK A BLOCK
  35 .SEE REMAP      ;REMAP PACK #S AND FIX UFDS
  36
  37 .SEE PUNCH      ;VARIABLE TO BE SET NON-ZERO IF COPYING OF TTY OUTPUT TO PAPER TAPE IS WANTED
  38 .SEE HCRASH     ;VARIABLE TO BE SET NON-ZERO IF DUP'ING A DISK AFTER HEAD CRASH
  39 .SEE NOQUES     ;IF NON-ZERO, NO QUESTIONS IN GOGOX MODE
  40 .SEE FERRS      ;COUNT OF CORRECTABLE ERRORS
  41 .SEE CERRS      ;COUNT OF ECC-CORRECTED ERRORS (RP04 ONLY)
  42 .SEE DUPRER     ;COUNT OF BLOCKS THAT COULDN'T BE READ IN `DUP'
  43 .SEE DUPWER     ;COUNT OF BLOCKS THAT COULDN'T BE WRITTEN IN `DUP'
  44
  45 IF1,    TITLE SALVATION
  46 IF2,[   PRINTX/SALVATION /
  47         .TYO6 .FNAM2
  48         PRINTX/
  49 /]
  50
  51 DEFINE SUBTTL A/
  52 TERMIN
  53
  54 ;AC'S
  55
  56 ZR=0
  57 A=1
  58 B=2
  59 C=3
  60 D=4
  61 N=5
  62 I=6
  63 Q=7
  64 H=10
  65 TT=11
  66 T=12
  67 W=13
  68 U=14
  69 J=15
  70 K=16
  71 P=17
  72
  73 SUBTTL CONFIGURATION
  74
  75 DEFINE IFCE A,B
  76 IFE SIXBIT/A/-SIXBIT/B/,TERMIN  ;SUBSTITUTE FOR IFSE THAT IGNORES CASE
  77
  78 ;OPTIONS
  79
  80 IF1,[
  81 PRINTX /Run under time-sharing? /
  82 .TTYMAC TS
  83  IRPS Z,,[YES Y AYE DA JA]
  84   IFCE Z,TS,{
  85         ITS==1
  86         IRPS ZZ,,[DC10P RP10P RH10P OLPTP NLPTP TTLPTP KL10P]
  87          ZZ==0
  88          TERMIN
  89         .ISTOP
  90         }
  91  TERMIN
  92 TERMIN
  93
  94 IFNDEF ITS,[            ;run stand alone
  95 ITS==0
  96 PRINTX /Which machine? /
  97 .TTYMAC MCHN
  98  IFCE MCHN,AIKA,[
  99         FIRSPK==1       ;first pack that must be mounted in gogo mode
 100         LASTPK==5       ;last pack that must be mounted in gogo mode
 101         NUDSL==440.
 102         DC10P==1
 103         RP10P==0
 104         RH10P==0
 105         T300P==0
 106         KL10P==0
 107         OLPTP==0        ;R.I.P.
 108         NLPTP==0
 109         TTLPTP==0
 110         TCMXH==55.
 111         LIGHTS==4       ;PI
 112         ];AIKA
 113  IFCE MCHN,ML,[
 114         FIRSPK==2
 115         LASTPK==3
 116         NUDSL==250.
 117         DC10P==0
 118         RP10P==1
 119         RH10P==0
 120         T300P==0
 121         KL10P==0
 122         OLPTP==0
 123         NLPTP==0        ;rest in pieces
 124         TTLPTP==0
 125         TCMXH==55.
 126         LIGHTS==4       ;PI
 127         ];ML
 128  IFCE MCHN,DM,[
 129         FIRSPK==17.
 130         LASTPK==21.
 131         NUDSL==200.
 132         DC10P==0
 133         RP10P==1
 134         RH10P==0
 135         T300P==0
 136         KL10P==0
 137         OLPTP==0
 138         NLPTP==0
 139         TTLPTP==100
 140         TCMXH==55.
 141         LIGHTS==4       ;PI
 142         ];DM
 143  IFCE MCHN,MC,[
 144         SA==105*2000    ; MC system is big, need to push SALV higher.
 145         FIRSPK==0
 146         LASTPK==1
 147         NUDSL==500.
 148         DC10P==0
 149         RP10P==0
 150         RH10P==1
 151         T300P==3        ;UNIT 3 IS FIRST T-300 UNIT
 152         KL10P==1
 153         OLPTP==0
 154         NLPTP==0
 155         TTLPTP==0       ;NO LPT AT ALL
 156         TCMXH==100.     ;LA36
 157         LIGHTS==500     ;KL-UDGE
 158         NDRIVE==6       ;8 DOESN'T FIT IN 128K
 159         NUNITS==6
 160         ];KL
 161 TERMIN
 162 IFNDEF FIRSPK, .FATAL UNKNOWN MACHINE "MCHN"
 163 ];IFNDEF ITS
 164
 165 ;Formerly we knew number of units, now these are set to maximum and at run
 166 ; time we find out which units are present and on-line with the right packs.
 167 IFNDEF NDRIVE, NDRIVE==8        ;# physical units
 168 IFNDEF NUNITS, NUNITS==8        ;# virtual units
 169
 170 IFE NUNITS-NDRIVE,[     ;Hack for virtual units in pre-Calcomp AI-KA system.
 171  DEFINE UNTMES A/
 172  TYPE A
 173  TERMIN
 174 ]
 175 IFN NUNITS-NDRIVE,[
 176  DEFINE UNTMES A/
 177   DEFINE ZZQ UNIT
 178    TYPE A
 179   TERMIN
 180   ZZQ [VIRTUAL UNIT]
 181  TERMIN
 182 ]
 183 \f
 184 ;MACROS FOR CONDITIONALIZATION
 185
 186 DEFINE TS
 187 IFN ITS!TERMIN
 188
 189 DEFINE NTS
 190 IFE ITS!TERMIN
 191
 192 DEFINE DC
 193 IFN DC10P!TERMIN
 194
 195 DEFINE RP
 196 IFN RP10P!TERMIN
 197
 198 DEFINE RH
 199 IFN RH10P!TERMIN
 200
 201 DEFINE KA
 202 IFE KL10P!TERMIN
 203
 204 DEFINE KL
 205 IFN KL10P!TERMIN
 206
 207 DEFINE INSIRP I,[X]
 208 IRPS Z,,X
 209  I,Z
 210 TERMIN
 211 TERMIN
 212
 213 DEFINE INFORM A,B,C,D,E,F,G
 214 PRINTX \A!B!C!D!E!F!G
 215 \
 216 TERMIN
 217
 218 DEFINE CONC A,B
 219 A!B!TERMIN
 220
 221 DEFINE STRA C/
 222         MOVE A,[440700,,[ASCIZ \C\]]
 223 TERMIN
 224
 225 DEFINE LPR B/
 226         JSR LOUTST
 227          [ASCIZ \B\]
 228 TERMIN
 229
 230 DEFINE TYPE TXT/
 231         JSR TOUTST
 232          [ASCIZ \TXT\]
 233 TERMIN
 234
 235 TS      INFORM Runs under time-sharing on any machine
 236 DC      INFORM Systems Concepts disk control
 237 RP      INFORM DEC RP10 disk control
 238 RH      INFORM DEC RH10 disk control
 239         INFORM Number of drives=,\ndrives
 240 ;       INFORM Number of virtual units=,\nunits
 241 KA      INFORM KA-10
 242 KL      INFORM KL-10
 243 IFN OLPTP, INFORM Old LPT Interface
 244 IFN NLPTP, INFORM New LPT Interface
 245 IFN TTLPTP, INFORM LPT on MTY line number ,\TTLPTP&77
 246 TS, T300P==0
 247 IFN T300P, INFORM Support for Trident T-300 via PDP-11
 248 ];IF1
 249
 250 MEMSIZ==1000000
 251 IFNDEF SA,SA==100*2000
 252
 253 NLPT=464        ;device code of ML lpt
 254 MTY==400        ;device code of scanner
 255
 256 APR==0
 257 PI==4
 258 KA, TTY==120
 259 KA, PTP==100
 260 IFN T300P, DLB==60      ;DL-10
 261 .ALSO      DLC==64
 262
 263 X=PUSHJ P,
 264
 265 NTS,[   LOC SA
 266         JRST GOGO       ;make easy to start from ITS core load
 267 SALVRT: 0               ;system may JSR here
 268         JRST SALVAG
 269 ];NTS
 270 \f
 271 ;DISK PHYSICAL PARAMETERS
 272
 273 DC,[
 274         .INSRT SYSTEM;DC10 >
 275 ]
 276 RP,[
 277         .INSRT SYSTEM;RP10 >
 278 ]
 279 RH,[
 280         .INSRT SYSTEM;RH10 >
 281 ]
 282 TS,     NTUTBL==4       ;MAXIMUM NUMBER OF BLOCKS PER TUT ON ANY ITS
 283
 284 ;FILE SYSTEM PARAMETERS
 285
 286 .INSRT SYSTEM;FSDEFS >
 287
 288 IFN T300P,[
 289
 290                 ;DL10 COMMUNICATIONS AREA IN NON-ENCACHED LOW CORE
 291 DL10AR==500     ;ACTUAL STORAGE LAYOUT DEFINED IN ITS AND IN T300 DEFS
 292
 293         .INSRT SYSTEM;T300 >
 294 MXTUTB==NTUTB1  ;MAXIMUM OF NTUTBL AND NTUTB1
 295 ];T300P
 296 .ELSE MXTUTB==NTUTBL
 297
 298 DC,[
 299 DEFINE QCOPY A,B
 300 DCOPY A(-<B>_2&37774)!TERMIN
 301 ];DC
 302
 303 ;DEFINE CHANNEL PROGRAM AREA
 304
 305 NTS,[
 306 KL,[
 307         .INSRT SYSTEM;EPT >
 308
 309 ZZ==.
 310         LOC EPTDDT
 311         JRST MEMSIZ-4000        ;FOR 'DDT' COMMAND IN KLDCP
 312 LOC ZZ
 313
 314 PAG==10
 315 ..D010==0
 316 SWPIA=701440,,0
 317 SWPUO=701740,,0
 318 SWPIO=701640,,0
 319 SWPUA=701540,,0
 320 ];KL
 321 KA,[
 322 SLVICWA=20
 323 SLVIOWD=22
 324 ];KA
 325 ];NTS
 326
 327 TS,[
 328 TYIC==1
 329 TYOC==2
 330 LPTC==3
 331 QIN==4
 332 ]
 333
 334 IF2,[
 335 TS,[    NBLKS==10000.   ;FAKE
 336         TBLKS==10000.   ;FAKE
 337         MFDBLK==-1      ;JUST TO AVOID UNDEF SYM ERROR, VALUE NEVER USED
 338 ;       TUTBLK==-1      ;..
 339 ];TS
 340 ];IF2
 341 \f
 342 SUBTTL COPY BLOCK TO BLOCK
 343
 344 NTS,[
 345
 346 COPY:   JSR INIT
 347         PUSHJ P,CRR
 348         UNTMES COPY BLOCK FROM UNIT #
 349         PUSHJ P,NTYI
 350          JRST COPY
 351         CAIL A,NUNITS
 352          JRST COPY
 353         MOVEM A,FROM
 354         MOVE I,A
 355         PUSHJ P,RESET
 356 CP1:    PUSHJ P,CRR
 357         TYPE BLOCK #
 358         PUSHJ P,OTYI
 359         CAIL A,TBLKS
 360          JRST CP1
 361         MOVEM A,FMBLK
 362 CP2:    PUSHJ P,CRR
 363         UNTMES ONTO UNIT #
 364         PUSHJ P,NTYI
 365          JRST CP2
 366         CAIL A,NUNITS
 367          JRST CP2
 368         MOVEM A,TOU
 369         MOVE I,A
 370         PUSHJ P,RESET
 371         PUSHJ P,CRR
 372 CP3:    TYPE BLOCK #
 373         PUSHJ P,OTYI
 374         PUSHJ P,CRR
 375         CAIL A,TBLKS
 376          JRST CP3
 377         MOVEM A,TOBLK
 378         MOVEI A,TUT
 379         MOVE J,FMBLK
 380         MOVE I,FROM
 381         PUSHJ P,READ
 382         JUMPL T,CPERR
 383 COPYB:  MOVEI A,TUT             ;HANDY PLACE FOR A BREAKPOINT
 384         MOVE J,TOBLK
 385         PUSHJ P,WRITT
 386         JRST DDT
 387
 388 DTYI:   MOVEI B,0               ;DECIMAL TYPEIN
 389 DTYI1:  X NTYI
 390          JRST DTYI2
 391         IMULI B,10.
 392         ADD B,A
 393         JRST DTYI1
 394
 395 DTYI2:  MOVE A,B
 396         POPJ P,
 397
 398 OTYI:   MOVEI B,0               ;OCTAL TYPEIN
 399 OTYI1:  X NTYI
 400          JRST DTYI2
 401         LSH B,3
 402         ADD B,A
 403         JRST OTYI1
 404
 405 CPERR:  TYPE READ ERROR
 406         X CRR
 407         JRST DDT
 408 \f
 409         SUBTTL TEST AND UNLOCK SOME BLOCKS
 410
 411 UNLOCK: JSR INIT
 412         X CRR
 413         UNTMES UNLOCK BLOCKS ON UNIT #
 414         X NTYI
 415          JRST UNLOCK
 416         CAIL A,NUNITS
 417          JRST UNLOCK
 418         MOVEM A,FROM
 419         MOVE I,A
 420         X RESET
 421 UNLK1:  X CRR
 422         TYPE BLOCK #
 423         X OTYI
 424         PUSHJ P,UNLOCB
 425          JFCL
 426         JRST UNLK1              ;USE ^Z TO GET OUT
 427
 428 ;UNLOCK A BLOCK, NUMBER IN A, UNIT IN FROM
 429
 430 UNLOCB: INSIRP PUSH P,[J K Q D B TT]
 431         MOVE J,A
 432         MOVEM J,FMBLK
 433         SETZM CYLBUF                    ;ZERO OUT IN CASE CAN'T READ
 434         MOVE A,[CYLBUF,,CYLBUF+1]
 435         BLT A,CYLBUF+4000-1
 436         MOVE I,FROM
 437         MOVEI A,CYLBUF
 438         PUSHJ P,READ
 439         JUMPGE T,UNLK2
 440         TYPE READ ERROR
 441         X CRR
 442         X GSTS
 443         TYPE PROCEED?
 444         X Y.OR.N
 445          JRST UNLOCX
 446 UNLK2:  MOVE A,[RXWDS,,WXWDS]
 447         BLT A,WXWDS+4-1
 448         MOVEI A,CYLBUF
 449         X WRITE
 450         JUMPL T,WRERR
 451         MOVEI A,CYLBUF+2000
 452         X READ
 453         JUMPL T,[TYPE READ-BACK ERROR
 454                  X CRR
 455                  X GSTS
 456                  JRST UNLOCX]
 457         MOVSI T,-2000
 458 UNLK3:  MOVE TT,CYLBUF(T)
 459         CAME TT,CYLBUF+2000(T)
 460          JRST [ TYPE READ-BACK COMPARE ERROR
 461                 X CRR
 462                 JRST UNLOCX]
 463         AOBJN T,UNLK3
 464
 465         MOVEI A,TUT
 466         X RDTUT
 467         JUMPL T,CPERR
 468         MOVE J,FMBLK
 469         MOVEI B,TUT
 470         X TUTPNT
 471         JUMPE J,[ TYPE CAN'T ACCESS TUT
 472                   X CRR
 473                   JRST UNLOCX ]
 474         MOVEI B,1               ;SAFEST ... NEXT SALVAGE WILL PUT CORRECT VALUE
 475         DPB B,J
 476         MOVEI A,TUT
 477         X WRTUT
 478         JUMPL T,WRERR
 479         AOS -6(P)               ;WINNING, SKIP RETURN
 480 UNLOCX: INSIRP POP P,[TT B D Q K J]
 481         POPJ P,
 482
 483 WRERR:  TYPE WRITE ERROR
 484         JRST CRDDT
 485 \f
 486 SUBTTL DUP - COPY ENTIRE PACK
 487
 488 DUP1A:  PUSHJ P,CRR
 489 DUP1:   UNTMES  FROM UNIT #
 490         PUSHJ P,NTYI
 491          JRST DUP1A
 492         CAIL A,NUNITS
 493          JRST DUP1A
 494         MOVE I,A
 495         PUSHJ P,RESET
 496 DUP2:   MOVEM A,FROM
 497 TO:     PUSHJ P,CRR
 498         UNTMES ONTO UNIT #
 499         PUSHJ P,NTYI
 500          JRST TO
 501         CAIL A,NUNITS
 502          JRST TO
 503         MOVEM A,TOU
 504         X CRR
 505         UNTMES COPY FROM UNIT #
 506         MOVE A,FROM
 507         X DPT
 508         UNTMES  ONTO UNIT #
 509         MOVE A,TOU
 510         X DPT
 511         TYPE , OK?
 512         X Y.OR.N
 513          JRST DDT
 514         MOVE I,TOU
 515         PUSHJ P,RESET
 516         POPJ P,
 517
 518 DUP:    JSR INIT
 519         SETZM USRDS'
 520         SETZM USWRTS'
 521         SETZM DUPRER
 522         SETZM DUPWER
 523 RH,     SETZM CERRS
 524         TYPE DUPLICATE DISK
 525         PUSHJ P,DUP1
 526         MOVE I,FROM
 527 DC,     MOVE A,QTRAN(I)
 528 DC,     DPB A,[DUNFLD CYLRIR]
 529 RP,     MOVE I,TOU
 530 .ELSE [ MOVE A,PKNUM(I)
 531         MOVE I,TOU
 532         CAME A,PKNUM(I)
 533          JRST DUPLUZ
 534 ]DC,    MOVE A,QTRAN(I)
 535 DC,     DPB A,[DUNFLD CYLRIW]
 536         MOVEI J,NCYLS+XCYLS-1   ;DETERMINE HOW MANY CYLINDERS THIS DRIVE
 537 RP,[    MOVSI A,(DNOOPC)
 538         DPB I,[DUNFLD A]        ;SELECT DESTINATION DRIVE
 539         DATAO DPC,A
 540         DATAI DPC,B
 541         MOVE I,FROM
 542         DPB I,[DUNFLD A]        ;SELECT SOURCE DRIVE
 543         DATAO DPC,A
 544         DATAI DPC,A
 545         XOR A,B
 546         TRNE A,2000
 547          JRST [ TYPE CAN'T COPY RP02 TO RP03 OR VICE VERSA
 548                 JRST CRDDT ]
 549         TRNE B,2000
 550          MOVEI J,MCYLS+XCYLS-1  ;DRIVES ARE RP03S, MORE CYLINDERS TO COPY
 551 ];RP
 552 IFN T300P,[
 553         CAIL I,T300P
 554          JRST T3DUP             ;HAVE TO DO IT THE SLOW WAY
 555         MOVE I,FROM
 556         CAIL I,T300P
 557          JRST [ TYPE CAN ONLY GO T-300 TO T-300
 558                 JRST CRDDT ]
 559 ];T300P
 560         MOVEI A,CYLBUF
 561 DLUP:   MOVE I,FROM
 562         PUSHJ P,READCY
 563         JUMPL T,DLUP1           ;LOST, TRY BLOCK AT A TIME
 564         MOVE I,TOU
 565         PUSHJ P,WRITCY
 566         JUMPL T,DLUP1
 567 DLUP2:  SOJGE J,DLUP
 568 DC,     MOVEI T,CYLRIR          ;COPY READ-IN BLOCK
 569 DC,     PUSHJ P,RW0
 570 RH,[    SKIPN A,CERRS
 571          JRST DDT
 572         X TDPT
 573         TYPE  ECC-CORRECTED ERRORS.
 574         JRST CRDDT
 575 ]
 576 .ELSE   JRST DDT
 577
 578 DUPLUZ: TYPE PACK # DFRS
 579         PUSHJ P,CRR
 580         JRST DDT
 581 \f
 582 IFN T300P,[
 583 T3DUP:  MOVE I,FROM
 584         CAIGE I,T300P
 585          JRST [ TYPE CAN ONLY GO T-300 TO T-300
 586                 JRST CRDDT ]
 587         TYPE THIS WILL TAKE A WHILE...
 588         X CRR
 589         MOVEI J,NBLKS1+XBLKS1-1
 590 T3DUP1: MOVEI A,CYLBUF
 591         MOVE I,FROM
 592         X READ
 593         JUMPL T,CPERR
 594         MOVE I,TOU
 595         X WRITE
 596         JUMPL T,WRERR
 597         SOJGE J,T3DUP1
 598         JRST CRDDT
 599 ];T300P
 600
 601 IFE RH10P,[                     ;BLOCK AT A TIME
 602 DLUP1:  PUSH P,J
 603         IMULI J,NBLKSC
 604         CLEARM DLUPT
 605 DLUP3:  MOVE I,FROM
 606         MOVEI A,CYLBUF
 607         PUSHJ P,READ
 608         JUMPL T,DLUPE1
 609         MOVE I,[RXWDS,,WXWDS]
 610 DLUPEW: BLT I,WXWDS+4-1
 611         PUSHJ P,WRITT
 612         JUMPL T,DLUPE2
 613 DLUPEX: AOS TT,DLUPT
 614         CAIGE TT,NBLKSC
 615          AOJA J,DLUP3
 616         POP P,J
 617         JRST DLUP2
 618 ]
 619 RH,[                            ;SECTOR AT A TIME ON RP04 SO GET EXTRA SECTORS
 620 DLUP1:  MOVEI T,NHEDS*NSECS
 621         MOVEM T,DLUPT
 622 DLUP3:  SOS W,DLUPT             ;NEXT SECTOR (GOING BACKWARDS THROUGH CYLINDER)
 623         IDIVI W,NSECS           ;TRACK IN W, SECTOR IN U
 624         LSH W,8
 625         IOR W,U
 626         HRL W,J                 ;NOW W HAS DISK ADDRESS
 627         MOVEM W,RHPGA
 628         MOVE U,[-200,,CYLBUF-1]
 629         MOVEM U,RHIOW
 630         MOVE I,FROM
 631         MOVEI TT,%HMRED
 632         MOVEM TT,RHCMD
 633         PUSHJ P,RW1
 634         JUMPL T,DLUPE1
 635 DLUPEW: MOVE I,TOU
 636         MOVEI TT,%HMWRT
 637         MOVEM TT,RHCMD
 638         PUSHJ P,RW1
 639         JUMPL T,DLUPE2
 640 DLUPEX: SKIPE DLUPT
 641          JRST DLUP3
 642         JRST DLUP2
 643 ];RH
 644
 645 DLUPT:  0
 646
 647 DLUPE1: AOS DUPRER
 648         SKIPE HCRASH
 649          JRST DLUPE4            ;SPEED IS OF THE ESSENCE, DON'T TYPE ANYTHING
 650         TYPE Read error on block #
 651         PUSHJ P,DLUPE3
 652 DLUPE4: SETZM CYLBUF            ;COULDN'T READ THE BLOCK, SUBSTITUTE ALL ZEROS
 653         MOVE A,[CYLBUF,,CYLBUF+1]
 654         BLT A,CYLBUF+2000-1
 655         MOVE I,[DLUPE5,,WXWDS]  ;WITH SPECIAL EXTRA WORDS
 656         JRST DLUPEW             ;RESUME DLUP AT WRITE
 657
 658 DLUPE3: MOVE A,I
 659         X DPT
 660         MOVEI A,"-
 661         X TYO
 662 IFE RH10P, MOVE A,J
 663 IFN RH10P,[
 664         HLRZ A,RHPGA            ;CYLINDER
 665         IMULI A,NBLKSC
 666         LDB W,[101000,,RHPGA]   ;HEAD
 667         IMULI W,NSECS
 668         LDB U,[001000,,RHPGA]   ;SECTOR
 669         ADD W,U
 670         IDIVI W,SECBLK
 671         ADD A,W                 ;INACCURATE IF UNUSED SECTOR AT END OF CYLINDER
 672 ];RH10P
 673         PUSHJ P,DPT
 674         PUSHJ P,CRR
 675         JRST GSTS               ;HARDWARE STATUS
 676
 677 DLUPE2: AOS DUPWER
 678         SKIPE HCRASH
 679          JRST DLUPEX            ;SPEED IS OF THE ESSENCE, DON'T TYPE ANYTHING
 680         TYPE Write error on block #
 681         PUSHJ P,DLUPE3
 682         JRST DLUPEX
 683
 684 ;SUITABLE EXTRA WORDS FOR BLOCKS THAT COULDN'T BE READ
 685
 686 DLUPE5: 0                       ;WORD COUNT=2000, LAST BLOCK=0
 687         SIXBIT /??????/         ;DUMMY DIRECTORY
 688         SIXBIT /(DISK)/
 689         SIXBIT/LOSSAG/
 690 \f
 691 DC,[    SUBTTL CYLINDER I/O, DC10
 692 READCY: SKIPA T,[DREADC+DUNENB]         ;READ CONTINUOUS
 693 WRITCY: MOVSI T,(DWRITC+DUNENB)         ;WRITE CONTINUOUS
 694         MOVE TT,QTRAN(I)
 695         DPB TT,[DUNFLD T]
 696         MOVE TT,J
 697         SKIPGE QTRAN(I)
 698          ADDI TT,NCYLS+XCYLS
 699         DPB TT,[DCYL T]
 700         DPB TT,[DCYL CYLCM3]
 701 CYL1:   SKIPLE TT,PKNUM(I)
 702          JRST CYL2
 703         PUSH P,T
 704         PUSHJ P,RESET
 705         POP P,T
 706         JRST CYL1
 707
 708 CYL2:   CAIL J,NCYLS
 709          MOVEI TT,0
 710         DPB TT,[DPKID T]
 711         DPB TT,[DPKID CYLCM3]
 712         MOVEM T,CYLCOM
 713         DPB A,[DCCA CYLCM1]
 714         DPB A,[DCCA CYLCM2]
 715         MOVEI T,CYLCOM
 716 RW0:    HRRM T,DGO
 717         JRST RW1                ;TRY TRANSFER UNTIL SUCCEEDS
 718
 719 CYLCOM: 0
 720         DALU+DLDBWC+DLLB -2004*NBLKSC(3)        ;LOAD WORD COUNT WITH -2004*NO. OF BLOCKS/CYL
 721 CYLCM1: DCOPY .
 722 CYLCM3: DRCC                    ;READ COMPARE CONTINUOUS
 723         DALU+DLDBWC+DLLB -2004*NBLKSC(3)
 724 CYLCM2: DCCOMP .
 725         DHLT
 726
 727 CYLRIR: DREAD+DUNENB
 728         DCOPY CYLBUF(-LRIBLK_2&37774)
 729 CYLRIW: DWRITE+DUNENB
 730         DCOPY CYLBUF(-LRIBLK_2&37774)
 731         DHLT
 732 ];DC
 733 \f
 734 RP,[    SUBTTL CYLINDER I/O, RP10 & RH10 CONTROLS
 735
 736 ;RP10 CYLINDER I/O ALWAYS SUCCEEDS.  IF PROBLEMS OCCUR, GOES SECTOR
 737 ;AT A TIME, TYPING OUT WHAT IS GOING ON, ZEROING SECTORS THAT CAN'T BE READ,
 738 ;THEN RETURNS CLAIMING TO HAVE WON.
 739 READCY: SKIPA T,DRD
 740 WRITCY:  MOVE T,DWR
 741         MOVEM T,RPIOOP
 742         MOVEM J,RPIOCY
 743         SETZM RPIOHD
 744         SETZM RPIOSC
 745         MOVEM A,RPAOBJ
 746         MOVNI T,NBLKSC*2000
 747         HRLM T,RPAOBJ
 748 RPCY0:  PUSHJ P,RPIO
 749         JUMPGE T,CPOPJ          ;WON
 750 IFN 0,[                         ;I DON'T THINK THIS CODE WORKS
 751         SKIPE HCRASH
 752          POPJ P,
 753         MOVE T,RPIOOP
 754         CAMN T,DWR
 755          JRST [ TYPE WRITE ERROR ON BLOCK
 756                 JRST .+3 ]
 757           TYPE READ ERROR ON BLOCK
 758         PUSH P,A
 759         PUSH P,B
 760         MOVE A,I
 761         X DPT
 762         TYPE -
 763         MOVE A,RPIOHD
 764         IMULI A,NSECS
 765         ADD A,RPIOSC
 766         IDIVI A,SECBLK
 767         MOVE B,RPIOCY
 768         IMULI B,NBLKSC
 769         ADD A,B
 770         X DPT
 771         X CRR
 772         POP P,B
 773         POP P,A
 774         PUSHJ P,GSTS            ;EXPLAIN WHAT HAPPENED TO THIS SECTOR
 775         MOVE T,RPIOOP           ;IF READ, ZERO THE BUFFER
 776         HRLZ TT,RPAOBJ          ;IF WAS REALLY IN SECTOR AT A TIME MODE
 777         CAMN T,DRD
 778          CAIE TT,-200
 779           JRST RPCY1
 780         MOVE TT,RPAOBJ
 781         SETZM (TT)
 782         HRLZ T,TT
 783         HRRI T,1(TT)
 784         BLT T,177(TT)
 785 RPCY1:  AOS T,RPIOSC            ;ADVANCE TO NEXT SECTOR
 786         CAIGE T,NSECS
 787          JRST RPCY2
 788         SETZM RPIOSC
 789         AOS T,RPIOHD
 790         CAIL T,NHEDS
 791          POPJ P,                ;MUST BE DONE
 792 RPCY2:  MOVE T,[200,,200]
 793         ADDB T,RPAOBJ
 794         JUMPL T,RPCY0           ;GO DO THE REST OF THE CYLINDER
 795 ];IFN 0
 796         POPJ P,                 ;HMM, MUST BE DONE
 797 ];RP
 798
 799 RH,[    ;CYLINDER I/O, RH10 CONTROL
 800
 801 READCY: SKIPA TT,[%HMRED]
 802 WRITCY:  MOVEI TT,%HMWRT
 803 IFN T300P,[
 804         CAIL I,T300P
 805          JRST 4,.               ;NOT CODED YET
 806         SETZM T3IOP
 807 ];T300P
 808         MOVEM TT,RHCMD
 809         HRLZM J,RHPGA           ;SET ADDRESS TO START OF CYLINDER
 810         MOVEI T,-1(A)           ;SET UP IOWD TO TRANSFER WHOLE CYLINDER
 811         HRLI T,-200*NHEDS*NSECS ;- NUMBER OF WORDS TO TRANSFER
 812         MOVEM T,RHIOW
 813         JRST RW1
 814 ];RH
 815 \f
 816 SUBTTL TRAN - LOAD FROM MAG TAPE
 817
 818 MAGOP:  AOSE ITAPE
 819          JRST MTR1
 820         HRROI A,MAGHD
 821         PUSHJ P,MREAD
 822         MOVE A,MAGHD
 823         TRNE A,-1
 824          JRST MBDTHD
 825         CAMGE A,[-LTHBLK,,]
 826          JRST MBDTHD
 827         ADD A,[1,,THBLK+1]
 828         PUSHJ P,MREAD
 829         TYPE TAPE #
 830         HLRZ A,THTPN
 831         PUSHJ P,TDPT
 832         PUSHJ P,CRR
 833
 834 MTR1:   HRROI A,MAGHD
 835         PUSHJ P,MREAD
 836         JUMPE T,CPOPJ           ;EOF
 837         MOVE A,MAGHD
 838         TRNE A,-1
 839          JRST MBADHD
 840         CAMGE A,[-LMHBLK,,0]
 841          JRST MBADHD
 842         ADD A,[1,,MHBLK+1]
 843         PUSHJ P,MREAD
 844         SETZM LNKFLG
 845         HLRZ B,MHPKN
 846         JUMPE B,POPJ1           ;NOT A LINK
 847         SETOM LNKFLG
 848         MOVE A,[-3,,LNKNM1]     ;READ LINK INFO
 849         PUSHJ P,MREAD
 850         JRST POPJ1
 851
 852 MBADHD: LPR BAD HEADER
 853         PUSHJ P,LCRR
 854         PUSHJ P,IGFIL
 855         JRST MTR1
 856
 857 MBDTHD: TYPE BAD TAPE HEADER
 858         JRST CRDDT
 859
 860 TRAN:   PUSHJ P,REW
 861 TRAN1:  JSR INIT
 862         PUSHJ P,CRR
 863         MOVEI I,0
 864 TRAN2:  SKIPGE QACT(I)
 865          PUSHJ P,RESET
 866         CAIGE I,NUNITS-1
 867          AOJA I,TRAN2
 868         MOVEI A,5               ;READS FROM TAPE UNIT 5
 869         PUSHJ P,DUP2
 870         MOVEI A,TUT
 871         MOVE I,TOU
 872         PUSHJ P,RDTUT
 873         JUMPL T,READC
 874         MOVEI A,MFD
 875         MOVE J,MFDBK
 876         PUSHJ P,READT
 877 \f
 878 TNAML:  PUSHJ P,MAGOP
 879          JRST MREOT
 880         MOVE A,MHFN1            ;DON'T RELOAD DIRECTORIES!
 881         MOVE B,MHFN2
 882         CAMN A,[SIXBIT/.FILE./]
 883          CAME B,[SIXBIT/(DIR)/]
 884           CAIA
 885            JRST TIGNF
 886         CAMN A,[SIXBIT/M.F.D./]
 887          CAME B,[SIXBIT/(FILE)/]
 888           SKIPA A,MHSNM
 889            JRST TIGNF
 890         PUSHJ P,SIXLPT
 891         PUSHJ P,LSPAC
 892         MOVE A,MHFN1
 893         PUSHJ P,SIXLPT
 894         PUSHJ P,LSPAC
 895         MOVE A,MHFN2
 896         PUSHJ P,SIXLPT
 897         PUSHJ P,LSPAC
 898         CLEARM FERRS
 899         MOVE B,MHSNM
 900         MOVE A,MFD+MDNAMP
 901         SETZM IBLK
 902 TMLKP:  CAIL A,2000
 903          JRST TNEWU
 904         SKIPN C,MFD+MNUNAM(A)
 905          JRST TMLKZ
 906         CAMN B,C
 907          JRST TOLDU
 908 TMLKL:  ADDI A,LMNBLK
 909         JRST TMLKP
 910
 911 TMLKZ:  MOVEM A,IBLK
 912         JRST TMLKL
 913
 914 TOLDU:  HRREI J,-2000(A)        ;CONVERT MFD INDEX TO BLOCK NO
 915         ASH J,-1
 916         ADD J,NUDS
 917         MOVEM J,UFDTA
 918         MOVEI A,NUSRD
 919         PUSHJ P,READT
 920         CAME B,NUSRD+UDNAME
 921          JRST 4,.
 922         JRST TOLDUR
 923
 924 TNEWU:  MOVE A,[NUSRD,,NUSRD+1]
 925         SETZM NUSRD
 926         BLT A,NUSRD+1777
 927         MOVEM B,NUSRD+UDNAME
 928         MOVEI A,2000
 929         MOVEM A,NUSRD+UDNAMP
 930         SKIPE A,IBLK
 931          JRST .+3
 932           MOVNI A,LMNBLK
 933           ADDB A,MFD+MDNAMP
 934         MOVEM B,MFD+MNUNAM(A)
 935         HRREI J,-2000(A)        ;CONVERT MFD INDEX TO BLOCK NO
 936         ASH J,-1
 937         ADD J,NUDS
 938         MOVEM J,UFDTA
 939 TOLDUR:\f
 940         MOVE B,MHFN1
 941         MOVE C,MHFN2
 942         MOVE A,NUSRD+UDNAMP
 943         SETZM IBLK
 944 TULKP:  CAIL A,2000
 945          JRST TNEWF
 946         MOVSI T,UNCDEL
 947         TDNE T,NUSRD+UNRNDM(A)
 948          JRST TULKD
 949         SKIPN T,NUSRD+UNFN1(A)
 950          JRST TULKZ
 951         CAME B,T
 952          JRST TULKL
 953         CAMN C,NUSRD+UNFN2(A)
 954          JRST TOLDF
 955 TULKL:  ADDI A,LUNBLK
 956         JRST TULKP
 957
 958 TULKZ:  SKIPN NUSRD+UNFN2(A)
 959 TULKD:   MOVEM A,IBLK
 960         JRST TULKL
 961
 962 TOLDF:  LPR EXISTS
 963         PUSHJ P,LCRR
 964 TIGNF:  PUSHJ P,IGFIL
 965         JRST TNAML
 966
 967 IGFIL:  MOVE A,[-2000,,FDBUF]
 968         PUSHJ P,MREAD
 969         SKIPN EOUF
 970          JRST IGFIL
 971         CLEARM EOUF
 972         POPJ P,
 973 \f
 974 TNEWF:  SKIPE A,IBLK
 975          JRST TNEWCK
 976         MOVNI A,LUNBLK
 977         ADDB A,NUSRD+UDNAMP
 978 TNEWCR: MOVE T,NUSRD+UDESCP
 979         IDIVI T,6
 980         CAIL T,-UDDESC(A)
 981          JRST 4,.
 982         MOVEM B,NUSRD+UNFN1(A)
 983         MOVEM C,NUSRD+UNFN2(A)
 984 DC,     MOVEM B,WXWDS+XWFN1
 985 DC,     MOVEM C,WXWDS+XWFN2
 986         MOVE B,NUSRD+UDNAME
 987 DC,     MOVEM B,WXWDS+XWSYSN
 988 DC,     SETZM WXWDS+XWBWC
 989         MOVE B,NUSRD+UDESCP
 990         DPB B,[UNDSCP NUSRD+UNRNDM(A)]
 991         MOVE B,MHDATE
 992         MOVEM B,NUSRD+UNDATE(A)
 993         SETOM NUSRD+UNREF(A)
 994         MOVE B,TUT+QPKNUM
 995         DPB B,[UNPKN NUSRD+UNRNDM(A)]
 996         MOVEI A,NUSRD+UNRNDM(A)
 997         HRLI A,(UNWRDC)
 998         MOVEM A,TRNDEP'         ;DPB WC OF LAST BLOCK LATER
 999         SETZM CBYT'
1000         SETZM OBLKS'
1001         SETZM IBLK'
1002         SETZM LBLK'
1003         SKIPE LNKFLG
1004          JRST TRNLNK            ;JUMP IF APPENDING LINK
1005 TBLKL:
1006 TBLKL1: MOVE A,[-2000,,FDBUF]
1007         PUSHJ P,MREAD
1008         JUMPE T,TBLKL2
1009 DC,     DPB T,[XWAWC WXWDS+XWBWC]
1010         DPB T,TRNDEP            ;STORE WORD COUNT IN DIRECTORY
1011         MOVE T,LBLK
1012 DC,     DPB T,[XWBLK WXWDS+XWBWC]
1013         AOS IBLK
1014         PUSHJ P,WRBLK
1015 TBLKL2: SKIPN EOUF
1016          JRST TBLKL
1017         SETZM EOUF
1018         JRST TBDON
1019
1020 TNEWCK: SKIPN NUSRD+UNFN1(A)
1021         SKIPE NUSRD+UNFN2(A)
1022          JRST 4,.
1023         JRST TNEWCR
1024
1025 TBDON:  PUSHJ P,EBYT
1026         MOVEI J,UDWPH
1027         SKIPN LBLK
1028          PUSHJ P,BYDEP
1029 TBDON1: MOVEI J,0
1030         PUSHJ P,BYDEP
1031         JRST TMDON
1032
1033 TRNLNK: MOVE A,LNKSNM
1034         PUSHJ P,TRNLK1
1035         MOVE A,LNKNM1
1036         PUSHJ P,TRNLK1
1037         MOVE A,LNKNM2
1038         PUSHJ P,TRNLK1
1039         JRST TBDON1
1040
1041 TRNLK1: MOVE K,A
1042         MOVEI A,6
1043 TRNLK2: MOVEI J,0
1044         LSHC J,6
1045         JUMPE J,TRNLK4
1046         CAIE J,':
1047         CAIN J,';
1048          JRST [ PUSH P,J
1049                 MOVEI J,':
1050                 PUSHJ P,BYDEP
1051                 POP P,J
1052                 JRST .+1 ]
1053         PUSHJ P,BYDEP
1054         SOJG A,TRNLK2
1055         POPJ P,
1056
1057 TRNLK4: MOVEI J,';
1058         JRST BYDEP
1059 \f
1060 READFN: SKIPA I,FROM
1061 READT:   MOVE I,TOU
1062         PUSHJ P,READ
1063 READC:  JUMPL T,[JRST 4,.]
1064         POPJ P,
1065
1066 WRBLK:  MOVE J,TUT+QTUTP
1067         AOS TUT+QTUTP
1068         CAML J,TUT+QLASTB
1069          JRST WRLUZ
1070         MOVEM J,LBLK
1071         SETZM TUTLUZ
1072         MOVEI B,TUT
1073         PUSHJ P,TUTPNT
1074         LDB B,J
1075         JUMPN B,WRBLK
1076         MOVEI B,1
1077         DPB B,J
1078         MOVE J,LBLK
1079         MOVEI A,FDBUF
1080         PUSHJ P,WRITT
1081         SUB J,OBLKS
1082         ADDM J,OBLKS
1083         CAIN J,1
1084          JRST WRBC
1085         PUSHJ P,EBYT
1086         CAIG J,UDWPH-UDTKMX
1087          JRST WRBS
1088         MOVE J,OBLKS
1089         LSHC J,-NXLBYT*6
1090         MOVEI U,NXLBYT+1
1091         ADDI J,UDWPH+1
1092 WRBL:   PUSHJ P,BYDEP
1093         LSHC J,6
1094         SOJG U,WRBL
1095         POPJ P,
1096
1097 WRLUZ:  SETCMB J,TUTLUZ'
1098         JUMPE J,WRLUZ1
1099         MOVE J,TUT+QSWAPA
1100         CAMGE J,TUT+QFRSTB
1101          MOVE J,TUT+QFRSTB
1102         MOVEM J,TUT+QTUTP
1103         JRST WRBLK
1104
1105 WRLUZ1: TYPE DISK FULL
1106         SKIPN NOLPT
1107          X LCRR
1108         JRST CRDDT
1109 \f
1110 WRBS:   ADDI J,UDTKMX-1
1111 BYDEP:  MOVE T,NUSRD+UDESCP
1112         AOS NUSRD+UDESCP
1113         IDIVI T,6
1114         ADDI T,UDDESC
1115         CAML T,NUSRD+UDNAMP
1116          JRST 4,.
1117         ADDI T,NUSRD
1118         HLL T,QBTBL(W)
1119         DPB J,T
1120         POPJ P,
1121
1122 WRBC:   AOS J,CBYT
1123         CAIGE J,UDTKMX
1124          POPJ P,
1125 EBYT:   PUSH P,J
1126         SKIPN J,CBYT
1127          JRST POPJJ
1128         PUSHJ P,BYDEP
1129         SETZM CBYT
1130 POPJJ:  POP P,J
1131         POPJ P,
1132
1133
1134 TMDON:  MOVE J,[WXWDS,,WXWDS+1]
1135         SETZM WXWDS
1136         BLT J,WXWDS+3
1137         MOVE A,TUT+QTUTP
1138         IDIVI A,NBLKSC
1139         IMULI A,NBLKSC
1140         MOVEM A,TUT+QTUTP
1141         MOVEI A,TUT
1142         MOVE I,TOU
1143         PUSHJ P,WRTUT
1144         MOVEI I,0
1145 TMDON2: SKIPL QACT(I)
1146          JRST TMDON1
1147         MOVE J,MFDBK
1148         MOVEI A,MFD
1149         PUSHJ P,WRITE
1150         MOVE J,UFDTA
1151         MOVEI A,NUSRD
1152         PUSHJ P,WRITE
1153 TMDON1: CAIGE I,NUNITS-1
1154          AOJA I,TMDON2
1155         SKIPN FERRS
1156          LPR OK
1157         PUSHJ P,LCRR
1158         JRST TNAML
1159 \f
1160 SUBTTL UCOP - COPY DIRECTORIES FROM DRIVE TO DRIVE
1161
1162 UCOP:   JSR INIT
1163         TYPE COPY DIRS
1164         PUSHJ P,DUP1
1165         MOVEI A,D0
1166         MOVE J,MFDBK
1167         PUSHJ P,READFN
1168         PUSHJ P,WRITT
1169         MOVEI Q,2000
1170 UCOPL:  SUBI Q,LMNBLK
1171         CAMGE Q,D0+MDNAMP
1172          JRST DDT
1173         SKIPN B,D0(Q)
1174          JRST UCOPL
1175         HRREI J,-2000(Q)                ;CONVERT MFD INDEX TO BLOCK NO
1176         ASH J,-1
1177         ADD J,NUDS
1178         MOVEI A,OUSRD
1179         PUSHJ P,READFN
1180         CAME B,OUSRD+UDNAME
1181          JRST 4,.
1182         PUSHJ P,WRITT
1183         JUMPL T,WRERR
1184         JRST UCOPL
1185
1186 SUBTTL SPKID - SET PACK ID IN TUT
1187
1188 SPKID:  JSR INIT
1189         CAIA
1190 SPKID0:  X CRR
1191         UNTMES SET PACK ID ON UNIT #
1192         X NTYI
1193          JRST SPKID0
1194         CAIL A,NUNITS
1195          JRST SPKID0
1196         X CRR
1197         MOVE I,A
1198         PUSHJ P,RESET
1199         MOVEI A,TUT
1200         PUSHJ P,RDTUT
1201         JUMPL T,ZAPLUZ
1202         TYPE PACK NO=
1203         MOVE A,TUT+QPKNUM
1204         X TDPT
1205         TYPE , CHANGE ID FROM
1206         MOVE A,TUT+QPAKID
1207         X T6B
1208         TYPE  TO
1209         X SIXIN
1210         X CRR
1211         JUMPE B,ZAPLUZ
1212         MOVEM B,TUT+QPAKID
1213         MOVEI A,TUT
1214         PUSHJ P,WRTUT
1215         JUMPL T,ZAPLUZ
1216         JRST DDT
1217 \fSUBTTL REMAP - REASSIGN PACK#S AND FIX UFDS
1218
1219 REMAPP: REPEAT 40, -1           ;INDEX BY PACK #.  LH=NEW PACK #, RH=DISK ADDR OFFSET
1220
1221 REMAP:  JSR INIT
1222         UNTMES REMAP THE COPY OF THE UFDS ON UNIT #
1223         PUSHJ P,NTYI
1224          JRST REMAP
1225         X CRR
1226         CAIL A,NUNITS
1227          JRST REMAP
1228         MOVE I,A
1229         MOVEI A,MFD             ;GET MFD
1230         MOVE J,MFDBK
1231         PUSHJ P,READ
1232         JUMPL T,ACTUE3
1233         MOVE Q,MFD+MDNAMP
1234 REMAP1: CAIL Q,2000             ;NEXT UFD
1235          JRST CRDDT
1236         SKIPN B,MFD+MNUNAM(Q)
1237          JRST REMAP9
1238         MOVEM B,USRNAM
1239         MOVE J,Q
1240         SUBI J,2000
1241         IDIVI J,LMNBLK
1242         ADD J,NUDS              ;UFD BLOCK NUMBER
1243         MOVEI A,OUSRD
1244         PUSHJ P,READ
1245         JUMPL T,CPERR
1246         CAME B,OUSRD+UDNAME
1247          JRST CPERR
1248         MOVE K,OUSRD+UDNAMP
1249 REMAP2: CAIL K,2000             ;NEXT FILE
1250          JRST REMAP6
1251         MOVSI C,UNLINK
1252         TDNE C,UNRNDM+OUSRD(K)
1253          JRST REMAP5            ;DON'T MANGLE LINKS
1254         LDB C,[UNDSCP UNRNDM+OUSRD(K)]
1255         IDIVI C,UFDBPW
1256         HLL C,QBTBLI(D)
1257         ADDI C,UDDESC+OUSRD     ;C HAS DESC POINTER
1258         LDB D,[UNPKN UNRNDM+OUSRD(K)] ;D HAS PK #
1259         SKIPGE A,REMAPP(D)      ;GET MAPPING
1260          JRST 4,.               ;LOSER FORGOT TO PATCH IT IN
1261         HLRZ D,A                ;GET NEW PACK #
1262         DPB D,[UNPKN UNRNDM+OUSRD(K)] ;CHANGE IT
1263         HRRE D,A                ;D HAS BLOCK # OFFSET
1264 REMAP3: MOVE H,C
1265         ILDB A,C                ;GET DESC
1266         JUMPE A,REMAP5          ;EOF
1267         CAIG A,UDWPH
1268          JRST REMAP3            ;DOESN'T DEPEND ON ABS DISK ADDRESSES
1269         ANDI A,37               ;MASK OUT LOAD-ADDR-BIT
1270 REPEAT NXLBYT,[
1271         LSH A,UFDBYT
1272         ILDB B,C
1273         ADD A,B
1274 ]
1275         ADD A,D                 ;RELOCATE THE ADDRESS
1276         REPEAT 6,JFCL           ;PATCH AREA
1277         MOVE C,H                ;GET BACK B.P. TO START OF LOAD-ADDR DESCRIPTOR
1278         MOVE H,[<UFDBYT*NXLBYT+UFDBYT>_36+UFDBYT_30+A]
1279 REPEAT NXLBYT+1,[
1280         ILDB B,H
1281 IFE .RPCNT,     ADDI B,40
1282         IDPB B,C
1283 ]
1284         JRST REMAP3
1285
1286 REMAP5: ADDI K,LUNBLK
1287         JRST REMAP2
1288
1289 REMAP6: MOVEI A,OUSRD
1290         PUSHJ P,WRITE
1291         JUMPL T,WRERR
1292 REMAP9: ADDI Q,LMNBLK
1293         JRST REMAP1
1294 \f
1295 SUBTTL ZAP - ZERO DIR BLOCKS, WRITE EMPTY TUT & MFD
1296
1297 ZAP:    JSR INIT
1298         X CRR
1299         UNTMES INIT DIRS ON UNIT #
1300         PUSHJ P,NTYI
1301          JRST ZAP
1302         CAIL A,NUNITS
1303          JRST ZAP
1304         PUSHJ P,CRR
1305         MOVEM A,TOU
1306         MOVE I,A
1307 RP,[    TYPE PACK NO =
1308         X DTYI                  ;IF RP, NO PK # IN HARDWARE, GET IT FROM HUMAN
1309         X CRR
1310         MOVEM A,PKNUM(I)
1311 ]       PUSHJ P,RESET           ;IF DC OR RH, WILL USE PACK # FROM HARDWARE
1312         MOVE A,[WXWDS-1,,WXWDS]
1313         BLT A,WXWDS+3
1314         SETZM MFD               ;INIT ALL BLOCKS TO ZERO
1315         MOVE A,[MFD,,MFD+1]
1316         BLT A,MFD+1777
1317         MOVN J,NUDS             ;GET AOBJN PTR TO UFD BLOCKS
1318         HRLZ J,J
1319 KL,     ADD J,[2,,2]            ;PROTECT KLDCP?
1320         MOVEI A,MFD
1321 ZAPL:   PUSHJ P,WRITE
1322         JUMPL T,ZAPLUZ
1323         AOBJN J,ZAPL
1324
1325 DC,[    CONO DC0,DCCSET+DCDENB
1326         DATAO DC0,[DJMP DZAP]
1327         CONSZ DC0,DSSACT
1328          JUMPA .-1
1329         CONSO DC0,DSSERR
1330 ];DC
1331          JRST MARK69
1332
1333 ZAPLUZ: TYPE LOSE
1334         JRST CRDDT
1335
1336 DC,[
1337 DZAP:   DWRITE                  ;ZERO READ-IN BLOCK
1338         DCSKIP (-LRIBLK_2&37774)
1339         DHLT
1340 ];DC
1341 \f
1342         SUBTTL SIMPLE DISK TESTS
1343
1344 ;THIS ONE JUST WRITES A SINGLE BLOCK, READS IT BACK, AND CHECKS THAT IT'S THE SAME.
1345 DSKTST: JSR INIT
1346         SETOM HCRASH            ;DON'T DO ERROR RETRY
1347         TYPE TEST UNIT #
1348         X NTYI
1349          JRST DSKTST
1350         X CRR
1351         CAIL A,NUNITS
1352          JRST DSKTST
1353         MOVE I,A
1354         TYPE GOT A SCRATCH PACK ON UNIT #
1355         X TOPT
1356         TYPE ?
1357         X Y.OR.N
1358          JRST CRDDT
1359 DSKTS0: X RESET
1360         MOVEI J,NBLKSC*15.      ;RANDOMLY USE CYLINDER 15.
1361         MOVSI A,-2000
1362         MOVEI B,1               ;FIRST PART OF PATTERN IS FLOATING 1S
1363 DSKT0A: MOVEM B,D0(A)
1364         LSH B,1
1365         SKIPE B
1366          AOBJN A,DSKT0A
1367         HRROI B,-2              ;NEXT IS FLOATING 0S
1368 DSKT0B: MOVEM B,D0(A)
1369         JUMPGE B,DSKT0C
1370         LSH B,1
1371         AOS B
1372         AOBJN A,DSKT0B
1373 DSKT0C: MOVEM A,D0(A)   ;REST IS AN ADDRESS PATTERN
1374         AOBJN A,DSKT0C
1375         MOVEI A,D0
1376         X WRITE
1377         JUMPL T,WRERR
1378 DSKTS1: MOVEI A,D1
1379         X READ
1380         PUSHJ P,TYIPSE
1381         MOVSI B,-2000
1382 DSKT1A: MOVE A,D1(B)
1383         CAMN A,D0(B)
1384 DSKTS2:  AOBJN B,DSKT1A
1385         JUMP DSKTS4             ;CHANGE TO JUMPA FOR NO TYPEOUT
1386         JUMPGE B,DSKTS3         ;JUMP IF COMPARED ALL
1387         HRRZ A,B
1388         X TOPT
1389         TYPE /
1390         MOVE A,D0(B)
1391         X THWO
1392         X TSPAC
1393         MOVE A,D1(B)
1394         X THWO
1395         X TSPAC
1396         MOVE A,D0(B)
1397         XOR A,D1(B)
1398         X THWO
1399         X CRR
1400         JRST DSKTS2
1401
1402 DSKTS3: JUMPGE T,DSKTS1         ;AFTER PRINTING COMPARISON, IF DISK NOTICED ERROR
1403         X GSTS                  ; ALSO PRINT THAT
1404         JRST DSKTS1
1405
1406 DSKTS4: DATAO LIGHTS,[0]
1407         JUMPGE B,DSKTS1
1408         MOVE A,B
1409         XOR A,CYLBUF(B)
1410         DATAO LIGHTS,A
1411         JRST DSKTS2
1412 \f
1413 ;SEEK TEST.  THIS LOOPS OVER ALL HEADS, AND OPTIONALLY LOOPS OVER DIFFERENT
1414 ; LENGTH SEEKS.  IT DOESN'T WRITE, BUT IS A TEST OF SEEKING AND SEARCHING.
1415 ;SETOM HCRASH IF YOU WANT TO DO NO ERROR RETRIES ON READ/SEARCH ERRORS
1416 ;(SEEK INCOMPLETES WILL ALWAYS BE RETRIED.)
1417
1418 SEKTST: JSR INIT
1419         TYPE SEEK TEST UNIT #
1420         X NTYI
1421          JRST SEKTST
1422         X CRR
1423         CAIL A,NUNITS
1424          JRST SEKTST
1425         MOVE I,A
1426         X RESET
1427         TYPE ALWAYS DO FULL LENGTH SEEKS?
1428         SETZM SEKINC
1429         MOVEI A,10.*NBLKSC
1430         X Y.OR.N
1431          MOVEM A,SEKINC'        ;IF NO, DO DECREASING LENGTH SEEKS
1432 SEKTS0:
1433 RP,[
1434         MOVSI A,(DNOOPC)        ;DETERMINE HOW MANY CYLINDERS THIS DRIVE
1435         DPB I,[DUNFLD A]
1436         DATAO DPC,A
1437         DATAI DPC,B
1438         MOVEI A,<NCYLS-1>*NBLKSC        ;RP02
1439         TRNE B,2000
1440          MOVEI A,<MCYLS-1>*NBLKSC       ;RP03
1441 ];RP
1442 .ELSE   MOVEI A,<NCYLS-1>*NBLKSC
1443 IFN T300P,[
1444         CAIL I,T300P
1445          MOVEI A,<NCYLS1-1>*NBLKC1      ;T-300
1446 ];T300P
1447         MOVEM A,SEKCY2'
1448         SETZM SEKCY1'
1449 SEKTS1: SETZM SEKHDN'           ;RESET HEAD
1450 SEKTS2: MOVE J,SEKCY1           ;BLOCK ADDRESS OF OUTER CYLINDER
1451         ADD J,SEKHDN            ;SELECT A BLOCK ON THE DESIRED HEAD
1452         MOVEI A,CYLBUF
1453         X READ                  ;READ IT
1454         SKIPGE T
1455 SEKTS3:  X GSTS                 ;JFCL THIS IF YOU DON'T WANT ERROR MESSAGES
1456         MOVE J,SEKCY2           ;BLOCK ADDRESS OF INNER CYLINDER
1457         ADD J,SEKHDN            ;SELECT SAME HEAD
1458         MOVEI A,CYLBUF
1459         X READ
1460         SKIPGE T
1461          XCT SEKTS3
1462         PUSHJ P,TYIPSE
1463         MOVEI J,NSECS/SECBLK    ;ADVANCE TO NEXT HEAD
1464         ADDB J,SEKHDN
1465         CAIGE J,NBLKSC          ;SKIP IF TOUCHED ALL HEADS
1466          JRST SEKTS2
1467         MOVN B,SEKINC           ;YES, CHANGE CYLINDERS
1468         ADDB B,SEKCY2
1469         MOVE C,SEKINC
1470         ADDB C,SEKCY1
1471         CAMG C,B
1472          JRST SEKTS1
1473         JRST SEKTS0             ;RECYCLE
1474
1475 THWO:   PUSH P,A
1476         PUSH P,B
1477         TLNN A,-1
1478          JRST THWO1
1479         HLRZS A
1480         X TOPT
1481         TYPE ,,
1482         HRRZ A,-1(P)
1483 THWO1:  X TOPT
1484         POP P,B
1485         POP P,A
1486         POPJ P,
1487 \fDC,[
1488         SUBTTL DC-10 PACK FORMATTING
1489 MARK:   JSR INIT
1490         X CRR
1491         UNTMES FORMAT PACK ON UNIT #
1492         PUSHJ P,NTYI
1493          JRST MARK
1494         CAIL A,NUNITS
1495          JRST MARK
1496         PUSHJ P,CRR
1497         HRRZ TT,QTRAN(A)
1498         CONO DC1,(TT)           ;SETUP DRIVE # FOR LATENCY TIMER
1499         MOVEM A,TOU
1500         MOVE I,A
1501         PUSHJ P,RECAL
1502         CONSO DC1,DFUNSF\DOFFL
1503          JRST MARK1
1504         TYPE DRIVE OK?
1505         JRST CRDDT
1506
1507 MARK1:  MOVE A,[DSPC+DSCWIM+DSWIDX+DSWNUL]
1508         MOVEM A,CYLBUF
1509         MOVEI D,CYLBUF+1
1510         PUSHJ P,RDLAT           ;READ LATENCY TIMER
1511         JUMPE A,.-1
1512 MARK1A: CONI DC1,A
1513         CONI DC1,C
1514         LDB A,[DSLAT A]
1515         LDB C,[DSLAT C]
1516         CAME A,C
1517          JRST MARK1A
1518         JUMPN A,[MOVE B,A
1519                  JRST MARK1A]
1520 IFN 0,[         ;THIS HARDWARE HAS BEEN BROKEN FOR YEARS
1521         PUSH P,B
1522         MOVE A,B
1523         IDIVI A,10.             ;NO. OF MILLISECONDS
1524         PUSH P,B
1525         PUSHJ P,TDPT
1526         MOVEI A,".
1527         PUSHJ P,TYO
1528         POP P,A
1529         ADDI A,"0
1530         PUSHJ P,TYO
1531         TYPE  MILLISECONDS ROTATION TIME
1532         PUSHJ P,CRR
1533         POP P,B
1534         CAIGE B,254.            ;LIKELY JUST NO INDEX ON THIS PACK
1535          JRST MARK1B
1536         TYPE TOO DAMN LONG TO BE CREDIBLE, USING 24.5 MS.
1537         PUSHJ P,CRR
1538 ];IFN 0
1539         MOVEI B,245.
1540 MARK1B: IMULI B,1000            ;CONVERT TO NUMBER OF BITS/TRACK
1541         IDIVI B,36.             ;NO. OF WORDS PER SECTOR
1542         AOJ B,
1543         MOVEM B,MAXT'
1544         SETZ A,
1545         PUSHJ P,STOBLK          ;ENOUGH ONES TO WIPE OUT THIS TRACK
1546         MOVE J,MAXT
1547         IDIVI J,NSECS
1548         CAIL K,NSECS/2
1549          AOJ J,                 ;INTER-SECTOR GAP LENGTH
1550         SUBI J,3+3+7+3011       ;HEADER CODE+HEADER DATA+"ONES"+BLOCK+CHECKSUM
1551         MOVEI Q,NSECS
1552 MARK1C: MOVEI B,(D)
1553         HRLI B,HBLK             ;SETUP COPYS FOR HEADER PREAMBLE,DATA,POSTAMBLE
1554         ADDI D,3
1555         BLT B,-1(D)
1556         MOVNI B,-NSECS(Q)
1557         IMULI B,3
1558         ADDI B,DHEDR
1559         HRRM B,-2(D)            ;POINT COPY TO THIS SECTORS ENCODED DATA
1560         MOVEI B,103.            ;103 BLOCKS OF 10 ZEROS (ENCODED)
1561         MOVE A,[QCOPY EZERS,15.,]
1562         PUSHJ P,STBLK
1563         SOJLE Q,MARK1D
1564         MOVE B,J                ;ENOUGH ONES TO FILL OUT REMAINING PART OF SECTOR
1565         PUSHJ P,STOBLK
1566         JRST MARK1C
1567 \f
1568 ;SETUP STUFF FOR POSSIBLY WRITING READIN BLOCK
1569 MARK1D: MOVE A,[QCOPY EONES,3,]
1570         MOVEM A,(D)
1571         AOJ D,
1572         MOVSI A,(DOPR+DOHXFR)
1573         MOVEM A,(D)
1574         MOVEM D,RIWP'
1575         ADDI D,2
1576         MOVE B,J
1577         SUBI B,3+3+7+LRIBLK*3/2+3       ;HEADER+LRIBLK+CHECKSUM
1578         LSH B,-1
1579         SUBI B,3*3
1580         PUSHJ P,STOBLK
1581         MOVEI B,(D)
1582         HRLI B,WRTRI
1583         ADDI D,5
1584         BLT B,-1(D)
1585         MOVSI A,(DJMP)          ;PATCH JUMP AROUND RIBLK CODE, WILL BE CLOBBERED FOR BLOCK 0 ONLY
1586         ADDI A,(D)
1587         MOVE B,RIWP
1588         MOVEM A,1(B)
1589         MOVEI B,(D)
1590         MOVEM B,ENDP'
1591         AOS ENDP
1592         HRLI B,RCBLK
1593         ADDI D,5
1594         BLT B,-1(D)
1595         MOVEI B,-3(D)           ;PATCH AOJN .-1 ADDRESS
1596         HRRM B,-2(D)
1597         TYPE PACK NO =
1598         PUSHJ P,DTYI
1599         PUSHJ P,CRR
1600         MOVE I,TOU
1601         MOVEM A,PKNUM(I)
1602         MOVE I,[440300,,RIHEDR] ;ENCODE READIN HEADER
1603         PUSHJ P,ENCI
1604         MOVEI I,RIHED0
1605         PUSHJ P,HCOMP
1606         MOVEI J,<NBLKS+XBLKS>/NSECS-1
1607         MOVEM J,TRKN'
1608 \f;SO FAR
1609 ;WRITE IMAGE COMMAND - (START AT SECTOR PULSE)
1610 ;COPY <ENCODED ONES>    ;ENOUGH TO WIPE OUT FULL TRACK
1611 ;(THEN FOR EACH SECTOR):
1612
1613 ;HEADER PREAMBLE
1614 ;       ONES FOLLWED BY SINGLE ZERO
1615 ;       8 BYTES OF 10101
1616 ;       TWO 28 BIT HEADER WORDS
1617 ;       A SERIES OF ONES FOLLWED BY 01
1618 ;ENCODED ZEROS FOR DATA BLOCK (2004) WORDS + 2 WORDS CHECKSUM
1619 ;ENOUGH ENCODED ONES TO FILL OUT REST OF SECTOR (EXCEPT ON LAST SECTOR)
1620
1621 ;AFTER LAST SECTOR
1622 ;A FEW ONES
1623 ;       NORMALLY:                       FOR BLOCK 0:
1624 ;RIWP:  HANG FOR END OF TRANSFER        WRITE ONES
1625 ;       JUMP AROUND WRITE READIN        WRITE ONES
1626 ;                                       READIN HEADER PREAMBLE
1627 ;                                       READIN HEADER
1628 ;                                       READIN HEADER POSTAMBLE
1629 ;                                       READIN BLOCK
1630 ;                                       ONES TO PAD OUT REST OF TRACK
1631 ;       DALU SETUP CONTROL COUNTER
1632 ;ENDP:  READ COMPARE COMMAND
1633 ;       COPY 4 WORDS ZEROS
1634 ;       AOJN CC,.-1
1635 ;       HALT
1636
1637 MARK2:  MOVEI K,5
1638         MOVEM K,NTRYS'
1639         SETZM DHED0
1640         CAIL J,NBLKS/NSECS
1641          JRST MARK2C
1642         MOVE I,TOU
1643         MOVE A,PKNUM(I)
1644         DPB A,[DPKID DHED0]             ;PACK ID FOR HEADER
1645         DPB A,[DPKID @ENDP]             ;PACK ID FOR READ-COMPARE COMMAND
1646         JUMPN J,MARK2C
1647         MOVE B,RIWP
1648         MOVE A,[QCOPY EONES,3,]
1649         MOVEM A,(B)
1650         MOVEM A,1(B)
1651 MARK2C: IDIVI J,NHEDS
1652         PUSH P,J
1653         MOVE W,TOU
1654         SKIPGE QTRAN(W)
1655          ADDI J,NCYLS+XCYLS             ;OFFSET IF DOUBLE SIZE PHYSICAL PACK
1656 IRP A,,[CYLBUF,@ENDP,DHED0]             ;SETUP INITIAL WRITE-IMAGE COMMAND
1657         DPB J,[DCYL A]                  ;  " READ-COMPARE COMMAND
1658         DPB K,[DSURF A]                 ;  " HEADER WORD
1659 TERMIN
1660         POP P,J         ;VIRTUAL CYLINDER #
1661         MOVEI W,0
1662         DPB W,[DHNXAD DHED1]
1663         MOVEI W,1                       ;END OF TRACK
1664         CAIN K,NHEDS-1
1665          MOVEI W,2                      ;END OF CYLINDER
1666         CAIE J,NCYLS-1
1667         CAIN J,NCYLS+XCYLS-1
1668          TRO W,1                                ;END OF DISK
1669         MOVE I,[440300,,DHEDR]
1670         PUSHJ P,ENCI
1671         MOVEI I,DHED0
1672         MOVEI Q,NSECS
1673 MARK2B: CAIN Q,1                        ;PUT IN INCREMENT CODE
1674          DPB W,[DHNXAD DHED1]
1675         PUSHJ P,HCOMP                   ;ENCODE HEADERS
1676         AOS DHED0
1677         SOJG Q,MARK2B
1678 MARK2A: CONO DC0,DCCSET\DCDENB
1679         DATAO DC0,[DJMP CYLBUF]
1680         MOVE A,[DWLUP,,14]
1681         BLT A,16
1682         JRST 14         ;WAIT IN AC'S FOR DISC, THEN FALL THRU
1683 MARK2D: CONSO DC0,DSSERR
1684          JRST MARK4
1685         CONSZ DC1,DCPERR\DNXM\DDOBSY
1686          JRST MARK3A
1687         CONSZ DC1,DPROT
1688          JRST MARK3B
1689         CONSZ DC1,DOFFL\DFUNSF
1690          JRST MARK3C
1691         CONSO DC1,DWTHER\DCKSER\DOVRRN\DRCER\DRLNER
1692          JRST MARK3D
1693 MTROV:  SOSLE NTRYS
1694          JRST MARK2A
1695         CONSZ DC1,DOVRRN
1696          JRST MARK3A
1697         TYPE DISK BAD
1698         JRST CRDDT
1699
1700 DWLUP:  CONSZ DC0,DSSACT
1701          JRST 14
1702         JRST MARK2D
1703
1704 MARK3A: TYPE MACHINE LOSSAGE
1705         JRST CRDDT
1706
1707 MARK3B: TYPE NOT WRT ENABLED
1708         JRST CRDDT
1709
1710 MARK3C: TYPE DRIVE LOSSAGE
1711         JRST CRDDT
1712
1713 MARK3D: TYPE CONTROLLER LOSSAGE
1714         JRST CRDDT
1715
1716 MARK4:  SOSL J,TRKN
1717          JRST MARK2
1718 ];DC
1719 \f
1720 ;INITIALIZE MFD AND TUT
1721 ; TOU AND PKNUM+n MUST BE ALREADY SET UP
1722
1723 MARK69: MOVE I,TOU
1724         X MFDINN
1725         TYPE SWAPPING ALLOC =
1726         PUSHJ P,OTYI
1727         PUSHJ P,CRR
1728         X TUTINI
1729         MOVE A,PKNUM(I)
1730         MOVEM A,TUT+QPKNUM
1731         TYPE PACK # =
1732         X TDPT
1733         X CRR
1734         TYPE PACK ID =
1735         PUSHJ P,6TYI
1736         PUSHJ P,CRR
1737         MOVEM B,TUT+QPAKID
1738         MOVEI A,MFD
1739         MOVE J,MFDBK
1740         PUSHJ P,WRITT
1741         JUMPL T,WRERR
1742         MOVE A,TUT+QSWAPA       ;SET UP FREE SPACE POINTER
1743         CAMGE A,NUDS
1744          MOVE A,NUDS
1745         ADDI A,NBLKSC-1         ;JUST IN CASE QSWAPA NOT ON CYLINDER BOUNDARY
1746         IDIVI A,NBLKSC
1747         IMULI A,NBLKSC
1748         MOVEM A,TUT+QTUTP
1749         MOVEI A,TUT
1750         PUSHJ P,WRTUT
1751         JUMPL T,WRERR
1752         JRST DDT
1753
1754 6TYI:   MOVE C,[440600,,B]
1755         MOVEI B,0
1756 6TYL:   PUSHJ P,TYI
1757         SUBI A,40
1758         JUMPLE A,CPOPJ
1759         TLNE C,770000
1760          IDPB A,C
1761         JRST 6TYL
1762 \fDC,[
1763 HCOMP:  SETOM HPAR'
1764         MOVEI J,(I)
1765         HRLI J,-2
1766 HCOMP1: MOVEI B,14.
1767         MOVE A,(J)
1768         XORM A,HPAR
1769         LSH A,-2
1770         SOJG B,.-2
1771         AOBJN J,HCOMP1
1772
1773         MOVE B,(I)
1774         PUSHJ P,ENCH
1775         MOVE B,HPAR
1776         ANDI B,3
1777         LSH B,20.
1778         XORB B,1(I)
1779         PUSHJ P,ENCH
1780         MOVSI B,770000
1781 HCOMP2: TDNN B,DSKBP
1782          POPJ P,
1783         PUSHJ P,ENCDO
1784         JRST HCOMP2
1785 \f
1786 ENCO:   SKIPA A,C1
1787 ENCZ:    MOVEI A,0
1788 ENC:    ANDI A,1
1789         HRRZ T,ENCS'
1790         JRST @ENCT(T)
1791
1792 ENCT:   ENC1
1793         ENC2
1794         ENC1
1795         ENCZ2
1796
1797 ENCDO:  SKIPA A,[3]
1798 ENCDZ:   MOVEI A,0
1799 ENCD:   ANDI A,3
1800         HRRZ T,ENCS
1801         JRST @ENCDT(T)
1802
1803 ENCDT:  ENC2A
1804         [JRST 4,.]
1805         ENCZ2A
1806         [JRST 4,.]
1807
1808 ENC1:   HRLM A,ENCS
1809 ENC1A:  AOS ENCS
1810         POPJ P,
1811
1812 ENC2:   ROT A,-1
1813         HLR A,ENCS
1814         ROT A,2
1815         JRST ENC2B
1816 ENC2A:  LSH A,1
1817         AOS ENCS
1818 ENC2B:  JUMPE A,ENC1A
1819 C1:     TRO A,1
1820         IDPB A,DSKBP'
1821 ENC3:   SETZM ENCS
1822         POPJ P,
1823
1824 ENCZ2:  ROT A,-1
1825         HLR A,ENCS
1826         JRST .+2
1827 ENCZ2A:  ROT A,-1
1828         ASH A,2
1829         TRO A,2
1830         IDPB A,DSKBP
1831         ROT A,2
1832         TRO A,5
1833         IDPB A,DSKBP
1834         JRST ENC3
1835
1836 ENCH:   LSH B,36.-28.
1837         SKIPA C,[14.]
1838 ENCW:    MOVEI C,18.
1839         LSHC A,2
1840         PUSHJ P,ENCD
1841         SOJG C,.-2
1842         POPJ P,
1843 \f
1844 ENCI:   MOVEM I,DSKBP
1845         SETZM ENCS
1846         POPJ P,
1847
1848 RDLAT:  CONI DC1,A              ;READ LATENCY TIMER INTO A
1849         LDB A,[DSLAT A]
1850 RDLAT2: MOVEM A,T
1851         CONI DC1,A
1852         LDB A,[DSLAT A]
1853         CAME A,T
1854          JRST RDLAT2
1855         POPJ P,
1856
1857 STBLK:  MOVEM A,(D)             ;STORE C(A) IN B WORDS AT D
1858         SOJLE B,[AOJA D,CPOPJ]
1859         HRLI D,1(D)
1860         ADDI B,1(D)
1861         MOVS D,D
1862         EXCH B,D
1863         BLT B,-1(D)
1864         POPJ P,
1865
1866 STOBLK: MOVE A,[QCOPY EONES,LOBLK,]
1867         IDIVI B,LOBLK
1868         JUMPE B,STOBL3          ;LESS THAN ONE BLOCK NEEDED??
1869         JUMPE C,STOBL2
1870         CAIL C,3
1871          JRST STOBL2
1872         SOJ B,
1873         ADDI C,LOBLK
1874 STOBL2: PUSHJ P,STBLK
1875 STOBL3: CAIGE C,3
1876          MOVEI C,3
1877         MOVNI C,(C)
1878         DPB C,[DCWC A]
1879         MOVEM A,(D)
1880         AOJA D,CPOPJ
1881 \f
1882 HBLK:   QCOPY PREAMB,3,         ;NORMAL HEADER
1883         QCOPY .,3,
1884         QCOPY POSTMB,7,
1885
1886 WRTRI:  QCOPY PREAMB,3,         ;READIN HEADER, DATA BLOCK
1887         QCOPY RIHEDR,3,
1888         QCOPY POSTMB,7,
1889         QCOPY EZERS,<LRIBLK*3/2+3>,
1890         QCOPY EONES,3,
1891
1892 RCBLK:  DALU+DLCC+DLLB -401*NSECS(3)    ;READ COMPARE "LOOP" FOR DATA WORDS
1893         DRCC
1894         QCOPY ZERS,4
1895         DJMP+DAOJNC .
1896         DHLT
1897
1898 LOBLK==60
1899
1900 DHED0:  0
1901 DHED1:  -2004&37777
1902 DHEDR:  BLOCK 3*NSECS
1903
1904
1905 RIHED0: 0
1906 RIHED1: -LRIBLK&37777
1907 RIHEDR: BLOCK 3
1908
1909 EZERS:  REPEAT LRIBLK*3/2+3,252525252525
1910
1911 EONES:  REPEAT LOBLK+3,-1
1912
1913 PREAMB: -1                      ;ONES
1914         -26                     ;ONES...0.1010
1915         655326553265            ;1.10101.10101.10101.10101.10101.10101.10101
1916
1917 POSTMB: REPEAT 6,-1             ;ONES...01
1918         -3
1919
1920 ZERS:   BLOCK 4
1921 ];DC
1922 \f
1923 RH,[
1924         SUBTTL RH-10 PACK FORMATTING
1925
1926 MARK:   JSR INIT
1927         SETZM CERRS
1928 KL,[    SWPUA                   ;TURN THE CACHE OFF
1929         CONSZ APR,200000
1930          JRST .-1
1931         CONI PAG,A
1932         TRZ A,600000
1933         CONO PAG,(A)
1934 ];KL
1935         X CRR
1936         UNTMES FORMAT PACK ON UNIT #
1937         X NTYI
1938          JRST MARK
1939         CAIL A,NUNITS
1940          JRST MARK
1941         X CRR
1942         MOVE I,A
1943         MOVEM I,TOU
1944         SETOM MARKF
1945         PUSHJ P,RESET
1946         SETZM MARKF
1947         TYPE ARE YOU SURE YOU WANT TO FORMAT PACK ON DRIVE #
1948         X TOPT
1949         TYPE ?
1950         X TYI
1951         X CRR
1952         CAIE A,"Y
1953          JRST DDT
1954         TYPE PACK NO =
1955         PUSHJ P,DTYI
1956         PUSHJ P,CRR
1957         MOVEM A,PKNUM(I)
1958         MOVSI A,%HRSER          ;GET DRIVE SERIAL NUMBER
1959         PUSHJ P,RHGET
1960          JRST RHMKER
1961         HRLZ D,A
1962         TLZ D,600000            ;FIRST "KEY" WORD IS SERIAL NO OF DRIVE FORMATTED ON
1963         HRR D,PKNUM(I)          ;SECOND "KEY" WORD IS I.T.S. PACK NUMBER
1964         SETZB A,B               ;GENERATE PATTERN FOR SURFACE
1965 RHFMP1: MOVEM B,CYLBUF(A)       ;CYL 0 TRACK 0 SECTOR (B) IS FIRST HEADER WORD
1966         MOVEM D,CYLBUF+1(A)     ;PUT DRIVE SERIAL NUMBER IN 3.1-4.7 OF HDR WD 2
1967         ADDI A,2
1968         SETZB C,H               ;FILL SECTOR WITH WORST CASE PATTERN
1969 RHFMP2: MOVE T,RHWC(H)
1970         MOVEM T,CYLBUF(A)
1971         AOS H
1972         CAIL H,RHWCL
1973          MOVEI H,0
1974         AOS A
1975         CAIGE C,200-1
1976          AOJA C,RHFMP2
1977         CAIGE B,NSECS-1         ;DO NEXT SECTOR
1978          AOJA B,RHFMP1
1979         CAIE A,202*NSECS
1980          JRST 4,.               ;WRONG AMOUNT OF CRUFT GENERATED
1981         MOVE A,[-202*NSECS_4,,CYLBUF-1] ;SET UP IOWD
1982         MOVEM A,SLVIOWD
1983         SETZM SLVIOWD+1
1984         MOVEI A,SLVIOWD
1985         MOVEM A,SLVICWA
1986         JRST RHFMT0             ;GO FORMAT
1987
1988 RHWC:   726666666676            ;RP04 10-MODE WORST CASE PATTERN
1989         555555555753
1990         333333337266
1991         666666765555
1992         555557533333
1993         333372666666
1994         667655555555
1995         573333333333
1996 RHWCL==.-RHWC
1997
1998 RHMKER: TYPE DISK ERROR
1999         X CRR
2000         PUSHJ P,GSTS
2001         JRST DDT
2002 \f
2003 RHFMT0: MOVEI J,NCYLS+XCYLS
2004 RHFMT1: SOJL J,RHFMT4           ;LOOP ON CYLINDERS
2005         MOVEI K,NHEDS
2006 RHFMT2: SOJL K,RHFMT1           ;LOOP ON SURFACES
2007         MOVEI B,NSECS           ;ADJUST THE HEADER WORDS
2008         MOVEI C,0
2009 RHFMT3: DPB J,[221100,,CYLBUF(C)]
2010         DPB K,[100500,,CYLBUF(C)]
2011         ADDI C,202
2012         SOJG B,RHFMT3
2013         MOVSI A,%HRADR          ;SET UP ADDRESS IN DRIVE
2014         DPB K,[$HATRK A]
2015         PUSHJ P,RHSET
2016          JRST RHMKER
2017         MOVSI A,%HRCYL          ;LEAVE CYLINDER NUMBER IN RH10 "DIB" LIGHTS
2018         HRR A,J
2019         PUSHJ P,RHSET
2020          JRST RHMKER
2021         SETZM SLVICWA+1
2022         MOVSI A,%HRCTL          ;SET UP WRITE HEADERS AND DATA COMMAND
2023         HRRI A,%HMWHD
2024         MOVEI B,SLVICWA
2025         DPB B,[$HCICWA A]
2026         PUSHJ P,RHSET
2027          JRST RHMKER
2028         CONSO DSK,%HIDONE
2029          JRST .-1
2030         CONSZ DSK,%HIERR
2031          JRST RHMKER
2032         JRST RHFMT2
2033
2034 RHFMT4: TYPE FORMATTING COMPLETE, VERIFICATION BEGINS
2035         X CRR
2036         MOVEI J,NCYLS+XCYLS-1
2037 RHFMT5: MOVEI A,CYLBUF
2038         PUSHJ P,READCY
2039         JUMPGE T,RHFMT6
2040         TYPE CYLINDER
2041         MOVE A,J
2042         X TOPT
2043         TYPE  IN ERROR
2044         X CRR
2045         X GSTS
2046         X CRR
2047         JRST RHFMT9
2048
2049 RHFMT6: SETZB A,H               ;VERIFY DATA.  RELIES ON SECTOR SIZE BEING
2050 RHFMT7: MOVE B,CYLBUF(A)        ; A MULTIPLE OF RHWCL
2051         CAME B,RHWC(H)
2052          PUSHJ P,RHFMT8
2053         ADDI H,1
2054         CAIL H,RHWCL
2055          MOVEI H,0
2056         CAIGE A,200*NSECS
2057          AOJA A,RHFMT7
2058 RHFMT9: SOJGE J,RHFMT5
2059         SKIPN A,CERRS
2060          JRST RHFMTX
2061         X TDPT
2062         TYPE  ECC-CORRECTED ERRORS DURING VERIFICATION.
2063 RHFMTX: X CRR
2064         JRST MARK69             ;HARDWARE FORMATTED, DO SOFTWARE
2065
2066 RHFMT8: PUSH P,A
2067         TYPE WORD
2068         X TOPT
2069         TYPE  OF CYLINDER
2070         MOVE A,J
2071         X TOPT
2072         TYPE  CORRECT
2073         MOVE A,RHWC(H)
2074         X TOPT
2075         TYPE  ACTUAL
2076         MOVE A,B
2077         X TOPT
2078         X CRR
2079         JRST POPAJ
2080 ];RH
2081 \f
2082 RP,[
2083         SUBTTL RP-10 PACK FORMATTING
2084
2085 MARK:   JSR INIT
2086 KL,[    SWPUA                   ;TURN THE CACHE OFF
2087         CONSZ APR,200000
2088          JRST .-1
2089         CONI PAG,A
2090         TRZ A,600000
2091         CONO PAG,(A)
2092 ];KL
2093         X CRR
2094         UNTMES FORMAT PACK ON UNIT #
2095         X NTYI
2096          JRST MARK
2097         CAIL A,NUNITS
2098          JRST MARK
2099         X CRR
2100         MOVE I,A
2101         MOVEM I,TOU
2102         SETOM MARKF
2103         PUSHJ P,RESET
2104         SETZM MARKF
2105         MOVSI A,(DNOOPC)        ;DETERMINE TYPE OF DRIVE
2106         DPB I,[DUNFLD A]
2107         DATAO DPC,A
2108         DATAI DPC,A
2109         MOVEI B,"2
2110         MOVEI C,NCYLS+XCYLS
2111         TRNN A,2000
2112          JRST .+3
2113           MOVEI B,"3
2114           MOVEI C,MCYLS+XCYLS
2115         MOVEM C,LAST
2116         TLNE A,1
2117          JRST [ TYPE WRITE HEADER LOCKOUT SWITCH IS ON
2118                 JRST CRDDT ]
2119         TYPE ARE YOU SURE YOU WANT TO FORMAT PACK ON RP0
2120         MOVE A,B
2121         X TYO
2122         TYPE  #
2123         MOVE A,I
2124         X TOPT
2125         TYPE ?
2126         X TYI
2127         X CRR
2128         CAIE A,"Y
2129          JRST DDT
2130         TYPE PACK NO =
2131         PUSHJ P,DTYI
2132         PUSHJ P,CRR
2133         MOVEM A,PKNUM(I)
2134         SETZB A,B               ;GENERATE TEMPLATE TRACK
2135 RPFMP1: MOVEI T,31.             ;SYNC ZONE OF 30 ZERO WORDS
2136         SETZM CYLBUF(A)
2137         AOS A
2138         SOJG T,.-2
2139         AOS CYLBUF-1(A)         ;AND ONE WORD CONTAINING 1 IN BIT 35
2140         MOVEM B,CYLBUF(A)       ;THEN ADDRESS WORD
2141 REPEAT 4,SETZM CYLBUF+1+.RPCNT(A) ;THEN ADDR PARITY WORD AND 3 ZERO WORDS SYNC
2142         ADDI A,5
2143         MOVE T,RPWC             ;THEN 128 DATA WORDS OF WORST CASE PATTERN
2144         MOVEM T,CYLBUF(A)
2145         MOVSI T,CYLBUF(A)
2146         HRRI T,CYLBUF+1(A)
2147         BLT T,CYLBUF+177(A)
2148         ADDI A,200
2149         CAIGE B,NSECS-1         ;DO NEXT SECTOR
2150          AOJA B,RPFMP1
2151         CAIE A,244*NSECS
2152          JRST 4,.               ;WRONG AMOUNT OF CRUFT GENERATED
2153         MOVE A,[-244*NSECS,,CYLBUF-1] ;SET UP IOWD
2154         MOVEM A,SLVIOWD
2155         SETZM SLVIOWD+1
2156         MOVEI A,SLVIOWD
2157         MOVEM A,SLVICWA
2158         JRST RPFMT0             ;GO FORMAT
2159
2160 RPMKER: TYPE DISK ERROR
2161         X CRR
2162         PUSHJ P,GSTS
2163         JRST DDT
2164 \f
2165 RPFMT0: MOVE J,LAST             ;HIGHEST CYLINDER # + 1
2166 RPFMT1: SOJL J,RPFMT4           ;LOOP ON CYLINDERS
2167         MOVEI K,NHEDS
2168 RPFMT2: SOJL K,RPFMT1           ;LOOP ON SURFACES
2169         MOVEI B,NSECS           ;ADJUST THE HEADER WORDS
2170         MOVEI C,0
2171 RPFMT3: DPB J,[121100,,CYLBUF+37(C)]
2172         DPB K,[050500,,CYLBUF+37(C)]
2173         MOVE D,CYLBUF+37(C)     ;COMPUTE HEADER PARITY WORD
2174         MOVEI T,36.
2175         MOVSI TT,(SETZ)         ;ODD PARITY
2176 RPFMTP: TRNE D,1
2177          TLC TT,(SETZ)
2178         ROT D,1
2179         SOJG T,RPFMTP
2180         MOVEM TT,CYLBUF+40(C)
2181         ADDI C,244
2182         SOJG B,RPFMT3
2183         MOVSI A,300000          ;WRITE FORMAT
2184         ADDI A,SLVICWA
2185         DPB J,[DCYL A]
2186         ROT J,-8                ;EXTRA BIT FOR RP03
2187         DPB J,[DCYLXB A]
2188         ROT J,8
2189         DPB K,[DSURF A]
2190         DPB I,[DUNFLD A]
2191         MOVEM J,RPIOCY
2192         PUSHJ P,SEEK
2193          JRST RPMKER
2194         DATAO DPC,A
2195         CONSO DPC,DONE
2196          JRST .-1
2197         CONSZ DPC,ALLER
2198          JRST RPMKER
2199         JRST RPFMT2
2200
2201 RPFMT4: TYPE FORMATTING COMPLETE, VERIFICATION BEGINS
2202         X CRR
2203         SOS J,LAST
2204 RPFMT5: MOVEI A,CYLBUF
2205         PUSHJ P,READCY
2206         JUMPGE T,RPFMT6
2207         TYPE CYLINDER
2208         MOVE A,J
2209         X TOPT
2210         TYPE  DOESN'T READ -- GIVING UP ON IT.
2211         X CRR
2212         X GSTS
2213         X CRR
2214         JRST RPFMT9
2215
2216 RPFMT6: SETZB A,H               ;VERIFY DATA.
2217         MOVE D,RPWC
2218         LSH D,1                 ;CONTROL DROPS ONE BIT DURING WRITE FORMAT
2219 RPFMT7: MOVE B,CYLBUF(A)
2220         CAME B,D
2221          PUSHJ P,RPFMT8
2222         CAIGE A,200*NSECS
2223          AOJA A,RPFMT7
2224 RPFMT9: SOJGE J,RPFMT5
2225         X CRR
2226         JRST MARK69             ;HARDWARE FORMATTED, DO SOFTWARE
2227
2228 RPFMT8: PUSH P,A
2229         TYPE WORD
2230         X TOPT
2231         TYPE  OF CYLINDER
2232         MOVE A,J
2233         X TOPT
2234         TYPE  CORRECT
2235         MOVE A,RPWC
2236         X TOPT
2237         TYPE  ACTUAL
2238         MOVE A,B
2239         X TOPT
2240         X CRR
2241         JRST POPAJ
2242
2243 RPWC:   714533,,462556          ;WORST CASE PATTERN
2244 ];RP
2245 CONSTA
2246 ];NTS
2247 \fNTS,[
2248 SUBTTL MFDR - RECONSTRUCT MFD FROM UFDS
2249
2250 MFDR:   MOVEI P,PDL
2251         PUSHJ P,CRR     ;RECONSTRUCT MFD BY GETTING NAMES FROM UFD'S
2252         UNTMES RECONSTRUCT MFD FROM UNIT #
2253         PUSHJ P,NTYI
2254          JRST MFDR
2255         MOVE I,A
2256         PUSHJ P,MFDINN
2257         SETOM IMNFLG
2258         MOVEI J,0
2259 MFDR1:  MOVEI A,TUT
2260         PUSHJ P,READ
2261         JUMPL T,MFDRL
2262         MOVE B,TUT+UDESCP       ;LOOK LIKE LEGIT UFD?
2263         TLNE B,-1
2264          JRST MRUFDL            ;SHOULD BE F.S. PNTR
2265         CAIL B,<2000.-11.>*6
2266          JRST MRUFDL
2267         MOVE B,TUT+UDNAMP
2268         SKIPE TUT+UDNAME        ;USER NAME
2269          TLNE B,-1
2270           JRST MRUFDL           ;PNTR TO BEG OF NAME AREA
2271         MOVEI B,(J)             ;CONVERT BLOCK NO TO MFD INDEX
2272         SUB B,NUDS
2273         LSH B,1
2274         ADDI B,2000
2275         MOVE C,TUT+UDNAME       ;USER NAME
2276         MOVEM C,MFD(B)
2277         AOSN IMNFLG
2278          MOVEM B,MFD+MDNAMP
2279         JRST MRUFDW
2280
2281
2282 MFDRL:  JRST 4,.+1
2283 MRUFDL: JFCL
2284 MRUFDW:
2285         ADDI J,1
2286         CAMGE J,NUDS
2287          JRST MFDR1
2288         TYPE WRITE?
2289         PUSHJ P,TYI
2290         CAIE A,"Y
2291          JRST DDT
2292 MFDWR:  MOVEI A,MFD
2293         MOVE J,MFDBK
2294         PUSHJ P,WRITE
2295         JRST DDT
2296 ];NTS
2297
2298 IMNFLG: 0
2299
2300 SUBTTL INITIALIZE MFD
2301
2302 MFDINN: CLEARM MFD
2303         MOVE A,[MFD,,MFD+1]
2304         BLT A,MFD+1777
2305         MOVE A,[SIXBIT /M.F.D./]
2306         MOVEM A,MFD+MDCHK
2307         MOVE A,NUDS
2308         MOVEM A,MFD+MDNUDS
2309         MOVEI A,2000
2310         MOVEM A,MFD+MDNAMP
2311         POPJ P,
2312 \f
2313 SUBTTL INITIALIZE TUT
2314
2315 ;DRIVE NUMBER IN I, SWAPPING ALLOC IN A
2316
2317 TUTINI: CLEARM TUT
2318         MOVE B,[TUT,,TUT+1]
2319         BLT B,TUT+<2000*MXTUTB>-1
2320         MOVEM A,TUT+QSWAPA
2321         MOVE K,A
2322         CAMGE K,NUDS
2323          MOVE K,NUDS            ;K HAS BASE OF FILE AREA
2324         MOVEI J,NBLKS           ;DETERMINE HOW MANY BLOCKS THIS DRIVE
2325 RP,[    MOVSI A,(DNOOPC)
2326         DPB I,[DUNFLD A]        ;SELECT DRIVE
2327         DATAO DPC,A
2328         DATAI DPC,A
2329         TRNE A,2000
2330          MOVEI J,MBLKS          ;RP03 HAS MORE BLOCKS
2331 ];RP
2332 IFN T300P,[
2333         CAIL I,T300P
2334          MOVEI J,NBLKS1
2335 ];T300P
2336         MOVEM J,TUT+QLASTB      ;LAST REGULAR BLOCK IS LAST TUT'ED
2337 IFN T300P,[
2338         MOVEI A,<2000*NTUTBL-LTIBLK>*TUTEPW
2339         CAIL I,T300P
2340          MOVEI A,<2000*NTUTB1-LTIBLK>*TUTEPW
2341         SUB J,A
2342 ];T300P
2343 .ELSE   SUBI J,<2000*NTUTBL-LTIBLK>*TUTEPW ;SUBTRACT MAX NUMBER OF TUTABLE BLOCKS
2344         CAMLE J,K               ;IS THERE ROOM FOR ALL OF FILE AREA?
2345          JRST 4,.               ;NOPE
2346         SKIPGE J
2347          MOVEI J,0
2348         MOVEM J,TUT+QFRSTB
2349         MOVEI A,TUT
2350 TUTFIL: MOVEI K,TUTLK           ;ENTER HERE FROM SALV1, A -> TUT
2351         MOVSI D,440000+TUTBYT_6
2352         ADDI D,LTIBLK(A)
2353         MOVE B,NUDS
2354         SUB B,QFRSTB(A)
2355         JUMPLE B,TUTI1A
2356 TUTI1:  IDPB K,D                ;MARK OUT USER DIR AREA
2357         SOJG B,TUTI1
2358
2359 TUTI1A: MOVEI B,(A)
2360         MOVSI D,-LSBTAB
2361 TUTI2:  SKIPGE J,SBTAB(D)
2362          JRST TUTI3             ;NOT REALLY THERE
2363         PUSHJ P,TUTPNT
2364         MOVEI K,TUTLK
2365         DPB K,J                 ;MARK OUT BLOCK
2366 TUTI3:  AOBJN D,TUTI2
2367         MOVE D,NTBL(I)          ;MARK OUT TUT (SIZE VARIES)
2368 TUTI4:  MOVE J,MFDBK
2369         SUB J,D
2370         PUSHJ P,TUTPNT
2371         MOVEI K,TUTLK
2372         DPB K,J
2373         SOJG D,TUTI4
2374         POPJ P,
2375
2376 ;TUTPNT - ROUTINE TO ACCESS THE TUT
2377 ; CALL WITH BLOCK NUMBER IN J, POINTER TO TUT IN B
2378 ; RETURNS WITH BYTE POINTER IN J (0 IF BLOCK NOT TUT'ED)
2379 ; K IS CLOBBERED
2380 ;
2381 ;TUTPNN - SAME BUT CALL WITH DISK NUMBER IN I, CLOBBERS B TO NEW TUT ADDR
2382 ;
2383 ;TUTPNO - SAME BUT CALL WITH DISK NUMBER IN I, CLOBBERS B TO OLD TUT ADDR
2384
2385 TUTPNN: SKIPA B,QNTUTO(I)
2386
2387 TUTPNO: MOVE B,QOTUTO(I)
2388
2389 TUTPNT: CAMGE J,QLASTB(B)
2390         CAMGE J,QFRSTB(B)
2391          TDZA J,J
2392           CAIA
2393          POPJ P,                ;BLOCK NOT TUT'ED, RETURN J=0
2394         SKIPGE QPKNUM(B)
2395          JRST [ TYPE OLD FORMAT TUT?
2396                 JRST ERRDDT ]
2397         SUB J,QFRSTB(B)
2398         IDIVI J,TUTEPW
2399         HLL J,QTTBL(K)
2400         ADDI J,LTIBLK(B)
2401         POPJ P,
2402 \fSUBTTL MAIN SALVAGER
2403
2404 GOGO:   JRST GOGO0      ;VECTOR OF MYSTERIES
2405 SALVAG: JRST GOGO1      ;(IN CASE UP CREEK WITHOUT SYMBOL TABLE)
2406 CHKR:   JRST CHKR0
2407 NTS,[
2408         JFCL LPBUST     ;-> LPT BUSTED FLAG
2409         JFCL NOQUES     ;-> NO QUESTIONS FLAG
2410         JFCL GOODUN     ;-> ONLY ROUTINE THAT KNOWS WHICH ARE "RIGHT" PACKS
2411         JFCL GETSTS     ;-> ROUTINE TO TYPEOUT CURRENT DISK STATUS
2412         JFCL DSKTST     ;-> SIMPLE READ/WRITE TEST
2413         JFCL SEKTST     ;-> SIMPLE SEEK TEST (READ ONLY)
2414         JFCL DUP        ;-> DISK COPYING ROUTINE
2415         JFCL HCRASH     ;-> AS FAST AS POSSIBLE FLAG
2416 ];NTS
2417
2418 GOGO1:  JSR INIT
2419         SETOM NOQUES    ;IF STARTED BY BEG$G IN ITS, BE FAST.
2420         JRST GOGO2      ;(NO ROUTINE TYPEOUT)
2421
2422 GOGO0:  JSR INIT
2423 GOGO2:  SETOM GOGOX     ;AUTOMATIC MODE
2424         TYPE SALVAGER.
2425         MOVE A,[.FNAM2]
2426         X T6B
2427         X CRR
2428         MOVEI A,NUNITS-1
2429         SETOM QACT(A)   ;ALL UNITS ACTIVE
2430         SOJGE A,.-1
2431         PUSHJ P,ACTUN   ;ACTIVATE ALL UNITS THAT ARE ON-LINE
2432         PUSHJ P,GOODUN  ;MAKE SURE ALL PACKS THAT SHOULD BE MOUNTED ARE
2433         MOVEM I,MDSK    ;FIRST ACTIVE UNIT IS DSK TO GET MFD FROM
2434         MOVEM I,UDSK    ;.. DSK TO GET UFD'S FROM
2435         PUSHJ P,DRPHAS  ;VERIFY THAT DIRECTORIES ON ALL PACKS ARE IN PHASE
2436         SETZM CKFLSW    ;DON'T CHECK ALL BLOCKS
2437         JRST SALV1
2438
2439 CHKR0:  JSR INIT        ;ASK QUESTIONS MODE
2440         TYPE SALVAGER.
2441         MOVE A,[.FNAM2]
2442         PUSHJ P,T6B
2443         PUSHJ P,CRR
2444         MOVEI A,NUNITS-1
2445         SETZM QACT(A)
2446         SOJGE A,.-1
2447         TYPE ACTIVE UNITS ARE:
2448 CHKR1:  PUSHJ P,NTYI
2449          JRST CHKR2
2450         CAIGE A,NUNITS
2451          SETOM QACT(A)
2452         JRST CHKR1
2453
2454 CHKR2:  PUSHJ P,CRR
2455         PUSHJ P,ACTUN
2456 CHKR3:  UNTMES USE MFD FROM UNIT:
2457         PUSHJ P,NTYI
2458          JRST CHKR3
2459         CAIGE A,NUNITS
2460          SKIPN QACT(A)
2461           JRST CHKR3
2462         MOVEM A,MDSK
2463         PUSHJ P,CRR
2464         PUSHJ P,DRPHAS  ;VERIFY THAT DIRECTORIES ON ALL PACKS ARE IN PHASE
2465         SETZM CKFLSW
2466         SETZM CKFIX
2467 DC,     TYPE CHECK FILES FOR CLOBBERED BLOCKS?
2468 .ELSE   TYPE READ ALL BLOCKS OF ALL FILES?
2469         PUSHJ P,TYI
2470         CAIN A,"Y
2471          SETOB A,CKFLSW
2472         PUSHJ P,CRR
2473         JUMPGE A,CHKR4
2474 DC,[    TYPE FIX POINTERS THEN?
2475         SETOM CKFIX
2476         X Y.OR.N
2477          SETZM CKFIX
2478 ];DC
2479 CHKR4:  UNTMES GET USR DIRS FROM UNIT:
2480         PUSHJ P,NTYI
2481          JRST CHKR4
2482         CAIGE A,NUNITS
2483          SKIPN QACT(A)
2484           JRST CHKR4
2485         PUSHJ P,CRR
2486         MOVEM A,UDSK
2487         JRST SALV1
2488 \f
2489 ACTUN:  MOVEI C,NUNITS-1
2490 ACTUN2: SKIPN QACT(C)
2491          JRST ACTUN1
2492         MOVE I,C
2493         PUSHJ P,RESET
2494         SKIPN QACT(C)   ;STILL THERE?
2495          JRST ACTUN1
2496         MOVE I,C
2497         MOVE A,QOTUTO(I)
2498         PUSHJ P,RDTUT
2499         JUMPL T,ACTUE1
2500         MOVE I,QOTUTO(C)
2501         MOVE A,QPKNUM(I)
2502         ANDI A,37
2503         MOVEM A,QPKN(C)
2504         SKIPE NOQUES
2505          JRST ACTUN1
2506         TYPE UNIT #
2507         MOVE A,C
2508         PUSHJ P,DPT
2509         TYPE  ID IS
2510         MOVE A,QPAKID(I)
2511         PUSHJ P,T6B
2512         TYPE  PK #
2513         MOVE A,QPKNUM(I)
2514         PUSHJ P,TDPT
2515 IFN DC10P+RH10P,[
2516         MOVE A,PKNUM(C)
2517         CAMN A,QPKNUM(I)
2518          JRST ACTUN4
2519 IFN T300P,[
2520         CAIL C,T300P
2521          JRST ACTUN4            ;PKNUM NOT REALLY SET UP
2522 ];T300P
2523         TYPE  (HARDWARE SAYS
2524         PUSHJ P,TDPT
2525         TYPE )
2526 ACTUN4: ]
2527         SKIPN A,QTRSRV(I)
2528          JRST ACTUN5
2529         CAMN A,[-1]
2530          JRST [ TYPE  (RESERVED)
2531                 JRST ACTUN5 ]
2532         PUSHJ P,TSPAC
2533         PUSHJ P,SIXTYP
2534         TYPE :
2535 ACTUN5: PUSHJ P,CRR
2536 ACTUN1: SOJGE C,ACTUN2
2537         SETOM ACTIVE
2538         POPJ P,
2539
2540 ACTUE1: TYPE Error reading TUT block
2541         PUSHJ P,CRR
2542         PUSHJ P,GSTS
2543         JRST ERRDDT
2544
2545 ACTUE3: TYPE Error reading MFD block
2546         PUSHJ P,CRR
2547         PUSHJ P,GSTS
2548         JRST ERRDDT
2549 ACTIVE: 0               ;-1 IF ALREADY HAVE RESET DRIVES
2550 \f
2551 ;MAKE SURE ALL NECESSARY PACKS ARE MOUNTED
2552 GOODUN:
2553 NTS,[   MOVEI A,FIRSPK  ;AND RETURN MASTER DISK # IN I
2554 GOODN1: MOVEI C,NUNITS-1
2555 GOODN2: SKIPE QACT(C)
2556          CAME A,QPKN(C)
2557           SOJGE C,GOODN2
2558         JUMPL C,GOODN3  ;THIS PACK MISSING
2559         CAIGE A,LASTPK
2560          AOJA A,GOODN1
2561         MOVEI A,LASTPK-FIRSPK+1 ;NUMBER OF PRIMARY PACKS
2562         MOVEI C,NUNITS-1        ;SCAN FOR SECONDARY PACKS
2563 GOODN4: SKIPN QACT(C)
2564          JRST GOODN5
2565         MOVE B,QOTUTO(C)
2566         SKIPE B,QTRSRV(B)
2567          CAMN B,[-1]
2568           JRST GOODN5
2569         ADDI A,1                ;THIS SECONDARY PACK IS OK TO HAVE MOUNTED
2570 GOODN5: SOJGE C,GOODN4
2571 ];NTS
2572         MOVEI C,NUNITS-1        ;AND FIND MASTER DISK (LOWEST NUMBERED ACTIVE UNIT)
2573         SKIPE QACT(C)           ;ALSO COMPUTE GOOD PACKS - ALL PACKS IN A
2574          JRST [ MOVE I,C
2575                 SOJA A,.+1 ]
2576         SOJGE C,.-2
2577 NTS,    JUMPGE A,CPOPJ
2578 NTS,    TYPE EXTRA PACKS MOUNTED.
2579 NTS,    JRST ERRDDT
2580 TS,     POPJ P,
2581
2582 GOODN3: TYPE PACK #
2583         X TDPT
2584         TYPE  NOT MOUNTED
2585         JRST ERRDDT
2586 \f
2587 TS, DRPHAS: POPJ P,
2588 NTS,[
2589 ;CHECK THAT DIRECTORIES ARE IN PHASE ON ALL PACKS
2590 DRPHAS: MOVEI I,NUNITS-1
2591 DRPHS1: SKIPN QACT(I)           ;FIRST, GET ALL THE MFDS
2592          JRST DRPHS2
2593         MOVE J,MFDBK
2594         MOVE A,QNTUTO(I)
2595         PUSHJ P,READ
2596         JUMPL T,ACTUE3
2597 DRPHS2: SOJGE I,DRPHS1
2598         MOVE I,MDSK             ;GET MASTER DISK'S ASCENDING DIRECTORY NUMBER
2599         MOVE A,@QNTUTO(I)       .SEE MDNUM
2600         MOVE B,A
2601         SUBI B,1
2602         MOVEI I,NUNITS-1        ;SEE IF ALL OTHERS ARE THE SAME, OR AT MOST 1 LESS
2603 DRPHS3: SKIPE QACT(I)
2604          JRST [ CAMG B,@QNTUTO(I) .SEE MDNUM
2605                  CAMGE A,@QNTUTO(I) .SEE MDNUM
2606                   JRST DRPHS6
2607                 JRST .+1 ]
2608         SOJGE I,DRPHS3
2609         POPJ P,
2610
2611 DRPHS6: TYPE DIRECTORIES OUT OF PHASE.
2612         X CRR
2613         MOVEI I,0
2614 DRPHS4: SKIPN QACT(I)
2615          JRST DRPHS5
2616         UNTMES UNIT #
2617         HRRZ A,I
2618         X TOPT
2619         TYPE  PACK #
2620         MOVE A,QPKN(I)
2621         X TDPT
2622         TYPE , MDNUM=
2623         MOVE A,@QNTUTO(I)       .SEE MDNUM
2624         X TOPT
2625         X CRR
2626 DRPHS5: CAIGE I,NUNITS-1
2627          AOJA I,DRPHS4
2628         TYPE VERIFY THAT THE PROPER PACKS ARE MOUNTED.  IF YOU AREN'T SURE,
2629         X CRR
2630         TYPE GET HELP.  IF THEY ARE PROPER, AND ONE IS JUST COMING ON-LINE
2631         X CRR
2632         TYPE AFTER BEING OFF FOR A WHILE, YOU WILL HAVE TO UCOP TO IT.
2633         SKIPE GOGOX
2634          JRST ERRDDT
2635         JRST CRR
2636 ];NTS
2637 \f
2638 SALV1:  SETZM MFDWRT    ;-1 IF MFD MODIFIED (DIRECTORIES DELETED)
2639         SETZM SHARED
2640         MOVEI I,NUNITS-1
2641 SALV2:  SKIPN QACT(I)
2642          JRST SALV3
2643         HRRZ B,QNTUTO(I)        ;ZERO OUT NEW TUT
2644         HRL B,B
2645         SETZM (B)
2646         MOVE A,B
2647         AOS B
2648         BLT B,2000*MXTUTB-1(A)
2649         HRRZ B,QNTUTO(I)        ;COPY RANDOM INFO FROM OLD TUT TO NEW
2650         HRL B,QOTUTO(I)
2651         MOVE A,B
2652         BLT A,LTIBLK-1(B)
2653         HRRZ A,QNTUTO(I)
2654         PUSHJ P,TUTFIL          ;FILL IN BLOCKS AREA OF TUT
2655 SALV3:  SOJGE I,SALV2
2656         MOVE I,MDSK
2657         MOVEI A,MFD
2658         MOVE J,MFDBK
2659         PUSHJ P,READ
2660         JUMPL T,ACTUE3
2661         MOVE A,MFD+MDNUDS
2662         CAME A,NUDS
2663          JRST [ TYPE Wrong NUDSL version =
2664                 X TDPT
2665                 JRST ERRDDT]
2666         MOVE A,MFD+MDCHK
2667         CAME A,[SIXBIT /M.F.D./]
2668          JRST [ TYPE MFD check word garbaged?
2669                 X T6B
2670                 X CRR
2671                 SKIPN GOGOX
2672                 X CONTIN
2673                  JRST ERRDDT
2674                 JRST .+1]
2675         MOVE Q,MFD+MDNAMP
2676         ADDI Q,MFD
2677 MFDLUP: CAIL Q,MFD+2000
2678          JRST MFDFIN
2679         SKIPN A,MNUNAM(Q)
2680          JRST MFDLU1
2681         PUSHJ P,USRLUP
2682         SKIPN LFILES
2683          PUSHJ P,DELUSR
2684 MFDLU1: ADDI Q,LMNBLK
2685         JRST MFDLUP
2686
2687 DELUSR: MOVE A,MNUNAM(Q)
2688         CAMN A,[SIXBIT /.LPTR./]
2689          POPJ P,
2690         PUSHJ P,T6B
2691         TYPE ; NO FILES, USER DIRECTORY DELETED
2692         PUSHJ P,CRR
2693         SETZM MNUNAM(Q)
2694         SETOM MFDWRT
2695         POPJ P,
2696 \f
2697 USRLUP: MOVEM A,USRNAM
2698         SETZM UFDLOS
2699         SETZM UFDSEE                    ;-1 IF ANY ERROR OCCURS, PRINT WHOLE UFD
2700         SETZM LFILES
2701         MOVE J,Q
2702         SUBI J,MFD+2000                 ;MAP MFD ENTRY INTO UFD BLOCK
2703         IDIVI J,LMNBLK                  ; -Nth USER DIRECTORY
2704         ADD J,NUDS                      ;END OF USER DIR AREA - N
2705         PUSH P,Q
2706         PUSH P,UDSK                     ;SAVE UFD DISK, MIGHT CHANGE IF UFD IS BAD
2707         MOVEM J,DBLK
2708         MOVE I,UDSK
2709 USRLU1: MOVEI A,OUSRD                   ;COME BACK TO HERE ON TRY NEXT DRIVE
2710         PUSHJ P,READ
2711         JUMPL T,USRLE2
2712         MOVE Q,OUSRD+UDNAME
2713         CAME Q,USRNAM
2714          JSR USRLE4
2715         MOVE Q,[OUSRD,,NUSRD]
2716         BLT Q,NUSRD+1777                ;COPY OLD FOR GARBAGE CHECK
2717         MOVEI Q,2000-LUNBLK+OUSRD
2718         MOVEI J,OUSRD
2719         ADD J,UDNAMP(J)                 ;LOWEST FILE NAME BLOCK
2720         CAIG J,OUSRD+2000
2721         CAIGE J,OUSRD+UDDESC
2722          JRST USRLE3                    ;NAME POINTER OUTSIDE BLOCK! (try next drive)
2723         MOVE T,OUSRD+UDESCP
2724         IDIVI T,6
2725         ADDI T,OUSRD+UDDESC
2726         CAML T,J
2727          JRST USRLE7            ;NAME AND DESCRIPTOR AREAS OVERLAP (try next drive)
2728         PUSH P,J                ; FILE NAME POINTER
2729
2730 ;PER FILE LOOP
2731 DIRL1:  CAMGE Q,J
2732          JRST USRFIN
2733         SETOM FILEER            ; PRINT FILE NAME ONLY ON FIRST ERROR
2734         SETZM BADFIL            ; SET IF BAD RETRIEVAL DISCOVERED
2735         MOVEM Q,LASTQ
2736         SKIPN A,UNFN1(Q)
2737         SKIPE UNFN2(Q)
2738          CAIA
2739           JRST DIRLUP
2740         AOS LFILES
2741         LDB C,[UNPKN UNRNDM(Q)]
2742         LDB A,[UNDSCP UNRNDM(Q)]
2743         CAML A,OUSRD+UDESCP
2744          JRST DIRLE1            ;POINTS OUTSIDE DESC AREA (ignore)
2745         IDIVI A,6
2746         ADDI A,OUSRD+UDDESC
2747         HLL A,QBTBLI(B)
2748         TLNE A,400000
2749          SUB A,[440000,,1]
2750         MOVEI ZR,0
2751         LDB B,A
2752         JUMPN B,DIRLE2          ;NOT PRECEEDED BY ZERO (ignore)
2753 DIRL2:  MOVE N,A
2754         MOVEI J,0
2755         ILDB B,A
2756         JUMPE B,DIRLE3          ;POINTS TO ZERO (ignore)
2757 DIRL3:  MOVE TT,UNRNDM(Q)
2758         TLNE TT,UNLINK
2759          JRST LINK
2760         SETZM NOTUT
2761         PUSHJ P,FINDPK          ;FIND WHICH PACK
2762         SKIPL C
2763          SKIPN QACT(C)
2764           SETOM NOTUT           ;FILE ON UNMOUNTED PACK, DON'T HACK TUT
2765         MOVEM C,FUNIT
2766         SETZM LSTBLK
2767         SETZM ADRSET
2768 TRLUP:  MOVE TT,N
2769         ADDI TT,NUSRD-OUSRD
2770         IDPB ZR,TT
2771         ILDB B,N
2772         JUMPE B,DIRLUP
2773         CAIN B,UDWPH    ; WRITE PLACE HOLDER, OR NULL FILE
2774          JRST TRLUP
2775         CAIL B,UDWPH
2776          JRST LOAD
2777         CAILE B,UDTKMX
2778          JRST SKIPF
2779         JRST TLUP
2780 \f
2781 TLUP:   AOS Q
2782 TLUP1:  MOVE A,Q
2783         SKIPN ADRSET
2784          JRST DIRLE4            ;NO STARTING BLOCK (ignore untill jmp)
2785         SKIPE NOTUT             ;IF NOT ON ACTIVE UNIT, SKIP FILE
2786          JRST CKFL3
2787         MOVE D,QOTUTO(C)
2788         CAML A,QLASTB(D)
2789          JRST DIRLE5            ;BLOCK OFF DSK (ignore block)
2790         CAMGE A,QFRSTB(D)
2791          JRST DIRLE5
2792         CAMGE A,NUDS
2793          JRST DIRLE6            ;POINTS TO UFDS (ignore block)
2794 CKFL2A: MOVSI D,-LSBTAB
2795         CAMN A,SBTAB(D)
2796          JRST DIRLE6            ;SPECIAL BLOCK
2797         AOBJN D,.-2
2798         MOVE D,MFDBK
2799         SUB D,NTBL(C)
2800         CAML A,D
2801          CAMLE A,MFDBK
2802           CAIA
2803            JRST DIRLE6          ;TUT
2804 NTS,[   SKIPGE CKFLSW
2805          PUSHJ P,CKFL
2806 ];NTS
2807         MOVEM Q,LSTBLK
2808         SKIPN NOTUT
2809          SKIPN ADRSET
2810           JRST CKFL3
2811         MOVE D,J        ;SEE IF BLOCK LOCKED
2812         SUBI D,NTUT0-OTUT0 ;(LOCK BYTES NOT IN NEW TUT YET)
2813         ILDB D,D
2814         CAIN D,TUTLK
2815          PUSHJ P,DIRLEB
2816         ILDB D,J
2817         SKIPE D
2818          JSR DIRLE7     ;SHARED BLOCK
2819         CAIGE D,TUTMNY
2820          AOS D
2821         DPB D,J
2822         MOVE K,J
2823         SUBI K,NTUT0-OTUT0
2824         LDB D,K
2825         JUMPE D,DIRLE9
2826 CKFL3:  SOJG B,TLUP
2827         JRST TRLUP
2828
2829 OLDFIL: SETOM UFDSEE            ;PRINT WHOLE UFD LATER
2830         AOSE FILEER
2831          JRST CKFL2A
2832         TYPE !!! Over-writing user-directory area block
2833         MOVE A,Q
2834         X DPT
2835         TYPE , BY
2836         X PNTNAM
2837         JRST CKFL2A
2838
2839 \f
2840 CKFL:   PUSH P,J
2841         PUSH P,I
2842         SETOM XWDSEE
2843         MOVE J,A
2844         MOVEI A,FDBUF
2845         MOVE I,C
2846         PUSHJ P,READ
2847 CKFLBP: JUMPL T,CKFLE1
2848 CKFL4:
2849 DC,[    MOVE A,RXWDS+XWSYSN
2850         CAME A,USRNAM
2851         JRST CKFLE2
2852 CKFL5:  LDB A,[XWBLK RXWDS]
2853         CAME A,LSTBLK
2854         JRST CKFL6
2855 CKFL6A: SKIPE CKFIX                     ;FIX ERRORS?
2856         SKIPGE XWDSEE                   ;ANY ERRORS?
2857         JRST CKFL7
2858         LDB A,[XWAWC RXWDS]
2859         DPB A,[XWAWC WXWDS]
2860         MOVE A,LSTBLK
2861         DPB A,[XWBLK WXWDS]
2862         MOVE A,USRNAM
2863         MOVEM A,WXWDS+XWSYSN
2864         MOVE Q,LASTQ
2865         MOVE A,UNFN1(Q)
2866         MOVEM A,WXWDS+XWFN1
2867         MOVE A,UNFN2(Q)
2868         MOVEM A,WXWDS+XWFN2
2869         MOVEI A,FDBUF
2870         PUSHJ P,WRITE
2871         MOVEI A,FDBUF
2872         PUSHJ P,READ
2873         JUMPL T,CKFLE1
2874         LPR RETRIEVAL NOW:
2875         PUSHJ P,LPTXWD
2876         SETOM XWDSEE
2877         JRST CKFL4
2878 ];DC
2879 CKFL7:  POP P,I
2880         POP P,J
2881         POPJ P,
2882
2883 CKFLE1: PUSHJ P,PNTNAM
2884         TYPE ERROR READING BLOCK
2885 CKFLE3: MOVE A,J
2886         PUSHJ P,DPT
2887         PUSHJ P,CRR
2888         PUSHJ P,PNTXWD
2889         PUSHJ P,GSTS
2890         JRST CKFL4
2891 DC,[
2892 CKFLE2: JRST CKFL6A             ;JFCL THIS IF YOU HATE ARCHIVES
2893         AOS BADFIL
2894         PUSHJ P,LPTNAM
2895         X LTAB
2896         X LPTXWD
2897         X LTAB
2898         LPR Retrieval User-name differs
2899         LDB A,[XWBLK RXWDS]
2900         CAMN A,LSTBLK
2901         JRST [  X LCRR
2902                 JRST CKFL6A]
2903         LPR ,
2904         JRST CKFLE4
2905
2906 CKFL6:  JRST CKFL6A             ;JFCL THIS IF YOU HATE ARCHIVES
2907         AOS BADFIL
2908         PUSHJ P,LPTNAM
2909         X LTAB
2910         X LPTXWD
2911         X LTAB
2912 CKFLE4: LPR Chain pointer wrong, Last block=
2913         MOVE A,LSTBLK
2914         PUSHJ P,LOPT
2915         PUSHJ P,LCRR
2916         JRST CKFL6A
2917 ];DC
2918 \f
2919 LOAD:   SETOM ADRSET            ;B HAS BYTE WHERE  UDWPH < BYTE <=77
2920         ANDCMI B,20             ;DM FUNNY BITS
2921         MOVEI J,-UDWPH-1(B)
2922         MOVEI K,NXLBYT
2923 LOAD1:  MOVE TT,N
2924         ADDI TT,NUSRD-OUSRD
2925         IDPB ZR,TT
2926         ILDB B,N
2927         LSH J,6
2928         ADD J,B
2929         SOJG K,LOAD1
2930         MOVE Q,J
2931         SKIPE NOTUT
2932          JRST LOAD2             ;THIS DRIVE NOT ACTIVE
2933         MOVE I,C
2934         PUSHJ P,TUTPNN          ;GET POINTER TO NEW TUT
2935         ADD J,[TUTBYT_14,,]     ;BACK UP FOR ILDB
2936 LOAD2:  MOVEI B,1
2937         JRST TLUP1
2938
2939 SKIPF:  SUBI B,UDTKMX
2940         IBP J
2941         AOS Q
2942         SOJG B,.-2
2943         MOVEI B,1
2944         JRST TLUP
2945 \f
2946 LINK:   MOVE TT,N
2947         ADDI TT,NUSRD-OUSRD
2948         PUSHJ P,LTYPE
2949          JRST DIRLEC
2950         PUSHJ P,LTYPE
2951          JRST DIRLEC
2952         PUSHJ P,LTYPE
2953          JRST DIRLUP
2954         ILDB B,N
2955         JUMPE B,DIRLUP
2956         JRST DIRLE8             ;LINK NOT FOLLOWED BY ZERO (ignore)
2957
2958 LTYPE:  MOVEI B,6
2959 LTYPE2: IDPB ZR,TT
2960         ILDB A,N
2961         JUMPE A,CPOPJ           ;NON SKIP RETURN IF FOLLOWED BY ZERO
2962         CAIN A,':
2963          JRST [ ILDB A,N
2964                 IDPB ZR,TT
2965                 JRST LTYPE3]
2966         CAIE A,';
2967 LTYPE3:  SOJG B,LTYPE2
2968         JRST POPJ1              ;SKIP RETURN IF ENDS NATURALLY
2969
2970 DIRLUP: SKIPN BADFIL
2971          JRST DIRLP1
2972         TYPE BAD RETRIEVAL:
2973         X PNTNAM
2974 DIRLP1: MOVE Q,LASTQ
2975         MOVE J,(P)
2976         MOVSI A,UNMARK
2977         ANDCAM A,UNRNDM(Q)
2978         SUBI Q,LUNBLK
2979         JRST DIRL1
2980
2981 FINDPK: PUSH P,B                ;MAP PACK NUMBER IN C, TO UNIT NUMBER
2982         MOVEI B,NUNITS-1
2983         CAMN C,QPKN(B)
2984          JRST FINDP1
2985         SOJGE B,.-2
2986         SETOM C
2987         POP P,B
2988         POPJ P,
2989
2990 FINDP1: HRRZ C,B
2991         POP P,B
2992         POPJ P,
2993 \f
2994 USRLE2: TYPE USR DIRECTORY READ ERROR
2995         SETOM FLAG'             ;HARDWARE ERROR
2996 USRL2A: PUSHJ P,TSPAC
2997         MOVE A,USRNAM
2998         PUSHJ P,SIXTYP
2999         MOVEI A,";
3000         PUSHJ P,TYO
3001         PUSHJ P,CRR
3002         SKIPE FLAG
3003          PUSHJ P,GSTS           ;PRINT CONTROLLER STATUS
3004         SKIPE GOGOX
3005          JRST ERRDDT
3006         TYPE TRY NEXT DRIVE?
3007         PUSHJ P,TYI
3008         CAIE A,"Y
3009          JRST CRDDT
3010         PUSHJ P,CRR
3011         MOVE I,UDSK
3012 USRL2B: AOS I
3013         CAIL I,NUNITS
3014          SUBI I,NUNITS
3015         SKIPN QACT(I)
3016          JRST USRL2B
3017         MOVEM I,UDSK    ;WILL GET POPED BEFORE NEXT USER
3018         SETOM UFDLOS    ;CAUSE DIR TO BE WRITTEN ON ALL DRIVES
3019         MOVE J,DBLK
3020         JRST USRLU1
3021
3022 USRLE3: TYPE User directory name-pointer scrambled
3023         SETZM FLAG
3024         JRST USRL2A
3025
3026 USRLE7: TYPE Name area, descriptor area overlap
3027         SETZM FLAG
3028         JRST USRL2A
3029
3030 USRLE4: 0       ;USR NAME IN DIR DIFFERS
3031         TYPE USER NAME IN DIRECTORY DIFFERS
3032         PUSHJ P,TSPAC
3033         MOVE A,USRNAM
3034         PUSHJ P,T6B
3035         TYPE ; BLOCK
3036         MOVE A,DBLK
3037         X DPT
3038         UNTMES , UNIT
3039         MOVE A,I
3040         PUSHJ P,DPT
3041         TYPE , DIR HAS
3042         X TSPAC
3043         MOVE A,OUSRD+UDNAME
3044         X T6B
3045         PUSHJ P,CRR
3046         SKIPE GOGOX
3047          JRST ERRDDT
3048         TYPE CORRECT IT? (MFD ENTRY TAKEN AS GOOD)
3049         PUSHJ P,TYI
3050         X CRR
3051         CAIE A,"Y
3052          JRST ERRDDT
3053         MOVE A,USRNAM
3054         MOVEM A,OUSRD+UDNAME
3055         MOVEI A,OUSRD
3056         PUSHJ P,WRITE
3057         JRST @USRLE4
3058 \f
3059 USRLE5: SETOM UFDSEE
3060         SKIPN GARBF
3061          PUSHJ P,PGARBF
3062         LPR , POINTER=
3063         MOVE A,Q
3064         PUSHJ P,LOPT
3065         LPR , GARBAGE IS
3066         MOVE A,NUSRD(Q)
3067         ANDCAM A,OUSRD(Q)       ;CLEAR OUT THE GARBAGE
3068         PUSHJ P,LOPT
3069         PUSHJ P,LCRR
3070         AOJA Q,GARB6
3071
3072 PGARBF: LPR GARBAGE IN FREE AREA
3073         PUSHJ P,LCRR
3074         MOVE A,USRNAM
3075         PUSHJ P,L6B
3076         LPR ; Block #
3077         MOVE A,DBLK
3078         PUSHJ P,LOPT
3079         PUSHJ P,LCRR
3080         SKIPE GOGOX
3081          JRST ERRDDT
3082         SETOM UFDLOS
3083         SETOM GARBF
3084         POPJ P,
3085
3086 USRLE6: SETOM UFDSEE
3087         SKIPN EXGARB
3088          PUSHJ P,PEXGAR
3089         MOVE A,J
3090         PUSHJ P,LOPT
3091         PUSHJ P,LSPAC
3092         MOVE A,B
3093         PUSHJ P,LOPT
3094         PUSHJ P,LCRR
3095         MOVE TT,Q
3096         SUBI TT,NUSRD-OUSRD
3097         DPB ZR,TT
3098         JRST GARB3
3099
3100 PEXGAR: LPR EXTRA GARBAGE IN UFD
3101         PUSHJ P,LCRR
3102         MOVE A,USRNAM
3103         PUSHJ P,L6B
3104         LPR ; Block #
3105         MOVE A,DBLK
3106         PUSHJ P,LOPT
3107         PUSHJ P,LCRR
3108         SKIPE GOGOX
3109          JRST ERRDDT
3110         SETOM UFDLOS
3111         SETOM EXGARB
3112         POPJ P,
3113
3114 \f
3115 PNTNAM: PUSH P,NOLPT
3116         SETOM NOLPT
3117         X LPTNAM
3118         POP P,NOLPT
3119         POPJ P,
3120
3121 LPTNAM: PUSH P,A                ;DIRLE5 ETC.
3122         MOVE A,USRNAM
3123         PUSHJ P,L6B
3124         MOVEI A,";
3125         PUSHJ P,LTYO
3126         CAIA
3127 LPTFIL:  PUSH P,A               ;AVOID PDL SCREWAGE
3128         PUSH P,B
3129         PUSH P,C
3130         MOVE B,LASTQ
3131         MOVE A,UNFN1 (B)
3132         PUSHJ P,L6B
3133         PUSHJ P,LSPAC
3134         MOVE A,UNFN2(B)
3135         PUSHJ P,L6B
3136         LDB C,[UNPKN UNRNDM(B)]
3137         LPR   PACK
3138         MOVE A,C
3139         X LDPT
3140         X FINDPK                        ;FIND PACK FILE IS ON
3141         JUMPL C,LPTFI1
3142         LPR , UNIT #
3143         MOVE A,C
3144         X LDPT
3145 LPTFI1: PUSHJ P,LCRR
3146         INSIRP POP P,[C B A]
3147         POPJ P,
3148
3149 PNTXWD: PUSH P,NOLPT
3150         SETOM NOLPT
3151         X LPTXWD
3152         POP P,NOLPT
3153         POPJ P,
3154
3155 LPTXWD:
3156 DC,[
3157         PUSH P,A
3158         LPR Extra words: Block #
3159         MOVE A,UNIT
3160         X LDPT
3161         MOVEI A,"-
3162         X LTYO
3163         MOVE A,BLK
3164         X LOPT
3165         X LSPAC
3166         MOVE A,RXWDS+XWSYSN
3167         PUSHJ P,L6B
3168         MOVEI A,";
3169         PUSHJ P,LTYO
3170         MOVE A,RXWDS+XWFN1
3171         PUSHJ P,L6B
3172         PUSHJ P,LSPAC
3173         MOVE A,RXWDS+XWFN2
3174         PUSHJ P,L6B
3175         LPR , Chain pointer=
3176         LDB A,[XWBLK RXWDS]
3177         PUSHJ P,LOPT
3178         LPR , active wd cnt=
3179         LDB A,[XWAWC RXWDS]
3180         PUSHJ P,LOPT
3181         PUSHJ P,LCRR
3182         POP P,A
3183 ];DC
3184         SETZM XWDSEE            .SEE CKFL6A
3185         POPJ P,
3186 \fDIRLE1:        PUSHJ P,LPTNAM
3187         LPR DESC POINTS OUT OF DESC AREA
3188         PUSHJ P,LCRR
3189         SKIPE GOGOX
3190          JRST ERRDDT
3191         SETOM UFDSEE
3192         JRST DIRLUP
3193
3194 DIRLE2: PUSHJ P,LPTNAM
3195         LPR FILE NOT PRECEEDED BY ZERO
3196         PUSHJ P,LCRR
3197         SKIPE GOGOX
3198          JRST ERRDDT
3199         SETOM UFDSEE
3200         JRST DIRL2
3201
3202 DIRLE3: PUSHJ P,LPTNAM
3203         LPR FILE POINTS TO ZERO
3204         PUSHJ P,LCRR
3205         SKIPE GOGOX
3206          JRST ERRDDT
3207         SETOM UFDSEE
3208         JRST DIRL3
3209
3210 DIRLE4: PUSHJ P,LPTNAM
3211         LPR STARTING ADDRESS NOT SET
3212 DIRL4A: X LCRR
3213         SKIPE GOGOX
3214          JRST ERRDDT
3215         SETOM UFDSEE
3216         JRST CKFL3
3217
3218 DIRLE5: PUSHJ P,LPTNAM
3219         LPR BLOCK POINTS OFF DSK
3220         X LOPT
3221         JRST DIRL4A
3222
3223 DIRLE6: PUSHJ P,LPTNAM
3224         LPR BLOCK IN RESERVED AREA
3225         X LOPT
3226         JRST DIRL4A
3227
3228 DIRLE7: 0
3229         PUSHJ P,LPTNAM
3230         LPR SHARES BLOCK WITH SOME OTHER FILE
3231         X LCRR
3232         AOS SHARED      ;SHARED BLOCK FLAG
3233 ;       SKIPN NOLPT
3234 ;        SETOM UFDSEE
3235         SETZM SALVRT    ;NO AUTOMATIC SYS START
3236         JRST @DIRLE7
3237
3238 DIRLEC: PUSHJ P,LPTNAM
3239         LPR LINK NOT THREE NAMES
3240         JRST DIRLED
3241
3242 DIRLE8: PUSHJ P,LPTNAM
3243         LPR LINK NOT FOLLOWED BY A ZERO
3244 DIRLED: PUSHJ P,LCRR
3245         SKIPE GOGOX
3246          JRST ERRDDT
3247         SETOM UFDSEE
3248         JRST DIRLUP
3249
3250 DIRLE9: SKIPE NOQUES
3251          JRST CKFL3
3252         LPR FILE UNPROTECTED IN OLD TUT -
3253         X LPTNAM
3254         LPR Block
3255         MOVE A,Q
3256         X LOPT
3257         X LCRR
3258         JRST CKFL3
3259
3260 DIRLEB: PUSHJ P,LPTNAM
3261         LPR FILE CONTAINS LOCKED BLOCK
3262         MOVE A,Q
3263         X LOPT
3264         SETZM SALVRT            ;NO AUTO SYS STARTUP
3265         JRST LCRR
3266 \f
3267 USRFIN: CLEARM GARBF
3268         CLEARM EXGARB
3269         CLEARB ZR,J
3270         MOVE Q,[440600,,NUSRD+UDDESC]
3271 GARB2:  CAML J,OUSRD+UDESCP
3272          JRST USRFN2
3273 GARB4:  ILDB B,Q
3274         JUMPN B,USRLE6          ;GARBAGE IN DESCRIPTOR AREA (clear out)
3275 GARB3:  AOJA J,GARB2
3276
3277 USRFN2: TLNE Q,770000
3278          JRST GARB4
3279         MOVEI Q,-NUSRD+1(Q)     ;FIRST WORD ABOVE DESCRIPTOR AREA
3280 GARB6:  CAML Q,NUSRD+UDNAMP
3281          JRST GARB5
3282         SKIPN NUSRD(Q)
3283          AOJA Q,GARB6
3284         JRST USRLE5             ;GARBAGE IN NAME AREA (clear out)
3285
3286 GARB5:  SKIPE UFDSEE
3287          PUSHJ P,UFDPR
3288         SKIPN UFDLOS
3289          JRST USRFN5
3290         SKIPE NOQUES
3291          JRST GARB5A
3292         TYPE UFD NEEDS UPDATE - WRITE?
3293         X Y.OR.N
3294          JRST USRFN5
3295 GARB5A: MOVEI A,OUSRD
3296         MOVEI I,NUNITS-1
3297         MOVE J,DBLK
3298 GARB7:  SKIPE QACT(I)
3299          PUSHJ P,WRITE
3300         SOJGE I,GARB7
3301 USRFN5: POP P,J
3302         POP P,UDSK
3303         POP P,Q
3304         POPJ P,
3305
3306 \f
3307 SUBTTL LISTF - DUMP OUT USER DIRECTORY
3308 LISTF:  JSR INIT
3309         SKIPL ACTIVE            ;ALREADY DID RESET
3310          X ACTUN
3311         X CRR
3312         TYPE USER?=
3313         X SIXIN
3314         X CRR
3315         JUMPE B,DDT
3316         MOVEI I,NUNITS-1
3317         SETOM FUNIT
3318 LISTF3: SKIPN QACT(I)
3319          JRST LISTF2
3320         MOVEM I,FUNIT
3321         MOVE A,QNTUTO(I)
3322         PUSHJ P,RDTUT
3323         JUMPL T,[TYPE ERROR READING TUT #
3324                 MOVE A,I
3325                 X DPT
3326                 X CRR
3327                 X GSTS
3328                 X CONTIN
3329                 JRST DDT
3330                 JRST .+1]
3331 LISTF2: SOJGE I,LISTF3
3332         MOVEM B,USRNAM
3333         MOVEI A,MFD
3334         MOVE J,MFDBK
3335         SKIPGE I,FUNIT          ;USE FIRST ACTIVE UNIT
3336          JRST LISTF4            ;NO DISKS ACTIVE??
3337         X READ
3338         JUMPL T,[TYPE ERROR READING MFD
3339                 X CRR
3340                 X GSTS
3341                 X CONTIN
3342                 JRST DDT
3343                 JRST .+1]
3344         MOVE D,USRNAM
3345         MOVE Q,MFD+MDNAMP
3346 LISTF1: CAIL Q,2000
3347          JRST [ TYPE USER NOT FOUND -
3348                 MOVE A,D
3349                 X T6B
3350                 JRST CRDDT]
3351         CAME D,MFD(Q)
3352          JRST [ ADDI Q,LMNBLK
3353                 JRST LISTF1]
3354         SUBI Q,2000
3355         IDIVI Q,LMNBLK
3356         HRRZ J,Q
3357         ADD J,NUDS
3358         MOVEM J,DBLK
3359         MOVE I,FUNIT            ;USE FIRST ACTIVE UNIT
3360         MOVEI A,OUSRD
3361         X READ
3362         JUMPL T,[TYPE ERROR READING USER DIRECTORY
3363                 X CRR
3364                 X GSTS
3365                 X CONTIN
3366                 JRST CRDDT
3367                 JRST .+1]
3368         X USEE0
3369         JRST CRDDT
3370
3371 CONTIN: TYPE CONTINUE?
3372         X TYI
3373         X CRR
3374         CAIN A,"Y
3375          AOS (P)
3376         POPJ P,
3377
3378 LISTF4: TYPE NO ACTIVE UNIT TO GET DIR FROM
3379         JRST CRDDT
3380 \f
3381 UFDPR:  SETZM SALVRT            ;NO AUTO SYS STARTUP
3382         SKIPN NOLPT
3383          JRST [ TYPE Errors in directory
3384                 MOVE A,OUSRD+UDNAME
3385                 X T6B
3386                 X CRR
3387                 JRST .+1 ]
3388 USEE0:  MOVE Q,OUSRD+UDNAME
3389         PUSHJ P,LFORM
3390         LPR USER DIRECTORY:
3391         MOVE A,Q
3392         X L6B
3393         MOVEI A,";
3394         X LTYO
3395         X LCRR
3396         MOVEI J,OUSRD
3397         ADD J,UDNAMP(J)
3398         CAIG J,OUSRD+2000
3399         CAIGE J,OUSRD+UDDESC
3400          JRST [ LPR UFD NAME AREA POINTER OUT OF RANGE
3401                 JRST USEEF ]
3402         MOVE T,OUSRD+UDESCP
3403         IDIVI T,6
3404         ADDI T,OUSRD+UDDESC
3405         CAML T,J
3406          JRST [ LPR DESCRIPTOR FREE POINTER OVERLAPS NAME AREA
3407                 JRST USEEF ]
3408         MOVEM J,LAST
3409         MOVEI Q,OUSRD+2000-LUNBLK
3410 USEE1:  CAMGE Q,LAST                    ;PER FILE LOOP
3411          JRST USEEF
3412         MOVEM Q,LASTQ
3413         SKIPN A,UNFN1(Q)
3414         SKIPE UNFN2(Q)
3415          CAIA
3416           JRST USEELP
3417         X LPTFIL
3418         LDB C,[UNPKN UNRNDM(Q)]
3419         X FINDPK
3420         MOVEM C,FUNIT                   ;KLUDGE KLUDGE (LOOKS AT TUTS)
3421         LDB A,[UNDSCP UNRNDM(Q)]
3422         CAML A,OUSRD+UDESCP
3423          JRST [ LPR FILE DESCRIPTOR POINTER POINTS OUTSIDE DESCRIPTOR AREA
3424                 JRST USEELY ]
3425         IDIVI A,6
3426         ADDI A,OUSRD+UDDESC
3427         HLL A,QBTBLI(B)
3428         TLNE A,400000
3429          SUB A,[440000,,1]
3430         LDB B,A
3431         X LTAB
3432         X USBYTE
3433         LPR (INITIAL ZERO)
3434         JUMPN B,[ LPR - IS NOT PRESENT
3435                   JRST USEELY ]
3436         X LCRR
3437 USEE2:  MOVE N,A
3438         MOVEI J,0
3439         ILDB B,A                        ;PEEK AT NEXT BYTE
3440         JUMPE B,[X USBYTE
3441                  LPR  (FIRST BYTE SHOULD BE NON-ZERO)
3442                  JRST USEELY]           ;SHOULD BE NON-ZERO
3443         LDB A,[UNDSCP UNRNDM(Q)]
3444         X LOPT                          ;SHOW DESC ADDR BEFORE FIRST DESC BYTE
3445 USEE3:  MOVE TT,UNRNDM(Q)
3446         TLNE TT,UNLINK
3447          JRST USLINK
3448 \f;FALLS THROUGH
3449         SETZM ADRSET
3450 USLUP:  ILDB B,N
3451         X LTAB
3452         X USBYTE
3453         JUMPE B,[LPR (STOP)
3454                  X LCRR
3455                  JRST USEELP]
3456         CAIN B,UDWPH
3457          JRST [ LPR (WRITE-PLACE-HOLDER)
3458                 X LCRR
3459                 JRST USLUP]
3460         CAIL B,UDWPH
3461          JRST USLOAD
3462         CAILE B,UDTKMX
3463          JRST USSKIP
3464         LPR (TAKE-N BLOCKS)
3465 USLP1:  AOS Q
3466 USLP2:  MOVE A,Q
3467         X LOPT
3468         X LSPAC
3469         SKIPGE TT,FUNIT
3470          JRST USLP3             ;PACK NOT MOUNTED
3471         MOVE TT,QOTUTO(TT)
3472         CAMGE Q,QLASTB(TT)
3473          SKIPN ADRSET
3474           JRST USLPE            ;BAD BLOCK
3475         ILDB TT,J               ;TUT ENTRY
3476         CAMGE Q,NUDS
3477          JRST USLPE
3478         MOVSI D,-LSBTAB
3479         CAMN Q,SBTAB(D)
3480          JRST USLPE
3481         AOBJN D,.-2
3482         MOVE A,FUNIT
3483         MOVE D,MFDBK
3484         SUB D,NTBL(A)
3485         CAML Q,MFDBK
3486          CAMLE Q,D
3487           CAIA
3488            JRST USLPE           ;OVERLAPS TUT OR MFD
3489
3490         SKIPL FUNIT             ;FILE NOT ON ACTIVE UNIT
3491          CAIN TT,1
3492           JRST USLP3
3493         LPR ?? TUT=
3494         MOVE A,TT
3495         X LDPT
3496         LPR ??
3497 USLP3:  SOJG B,USLP1
3498         X LCRR
3499         JRST USLUP
3500 USLPE:  LPR ?? BAD BLOCK # ??
3501         JRST USLP3
3502
3503 USEELP: MOVE Q,LASTQ
3504         SUBI Q,LUNBLK
3505         JRST USEE1
3506 \f
3507 USLOAD: SETOM ADRSET
3508         ANDCMI B,20             ;DM FUNNY BITS
3509         MOVEI J,-UDWPH-1(B)
3510         MOVEI K,NXLBYT
3511 USLOD1: ILDB B,N
3512         X USBYTE
3513         LSH J,6
3514         ADD J,B
3515         SOJG K,USLOD1
3516         MOVE Q,J
3517         SKIPGE I,FUNIT
3518          TDZA J,J               ;NO TUT
3519           PUSHJ P,TUTPNO        ;GET POINTER TO OLD TUT
3520         ADD J,[TUTBYT_14,,]     ;BACK UP FOR ILDB
3521         LPR (JUMP
3522         MOVE A,Q
3523         X LOPT
3524         LPR )
3525         MOVEI B,1
3526         JRST USLP2
3527
3528 USSKIP: SUBI B,UDTKMX
3529         LPR (SKIP
3530         MOVE A,B
3531         X LOPT
3532         LPR )
3533         IBP J
3534         AOS Q
3535         SOJG B,.-2
3536         MOVEI B,1
3537         JRST USLP1
3538
3539 USLINK: X LTAB
3540         LPR (LINK)
3541         X USLINP
3542          JRST USLIN3
3543         MOVEI A,";
3544         X LTYO
3545         X USLINP
3546          JRST USLIN3
3547         X LSPAC
3548         X USLINP
3549          ADD N,[060000,,]       ;ENDS WITH ZERO, RE-READ THE ZERO BYTE
3550         X LCRR
3551         ILDB B,N
3552         X LTAB
3553         X USBYTE
3554         LPR (ZERO)
3555         JUMPE B,USLIN4
3556         LPR  ?? NO END ZERO ??
3557 USLIN4: X LCRR
3558         JRST USEELP
3559
3560 USLIN3: LPR  ?? ENDS EARLY ??
3561         JRST USLIN4
3562
3563 USLINP: MOVEI B,6
3564 USLIN2: ILDB A,N
3565         JUMPE A,CPOPJ           ;NON SKIP RETURN IF FOLLOWED BY ZERO
3566         CAIN A,';
3567          JRST POPJ1             ;SKIP RETURN IF ENDS NATURALLY
3568         CAIN A,':               ;QUOTE CHAR
3569          ILDB A,N
3570         ADDI A,40
3571         X LTYO
3572         SOJG B,USLIN2
3573         JRST POPJ1              ;SKIP RETURN IF ENDS NATURALLY
3574 \f
3575 USBYTE: PUSH P,A
3576         PUSH P,B
3577         LDB A,[30300,,(P)]
3578         ADDI A,"0
3579         X LTYO
3580         LDB A,[300,,(P)]
3581         ADDI A,"0
3582         X LTYO
3583         X LSPAC
3584         POP P,B
3585         POP P,A
3586         POPJ P,
3587
3588 USEELY: X LCRR
3589 USSELP: MOVE Q,LASTQ
3590         SUBI Q,LUNBLK
3591         JRST USEE1
3592
3593 USEEF:  X LCRR
3594         X LFORM
3595         POPJ P,
3596 \f
3597 SUBTTL MAIN SALVAGER - WRITE MFD & TUT
3598
3599 MFDFIN: MOVEI I,0
3600 MFDFN0: SKIPE QACT(I)
3601          PUSHJ P,TUTCMP
3602         CAIGE I,NUNITS-1
3603          AOJA I,MFDFN0
3604         SKIPN MFDWRT
3605          JRST SHARCK            ;MFD DIDN'T HAVE ANY CHANGES
3606 MFDWR0: SKIPE NOQUES
3607          JRST MFDWR1
3608         TYPE WRITE OUT CHANGES IN MFD?
3609         X Y.OR.N
3610          JRST SHARCK
3611 MFDWR1: MOVE J,MFDBK
3612         MOVEI I,NUNITS-1
3613 MFDWR2: MOVEI A,MFD
3614         SKIPE T,QACT(I)
3615          PUSHJ P,WRITE
3616         JUMPGE T,MFDWR3
3617         PUSHJ P,GSTS            ;ERROR WRITING MFD
3618         SKIPN GOGOX
3619          JRST MFDWR0
3620         JRST ERRDDT
3621
3622 MFDWR3: SOJGE I,MFDWR2
3623         JRST SHARCK
3624
3625 TUTCMP: SETZM TUTDFR            ;FIRST SEE IF ANY DIFFERENCES
3626         SETZM TTDFPS
3627         SETZM NLKBKS'
3628         SETZM TUTCHG            ;MAKE SUMMARY TABLE OF DIFFERENCES
3629         MOVE Q,[TUTCHG,,TUTCHG+1]
3630         BLT Q,TUTCHG+<TUTMAX*TUTMAX>-1
3631         MOVE Q,QTTBLI
3632         HRR Q,QNTUTO(I)         ;NEW B.P.
3633         ADDI Q,LTIBLK
3634         MOVE J,Q
3635         HRR J,QOTUTO(I)         ;OLD B.P.
3636         MOVE TT,QFRSTB(J)       ;BLOCK NUMBER
3637         MOVE B,QLASTB(J)
3638         SOS B
3639         MOVEM B,TUTHIB'         ;HIGHEST BLOCK #
3640         ADDI J,LTIBLK
3641 TUTC1:  ILDB B,Q
3642         ILDB D,J
3643         CAMN B,D
3644          JRST TUTC2
3645         CAIN D,TUTLK
3646          JRST [ MOVE B,D        ;IF LOCKED, STAY LOCKED
3647                 DPB B,Q
3648                 AOS NLKBKS      ;COUNT BLOCKS LOCKED DUE TO DISK ERRORS
3649                 SKIPN GOGOX
3650                  PUSHJ P,LCKRPT ;IN CHKR MODE, REPORT LOCKED BLOCKS
3651                 JRST TUTC2 ]
3652         PUSHJ P,TUTC4
3653 TUTC2:  CAMGE TT,TUTHIB
3654          AOJA TT,TUTC1
3655         SKIPN NOQUES
3656          SKIPN A,NLKBKS
3657           JRST TUTC3
3658         X TDPT
3659         UNTMES  LOCKED BLOCKS ON UNIT #
3660         HRRZ A,I
3661         X DPT
3662         X CRR
3663 TUTC3:  SKIPN TUTDFR
3664          POPJ P,                ;NO DIFFERENCES THIS TUT
3665         JRST TUTCM0             ;DIFFERENCES, GO HANDLE
3666
3667 TUTC4:  IMULI B,TUTMAX
3668         ADD B,D
3669         MOVE T,QOTUTO(I)        ;DON'T LIST TUT CHANGES IN SWAPPING AREA
3670         CAML TT,NUDS
3671         CAML TT,QSWAPA(T)
3672          AOS TUTCHG(B)
3673         AOS TUTDFR
3674         POPJ P,
3675 \f
3676 TUTCM0: SKIPE NOQUES            ;HERE WHEN TUT HAS DIFFERENCES
3677          JRST TUTCM3            ;IF NO QUESTIONS, JUST WRITE
3678         MOVEI A,TUTMAX*TUTMAX-1 ;SEE IF ANY TUT DIFFERENCES NOT IN SWAPPING AREA
3679         SKIPN TUTCHG(A)
3680          SOJGE A,.-1
3681         JUMPL A,TUTCM4          ;NONE, GO ASK IF SHOULD WRITE
3682         SETZM LINPOS            ;OTHERWISE, SUMMARIZE TUT DIFFERENCES
3683         TYPE TUT #
3684         HRRZ A,I
3685         X DPT
3686         MOVEI B,TUTMAX-1
3687 TUTSM1: MOVEI D,TUTMAX-1
3688 TUTSM2: MOVE A,B
3689         IMULI A,TUTMAX
3690         ADD A,D
3691         SKIPN A,TUTCHG(A)
3692          JRST TUTSM3
3693         X TSPAC
3694         X TDPT
3695         X TSPAC
3696         MOVE A,B
3697         X DPT
3698         TYPE _
3699         MOVE A,D
3700         X DPT
3701         MOVE A,LINPOS
3702         CAIGE A,60.
3703          JRST TUTSM3
3704         X CRR
3705         SETZM LINPOS
3706 TUTSM3: SOJGE D,TUTSM2
3707         SOJGE B,TUTSM1
3708         TYPE , PRINT?
3709         X Y.OR.N
3710          JRST TUTCM4
3711
3712 ;HERE TO PRINT OUT THE TUT
3713
3714         SETZM TUTDFR
3715         MOVE Q,QTTBLI
3716         HRR Q,QNTUTO(I)         ;NEW B.P.
3717         ADDI Q,LTIBLK
3718         MOVE J,Q
3719         HRR J,QOTUTO(I)         ;OLD B.P.
3720         MOVE TT,QFRSTB(J)       ;BLOCK NUMBER
3721         MOVE B,QLASTB(J)
3722         SOS B
3723         MOVEM B,TUTHIB'         ;HIGHEST BLOCK #
3724         ADDI J,LTIBLK
3725 TUTCM1: ILDB B,Q
3726         ILDB D,J
3727         CAME B,D
3728          JRST TUTDF1
3729 TUTCM2: CAMGE TT,TUTHIB
3730          AOJA TT,TUTCM1
3731
3732         SKIPE TTDFPS
3733          X LCRR
3734         X LFORM         ;SOMETHING PRINTED, ADVANCE LPT PAPER
3735 TUTCM4: TYPE TUT #
3736         HRRZ A,I
3737         X DPT
3738         TYPE  NEEDS UPDATING - WRITE?
3739         X Y.OR.N
3740          POPJ P,
3741 TUTCM3:
3742         MOVE A,QNTUTO(I)
3743         PUSHJ P,WRTUT
3744         JUMPGE T,CPOPJ
3745         PUSHJ P,GSTS            ;ERROR WRITING TUT
3746         SKIPN GOGOX
3747          JRST TUTCM4
3748         JRST ERRDDT
3749
3750 TUTMAX=1_TUTBYT
3751
3752 TUTCHG: BLOCK TUTMAX*TUTMAX
3753 \f
3754 TUTDF1: MOVE T,QOTUTO(I)
3755         CAML TT,NUDS
3756         CAML TT,QSWAPA(T)
3757          CAIA
3758           JRST TUTCM2           ;IN SWAPPING AREA, IGNORE
3759         PUSHJ P,NEWOLD
3760         PUSH P,[TUTCM2]
3761         AOSL TTDFPS
3762          JRST TUTDF7            ;NO MORE ROOM ON LINE
3763         MOVEI A,40              ;PRINT MULTIPLE FROBS PER LINE
3764         PUSHJ P,LPTR            ;SO THE LINE PRINTER WILL GO FASTER
3765         JRST LPTR
3766
3767 NEWOLD: SKIPN TUTDFR
3768          PUSHJ P,TUTTYP
3769         MOVE A,TT
3770         PUSHJ P,LOPT
3771         PUSHJ P,LSPAC
3772         MOVE A,B
3773         PUSHJ P,LOPT
3774         MOVEI A,"_
3775         PUSHJ P,LPTR
3776         MOVE A,D
3777         JRST LOPT
3778
3779 TUTTYP: SETOM TUTDFR
3780         PUSHJ P,LCRR
3781         LPR TUT DIFFERENCES FOR DRIVE #
3782         HRRZ A,I
3783         PUSHJ P,LOPT
3784 TUTDF7: MOVNI A,5       ;START NEW LINE, ROOM FOR 5 BLOCKS IF TTY
3785         SKIPN NOLPT
3786          MOVNI A,9      ;OR 9 IF LPT
3787         MOVEM A,TTDFPS
3788         JRST LCRR
3789
3790 LCKRPT: TYPE LOCKED BLOCK
3791         HRRZ A,I
3792         X TDPT
3793         MOVEI A,"-
3794         X TYO
3795         MOVE A,TT
3796         X TOPT
3797         X CRR
3798         POPJ P,
3799 \f
3800 SUBTTL TRACK DOWN SHARED BLOCKS
3801
3802 SHARCK: SKIPN SHARED
3803          JRST CRDDT     ;NO SHARED TRACKS, WE ARE DONE
3804         TYPE SHARED BLOCKS
3805         PUSHJ P,LCRR
3806         LPR LOOKING FOR SHARED BLOCKS
3807         PUSHJ P,LCRR
3808         MOVE I,MDSK
3809         MOVEI A,MFD
3810         MOVE J,MFDBK
3811         PUSHJ P,READ
3812         JUMPL T,ACTUE3
3813         MOVE Q,MFD+MDNAMP
3814         ADDI Q,MFD
3815 SMFDLP: CAIL Q,MFD+2000
3816          JRST SHRCKF            ;DONE
3817         SKIPN A,MNUNAM(Q)
3818          JRST SMFDL1
3819         PUSHJ P,SUSRLP
3820 SMFDL1: ADDI Q,LMNBLK
3821         JRST SMFDLP
3822
3823 SHRCKF: SKIPN GOGOX
3824          JRST CRDDT
3825         JRST ERRDDT
3826
3827 SUSRLP: HRREI J,-MFD-2000(Q)    ;CONVERT MFD INDEX TO BLOCK NUMBER
3828         ASH J,-1
3829         ADD J,NUDS
3830         MOVEM A,USRNAM
3831         PUSH P,Q
3832         MOVE I,UDSK
3833         PUSH P,UDSK
3834 SUSRL1: MOVEI A,OUSRD
3835         PUSHJ P,READ
3836         JUMPL T,SUSRE2
3837         MOVEI Q,2000-LUNBLK+OUSRD
3838         MOVEI J,OUSRD
3839         ADD J,UDNAMP(J)
3840         PUSH P,J
3841 SDIRL1: CAMGE Q,J
3842          JRST SUSRFN
3843         MOVEM Q,LASTQ
3844         SKIPE A,UNFN1(Q)
3845          JRST .+3
3846           SKIPN UNFN2(Q)
3847            JRST SDIRLP
3848         LDB C,[UNPKN UNRNDM(Q)]
3849         LDB A,[UNDSCP UNRNDM(Q)]
3850         IDIVI A,6
3851         ADDI A,OUSRD+UDDESC
3852         HLL A,QBTBLI(B)
3853         TLNE A,400000
3854          SUB A,[440000,,1]
3855 SDIRL2: MOVE N,A
3856         MOVEI J,0
3857         ILDB B,A
3858 SDIRL3: MOVE TT,UNRNDM(Q)
3859         TLNE TT,UNLINK
3860          JRST SDIRLP
3861         PUSHJ P,FINDPK
3862         SKIPL C
3863          SKIPN QACT(C)
3864           JRST SDIRLP
3865         CAIG B,UDWPH            ; A LOAD FIRST THING
3866          JRST SDIRLP
3867
3868 STRLUP: ILDB B,N
3869         JUMPE B,SDIRLP
3870         CAIN B,UDWPH
3871          JRST STRLUP
3872         CAIL B,UDWPH
3873          JRST SLOAD
3874         CAILE B,UDTKMX
3875          JRST SSKIPF
3876         JRST STLUP
3877 \f
3878 STLUP:  AOS Q
3879 STLUP1: ILDB D,J
3880         CAIE D,1
3881          PUSHJ P,SPNT
3882         SOJG B,STLUP
3883         JRST STRLUP
3884
3885 SLOAD:  ANDCMI B,20             ;DM FUNNY BIT
3886         MOVEI J,-UDWPH-1(B)
3887         MOVEI K,NXLBYT
3888 SLOAD1: ILDB B,N
3889         LSH J,6
3890         ADD J,B
3891         SOJG K,SLOAD1
3892         MOVE Q,J
3893         MOVE I,C
3894         PUSHJ P,TUTPNN          ;GET PNTR TO TUT
3895         ADD J,[TUTBYT_14,,]     ;COMPENSATE FOR ILDB
3896         MOVEI B,1
3897         JRST STLUP1
3898
3899 SSKIPF: SUBI B,UDTKMX
3900         IBP J
3901         AOS Q
3902         SOJG B,.-2
3903         MOVEI B,1
3904         JRST STLUP
3905
3906 SPNT:   MOVE A,USRNAM
3907         PUSHJ P,L6B
3908         MOVEI A,";
3909         PUSHJ P,LTYO
3910         EXCH Q,LASTQ
3911         MOVE A,UNFN1(Q)
3912         PUSHJ P,L6B
3913         PUSHJ P,LSPAC
3914         MOVE A,UNFN2(Q)
3915         PUSHJ P,L6B
3916         PUSHJ P,LSPAC
3917         HRRZ A,C
3918         PUSHJ P,LDPT
3919         MOVEI A,"-
3920         PUSHJ P,LTYO
3921         MOVE A,LASTQ
3922         PUSHJ P,LOPT
3923         LPR , TUT=
3924         MOVE A,D
3925         X LDPT
3926         PUSHJ P,LCRR
3927         EXCH Q,LASTQ
3928         POPJ P,
3929 \f
3930 SUSRE2: TYPE USER DIRECTORY PARITY ERROR
3931         PUSHJ P,TSPAC
3932         TYPE BLOCK #
3933         MOVEM J,DBLK
3934         MOVE A,J
3935         PUSHJ P,DPT
3936         UNTMES UNIT #
3937         MOVE A,I
3938         PUSHJ P,DPT
3939         PUSHJ P,CRR
3940         PUSHJ P,GSTS
3941         SKIPE GOGOX
3942          JRST ERRDDT
3943         TYPE TRY NEXT DRIVE?
3944         X Y.OR.N
3945          JRST ERRDDT
3946         MOVE I,UDSK
3947 SUSR2B: AOS I
3948         CAIL I,NUNITS
3949          SUBI I,NUNITS
3950         SKIPN QACT(I)
3951          JRST SUSR2B
3952         MOVEM I,UDSK
3953         MOVE J,DBLK
3954         JRST SUSRL1
3955
3956 SUSRFN: POP P,J
3957         POP P,UDSK
3958         POP P,Q
3959         POPJ P,
3960
3961 SDIRLP: MOVE Q,LASTQ
3962         SUBI Q,LUNBLK
3963         MOVE J,(P)
3964         JRST SDIRL1
3965
3966 POPBAJ: POP P,B
3967 POPAJ:  POP P,A
3968         POPJ P,
3969 \f
3970 SUBTTL INITIALIZATION
3971
3972 INIT:   0
3973         MOVEI P,PDL
3974 NTS,[ KA,[
3975         CONO 675550             ;RESET APR
3976         CONO PI,710000          ;RESET PI
3977         MOVE TT,[JSR UUOHLT]    ;HALT ON UUO
3978         SKIPN 41
3979          MOVEM TT,41
3980         MOVEI A,SA              ;MAKE SURE ALL NECESSARY MEMORY IS PRESENT
3981 INIT0:  MOVE B,(A)
3982         CONSZ 10000
3983          JRST [ TYPE NXM IN SALV MEM
3984                 JRST ERRDDT ]
3985         ADDI A,2000
3986         CAIGE A,THEEND
3987          JRST INIT0
3988 ];KA
3989 KL,[
3990         SETZM DTEOPR            ;BTB IF QUIT OUT AND RESTART
3991         CONO APR,267760         ;I/O RESET, CLEAR + DISABLE ALL FLAGS
3992         CONO PI,010000          ;CLEAR P.I. SYSTEM
3993         CONSZ PAG,400000
3994          JRST .+4               ;JUMP IF CACHE LOOK ENABLE
3995           SWPIA                 ;IF CACHE OFF, INVALIDATE IT BEFORE TURNING ON
3996           CONSZ APR,200000
3997            JRST .-1
3998         MOVEI TT,SALVPF         ;SET TO HALT ON PAGE FAIL (E.G. PARITY ERROR)
3999         MOVEM TT,PFNPC
4000         CONO PAG,600000+EPT/1000 ;SET UP EPT, ENABLE CACHE, DISABLE PAGING AND TRAPS
4001         DATAO PAG,[100000,,400000+EPT/1000]     ;UPT=EPT
4002         MOVEI TT,UUOHLT
4003         SKIPN EPT+430           ;HALT ON KERNEL UUO
4004          MOVEM TT,EPT+430
4005         MOVEI A,SA              ;MAKE SURE ALL NECESSARY MEMORY IS PRESENT
4006 INIT0:  MOVE B,(A)
4007         CONSZ 2000
4008          JRST [ TYPE NXM IN SALV MEM
4009                 JRST ERRDDT ]
4010         ADDI A,1000
4011         CAIGE A,THEEND
4012          JRST INIT0
4013 RH,     CONI DSK,TT
4014 RH,     TLNN TT,(%HID22)
4015 RH,      JRST [ TYPE DF10 IN KA MODE??
4016 RH,             JRST ERRDDT ]
4017 IFN T300P,[                     ;TURN ON DL10 TO ACCESS T-300
4018         CONO DLC,400000 ;MR CLR
4019         CONO DLB,1      ;TURN OFF EXCESS LIGHTS
4020         CONO DLB,2      ;..
4021         CONO DLB,3      ;..
4022         CONO DLB,DL10AR ;64 WORDS FOR PDP11 #0 AT DL10AR
4023         DATAO DLC,[200001,,]    ;KA INTERRUPT MODE
4024         CONO DLC,100020 ;ENB PDP11 PORT #0 NO INTERRUPTS
4025 ];T300P
4026 ];KL
4027 DC,     SETZM ENCS
4028 RH,     SETZM MARKF
4029 RP,[    DATAI DPC,A
4030         TLNN A,NOWRIH
4031          JRST [ TYPE [WRITE HEADERS ENABLED]
4032                 X CRR
4033                 JRST .+1 ]
4034 ];RP
4035         SETOM DRIVE             ;ALL DRIVES ASSUMED TO BE ON-LINE
4036         MOVE A,[DRIVE,,DRIVE+1]
4037         BLT A,DRIVE+NDRIVE-1
4038         MOVEI A,SLVIOWD         ;SET UP CHANNEL PROGRAM AREA
4039         MOVEM A,SLVICWA
4040         SETZM SLVIOWD+1
4041         SETZM SLVICWA+1
4042 ];NTS
4043         SETZM GOGOX
4044         SETZM NOQUES
4045         MOVEI A,NUNITS-1
4046         SETOM QPKN(A)           ;TUT NOT IN YET
4047         SOJGE A,.-1
4048 TS,[
4049         .OPEN TYIC,[SIXBIT /  $TTY/]
4050          .VALUE
4051         .OPEN TYOC,[SIXBIT /  !TTY/]
4052          .VALUE
4053         .CORE <THEEND-1>_-10.+1
4054          .VALUE
4055         MOVE A,[SQUOZE 0,NQS]
4056         .EVAL A,
4057          .VALUE
4058         MOVEM A,NQS
4059         MOVE A,[SQUOZE 0,QACT]
4060         .EVAL A,
4061          .VALUE
4062         MOVEM A,SQACT
4063         MOVE A,[SQUOZE 0,NUDSL]
4064         .EVAL A,
4065          .VALUE
4066         MOVEM A,NUDS
4067         MOVE A,[SQUOZE 0,MFDBLK]
4068         .EVAL A,
4069          .VALUE
4070         MOVEM A,MFDBK
4071         MOVE B,[SQUOZE 0,NTUTBL]
4072         .EVAL B,
4073          .VALUE
4074         MOVEI C,NUNITS-1
4075         MOVEM B,NTBL(C)
4076         SOJGE C,.-1
4077         CAILE B,MXTUTB
4078          .VALUE         ;NOT ASSEMBLED FOR BIG ENOUGH TUTS
4079         MOVE B,[SQUOZE 0,T300P] ;NEED KLUDGES FOR 2 SIZES OF TUT
4080         .EVAL B,
4081          MOVEI B,0
4082         JUMPE B,INI03
4083         MOVE C,[SQUOZE 0,NTUTB1]
4084         .EVAL C,
4085          .VALUE
4086         CAILE C,MXTUTB
4087          .VALUE                 ;TOO BIG
4088         MOVEM C,NTBL(B)
4089         CAIGE B,NUNITS-1
4090          AOJA B,.-2
4091 INI03:  MOVE A,[SQUOZE 0,NBLKS]
4092         .EVAL A,
4093          .VALUE
4094         MOVEM A,SNBLKS
4095         SUBI A,1
4096         MOVEM A,SNBLKS-1
4097 ];TS
4098
4099         ;BRING UP THE LPT
4100
4101         SETOM NOLPT             ;ASSUME THE WORST
4102         SKIPE LPBUST
4103          JRST LPTDWN
4104         SETOM LPFRST'           ;FLAG LPT NOT USED YET
4105
4106 TS,[    TYPE WANT LPT?
4107         PUSHJ P,TYI
4108         X CRR
4109         SETOM LPBUST            ;ASK ONLY ONCE
4110         CAIN A,"Y
4111          .OPEN LPTC,[.UAO,,'LPT]
4112           JRST LPTDWN
4113         SETZM NOLPT
4114         SETZM LPBUST
4115 ];TS
4116 ;DROPS THROUGH
4117 \f;DROPS IN
4118 NTS,[
4119 IFN OLPTP,[             ;BRING UP AI-KA LPT
4120 LPTUP3: CONO LPT,10
4121         DATAO LPT,[440]
4122         MOVEI A,200000
4123 LPTUP1: SOJLE A,LPTUP2
4124         CONSZ LPT,10
4125          JRST LPTUP1
4126         SETZM NOLPT
4127         JRST LPTDWN
4128 ];IFN OLPTP
4129
4130 IFN NLPTP,[                     ;BRING UP ML LPT
4131 LPTUP3: SETOM LPTBFC
4132         MOVE A,[<.BYTE 7 ? 15 ? 15 ? 15 ? 15 ? 15>]
4133         MOVEM A,LPTBUF
4134         CONO NLPT,200
4135         CONO NLPT,1000          ;IMAGE MODE
4136         DATAO NLPT,[23*2]       ;MOTOR ON
4137
4138         MOVEI A,200000          ;1 SECOND
4139 LPTUP1: SOJLE A,LPTUP2
4140         CONSO NLPT,100          ;IS IT ON?
4141          JRST LPTUP1
4142         SETZM NOLPT             ;WELL, YES
4143         CONO NLPT,200
4144         CONO NLPT,100           ;SET OUTPUT DONE
4145         JRST LPTDWN             ;ITS UP
4146 ];IFN NLPTP
4147
4148 IFN TTLPTP,[    ;BRING UP LPT ATTACHED VIA MTY
4149 LPTUP3: MOVEI A,200000
4150 LPTUP1: SOJLE A,LPTUP2
4151         CONI MTY,B
4152         TRNN B,40               ;ANY INPUT?
4153          JRST LPTUP1
4154         LDB B,[140500,,B]
4155         DATAI MTY,C
4156         CAIE B,TTLPTP&77
4157          JRST LPTUP1            ;NOT FROM LPT
4158
4159         SETZM NOLPT             ;IS FROM LPT -> WIN
4160         MOVEI B,TTLPTP_14       ;LINE NUMBER IN RIGHT PLACE
4161         CONO MTY,10(B)          ;SET OUTPUT DONE
4162         JRST LPTDWN
4163 ];IFN TTLPTP
4164
4165 IFN OLPTP+NLPTP+TTLPTP,[
4166                 ;ROUTINE TO ASK IF UP
4167 LPTUP2: TYPE LPT DOWN (Y OR N)
4168 IFN OLPTP, TYPE  [MAYBE NEEDS RESET BUTTON PUSHED]
4169         PUSHJ P,TYI
4170         X CRR
4171         CAIN A,"Y
4172          JRST LPTUP4
4173         CAIN A,"N
4174          JRST LPTUP3    ;"N", CHECK IT AGAIN
4175         JRST LPTUP2
4176
4177 LPTUP4: SETOM LPBUST
4178 ];IFN OLPTP+NLPTP+TTLPTP
4179 ];NTS
4180
4181 LPTDWN: JRST @INIT
4182
4183 NTS,[
4184 UUOHLT:
4185 KA,     0
4186         JRST 4,.        ;HERE IF UUO IN STAND-ALONE MODE (ELSE HALT IN ITS)
4187 ];NTS
4188 \f
4189 SUBTTL LPT & TTY I/O
4190
4191 LDPT:   PUSH P,A
4192         PUSH P,B
4193         JUMPGE A,LDPT0
4194         MOVEI A,"-
4195         PUSHJ P,LTYO
4196         MOVN A,-1(P)
4197 LDPT0:  PUSHJ P,LDPT1
4198         JRST POPBAJ
4199
4200 LDPT1:  IDIVI A,10.
4201         HRLM B,(P)
4202         SKIPE A
4203          PUSHJ P,LDPT1
4204         JRST LDPT2
4205
4206 LOPT:   PUSH P,A
4207         PUSH P,B
4208         PUSHJ P,LOPT1
4209         JRST POPBAJ
4210
4211 LOPT1:  LSHC A,-35.     ;IN CASE NEGATIVE
4212         LSH B,-1
4213         DIVI A,8
4214         HRLM B,(P)
4215         SKIPE A
4216          PUSHJ P,LOPT1
4217 LDPT2:  HLRZ A,(P)
4218         ADDI A,"0
4219 ;DROPS IN
4220 LTYO:
4221 LPTR:
4222 LPTR1:  SKIPE NOLPT
4223          JRST TYLPT             ;TYPE ON TTY INSTEAD
4224
4225         PUSH P,A
4226         AOSE LPFRST
4227          JRST LPTR2
4228           TYPE (INFO ON LPT)
4229           X CRR
4230 LPTR2:
4231
4232 IFN OLPTP,[
4233 OLP1:   CAIN A,12               ;SUPPRESS LF, MAKE CR=CR-LF
4234          JRST POPAJ
4235         CAIN A,15
4236          JRST [ CONO LPT,10
4237                 MOVEI A,440
4238                 JRST .+1]
4239         CAIN A,14
4240          MOVEI A,441
4241         CAIN A,33
4242          MOVEI A,"$
4243         CAIL A,"a
4244         CAILE A,"z
4245          CAIA
4246           SUBI A,40             ;LOWER CASE -> UPPER CASE
4247         SUBI A,40
4248         PUSH P,B
4249         HRLZI B,2               ;3 SECOND TIMEOUT
4250         CONSZ LPT,10
4251          SOJG B,.-1
4252         JUMPLE B,OLP2
4253 OLP3:   DATAO LPT,A
4254         JRST POPBAJ
4255
4256 OLP2:   X CRR
4257         TYPE HIT RESET BUTTON ON LPT
4258         X CRR
4259         HRLZI B,15              ;20 SECOND TIMEOUT
4260         CONSZ LPT,10
4261          SOJG B,.-1
4262         JUMPLE B,OLP2
4263         JRST OLP3
4264 ];IFN OLPTP
4265
4266 TS,[    .IOT LPTC,A
4267         JRST POPAJ
4268 ];TS
4269 \f
4270 IFN NLPTP,[             ;SEND CHARACTER TO NLPT
4271         PUSH P,B
4272         SOSLE LPTBFC    ;MORE TO GO
4273          JRST LPTR0     ;YES
4274 LPTR01: MOVEI B,5       ;NO, NEW WORD
4275         MOVEM B,LPTBFC
4276         MOVE B,[440700,,LPTBUF]
4277         MOVEM B,LPTBFP
4278         MOVEI B,-1      ;TIMEOUT FOR DEAD LPT
4279         CONSO NLPT,100
4280          SOJG B,.-1
4281         DATAO NLPT,LPTBUF
4282
4283 LPTR0:  IDPB A,LPTBFP   ;BUFFER 5 AT A TIME
4284         CAIL A,12
4285         CAILE A,14      ;LF OR FF, FORCE BUFFER NOW
4286          JRST POPBAJ
4287         MOVEI A,15
4288 LPTR00: SOSG LPTBFC
4289          JRST LPTR01
4290         IDPB A,LPTBFP
4291         JRST LPTR00
4292
4293                 ;NLPT BUFFERING CRUFT
4294 LPTBUF: -1      ;5 CHAR LPT BUFFER
4295 LPTBFC: 5       ;COUNT OF CHARS LEFT IN BUF
4296 LPTBFP: @.      ;BYTE POINTER INTO LPT BUFFER
4297
4298 LPTFIN: SKIPL LPFRST            ;DO NOTHING IF NEVER OUTPUT TO LPT
4299         SKIPGE NOLPT            ;WAS LPT INIT'ED?
4300          POPJ P,                ;NO, DON'T HANG
4301         MOVE A, [<.BYTE 7 ? 15 ? 14 ? 15 ? 15 ? 15>]
4302         MOVEI B, 15
4303 LPTFN0: SOSG LPTBFC
4304          JRST LPTFN1
4305         IDPB B, LPTBFP
4306         JRST LPTFN0
4307
4308 LPTFN1: CONSO NLPT,100          ;WAIT FOR THAT TO HAPPEN
4309          JRST .-1
4310         DATAO NLPT, LPTBUF
4311         CONSO NLPT,100          ;WAIT FOR THAT TO HAPPEN
4312          JRST .-1
4313         DATAO NLPT, A
4314         POPJ P,
4315 ];IFN NLPTP
4316 \f
4317 IFN TTLPTP,[
4318 ;       call with ascii char in A
4319 ;       saves and restores all AC's
4320
4321         ANDI    A,177   ;MASK TO 7 BIT ASCII
4322         CAIGE   A,40    ;SKIP IF NOT CTL CHAR
4323         CAIN    A,14    ;SKIP IF NOT FF
4324          JRST   LPTOP   ;PRINT LITERALLY FF, GRAPHICS
4325         CAIN    A,15    ;SKIP IF NOT CR
4326          JRST   LPCR    ;JUMP TO CR ROUT
4327         CAIN    A,12    ;SKIP IF NOT LF
4328          JRST   LPLF    ;JUMP TO LF ROUT
4329         CAIN    A,11    ;SKIP IF NOT TAB
4330          JRST   LPTAB   ;JUMP TO TAB ROUT
4331         MOVEI   A,"^    ;HERE FOR RANDOM CTL CHAR
4332         PUSHJ   P,LPTO  ;PUT OUT ^FOO
4333         MOVE    A,(P)   ;RETREIVE CHAR
4334         ADDI    A,100   ;MAKE IT A 'LETTER'
4335 LPTOP:  PUSHJ   P,LPTO
4336         JRST    POPAJ
4337
4338 LPCR:   SKIPE   LPTPOS  ;SKIP IF STILL AT LEFT MARGIN
4339         PUSHJ   P,LPTO  ;ELSE PUT OUT CR
4340         SETZM   LPTPOS  ;MARK 'AT LEFT MARGIN'
4341         SETOM   LPCRLF  ;MARK LF AFTER CR
4342         MOVEI   A,12    ;LF
4343         JRST    LPTOP   ;OUTPUT IT
4344
4345 LPLF:   AOSE    LPCRLF  ;SKIP IF THIS LF AFTER CR
4346          JRST   LPTOP   ;ELSE PUT IT OUT
4347         JRST    POPAJ
4348
4349 LPTAB:  MOVEI   A,40    ;SPACES FOR TAB
4350         PUSHJ   P,LPTO
4351         MOVE    A,LPTPOS        ;CHECK POS
4352         TRNE    A,7     ;SKIP IF POS = 0 MOD 8
4353          JRST   LPTAB   ;ELSE PUT ANOTHER SPACE
4354         JRST    POPAJ
4355
4356 LPTO:   CAIL    A,40    ;SKIP FOR CTL CHAR NOT COUNTED
4357          AOS    LPTPOS  ;COUNT CHAR
4358         PUSH    P,A
4359         PUSH    P,B
4360         MOVEI   A,-1    ;TIMER FOR FLAG
4361 LPWAIT: SOJLE   A,LPTOUT
4362         CONI    MTY,B   ;GET STATUS
4363         TRNE    B,40    ;SKIP IF NO INPUT FLAG
4364          JRST   FLSINP  ;ELSE JUMP TO FLUSH INPUT
4365         TRNN    B,10    ;SKIP IF OUTPUT FLAG
4366          JRST   LPWAIT  ;ELSE LOOP
4367         LDB     B,[140500,,B]   ;GET SUBDEV #
4368         CAIE    B,TTLPTP&77     ;SKIP IF THIS IS LPT #
4369          JRST   FLSOUT  ;ELSE FLUSH
4370 LPTOUT: MOVEI   B,TTLPTP_14 ;GET LPT NO IN SUBDEV POSITION
4371         CONO    MTY,(B) ;SELECT SUBDEV
4372         POP     P,B     ;RESTORE AC
4373         MOVE    A,(P)   ;GET CHAR
4374         LSH     A,35    ;PUT IN FUNNY POSITION
4375         DATAO   MTY,A   ;PUT OUT 1 CHAR
4376         JRST    POPAJ
4377
4378 FLSINP: DATAI   MTY,B   ;READ INPUT
4379         JRST    LPWAIT  ;AND IGNORE
4380
4381 FLSOUT: LSH     B,14    ;SHIFT TO SELECT
4382         CONO    MTY,200(B)      ;RESET FLAG, IT'S NOT LPT
4383         JRST    LPWAIT
4384
4385 LPTPOS: 0       ;PRINT POSITION FROM LEFT MARGIN
4386 LPCRLF: 0       ;# CHARS AFTER LAST CR, -1 IF TO IGNORE LF
4387 ];IFN TTLPTP
4388 \f
4389 TYLPT:  CAIN A,14
4390          JRST CRR               ;NO FF ON TTY
4391         JRST TYO
4392
4393 SIXTYP:
4394 T6B:    PUSH P,B                ;OUTPUT SIXBIT IN A
4395         PUSH P,A
4396         LSHC A,-36.
4397 T6B1:   LSHC A,6
4398         ADDI A,40
4399         PUSHJ P,TYO
4400         MOVEI A,0
4401         JUMPN B,T6B1
4402         POP P,A
4403 POPBJ:  POP P,B
4404         POPJ P,
4405
4406 SIXLPT:
4407 L6B:    PUSH P,B                ;OUTPUT SIXBIT IN A
4408         PUSH P,A
4409         MOVE B,[440600,,(P)]    ;ALWAYS OUTPUTS SIX COLUMNS
4410 L6B1:   ILDB A,B                ;CAN YOU GUESS WHY?  WIN A KEWPIE DOLL!
4411         ADDI A,40
4412         PUSHJ P,LPTR
4413         TLNE B,770000
4414          JRST L6B1
4415         POP P,A
4416         POP P,B
4417         POPJ P,
4418
4419 SLPT:   PUSH P,B
4420         MOVE B,A
4421 SL1:    ILDB A,B
4422         JUMPE A,POPBJ
4423         PUSHJ P,LPTR
4424         JRST SL1
4425
4426 DPT:
4427 TOPT:   PUSH P,A
4428         PUSH P,B
4429         MOVEI B,8
4430         MOVEM B,ORADIX
4431         PUSHJ P,TDPT1
4432         JRST POPBAJ
4433
4434 TDPT:   PUSH P,A
4435         PUSH P,B
4436         MOVEI B,10.
4437         MOVEM B,ORADIX'
4438         PUSHJ P,TDPT1
4439         JRST POPBAJ
4440
4441 TDPT1:  LSHC A,-35.             ;IN CASE NEGATIVE
4442         LSH B,-1
4443         DIV A,ORADIX
4444         HRLM B,(P)
4445         SKIPE A
4446          PUSHJ P,TDPT1
4447         HLRZ A,(P)
4448         ADDI A,"0
4449         JRST TYO
4450 \f
4451 LTAB:
4452 IFN OLPTP,[
4453         PUSHJ P,LSPAC   ;OLD LPT LACKS TABS
4454         PUSHJ P,LSPAC
4455         PUSHJ P,LSPAC
4456         JRST LSPAC
4457 ];IFN OLPTP
4458
4459 .ELSE [ PUSH P,A
4460         MOVEI A,11              ;NLPT HAS HARDWARE TABS
4461         JRST L1
4462 ];ELSE
4463
4464 LCRR:   PUSH P,A
4465         MOVEI A,15
4466         PUSHJ P,LPTR
4467         MOVEI A,12
4468         PUSHJ P,LPTR
4469         JRST POPAJ
4470
4471 LSPAC:  PUSH P,A
4472         MOVEI A,40
4473 L1:     PUSHJ P,LPTR
4474         POP P,A
4475         POPJ P,
4476
4477 LFORM:  PUSH P,A
4478         MOVEI A,14
4479         PUSHJ P,LPTR
4480         JRST POPAJ
4481
4482 LOUTST: 0
4483         PUSH P,A
4484         PUSH P,B
4485         HRRZ B,@LOUTST
4486         HRLI B,440700
4487 LOUT2:  ILDB A,B
4488         JUMPE A,LOUT1
4489         X LPTR
4490         JRST LOUT2
4491
4492 LOUT1:  POP P,B
4493         POP P,A
4494         AOS LOUTST
4495         JRST 2,@LOUTST
4496
4497 TOUTST: 0
4498         PUSH P,A
4499         PUSH P,B
4500         HRRZ B,@TOUTST
4501         PUSHJ P,OUTSTR
4502         AOS TOUTST
4503         POP P,B
4504         POP P,A
4505         JRST 2,@TOUTST
4506
4507 OUTSTR: HRLI B,440700
4508 OUTST1: ILDB A,B
4509         JUMPE A,CPOPJ
4510         PUSHJ P,TYO
4511         JRST OUTST1
4512
4513 ERRDDT: PUSHJ P,CRR
4514         TYPE *** ERROR *** SYSTEM MAY NOT BE BROUGHT BACK UP
4515 CRDDTE: NTS, SETZM SALVRT               ;CAN'T RETURN TO SYSTEM
4516 CRDDT:  PUSHJ P,CRR
4517
4518 DDT:
4519 NTS,[
4520 IFN NLPTP, PUSHJ P,LPTFIN               ;UNBUFFER LINE PRINTER
4521         SKIPE SALVRT
4522          JRST @SALVRT
4523         TYPE DDT
4524         SKIPN MEMSIZ-4000
4525          JRST 4,.                       ;NO DDT LOADED?
4526         JRST MEMSIZ-4000
4527 ];NTS
4528 TS,[    .VALUE [ASCIZ\\17:\e\16DDT\17\e\16
4529 \]
4530         JRST DDT
4531 ];TS
4532 \f
4533 CRR:    PUSH P,A
4534         PUSHJ P,CRR1
4535         SETZM LINPOS'
4536         JRST POPAJ
4537
4538 CRR1:   MOVEI A,15
4539         PUSHJ P,TYO
4540         MOVEI A,12
4541         JRST TYO
4542
4543 TSPAC:  PUSH P,A
4544         MOVEI A,40
4545         X TYO
4546         JRST POPAJ
4547
4548 TYO:
4549 TS,     .IOT TYOC,A
4550 NTS,[
4551 KA,[
4552         CONSZ TTY,20
4553          JRST .-1
4554         DATAO TTY,A
4555         SKIPN PUNCH
4556          JRST TYO0
4557         CONSZ PTP,20            ;WAIT FOR NOT BUSY
4558          JRST .-1
4559         DATAO PTP,A
4560 TYO0:
4561 ];KA
4562 KL,[
4563         PUSH P,A
4564         ANDI A,177
4565         PUSHJ P,DTEXIO
4566         POP P,A
4567 ];KL
4568 ];NTS
4569         AOS LINPOS
4570         POPJ P,
4571
4572 KL,[    ;DTE20 COMMUNICATION ROUTINE ... COPIED FROM DEC "SUBRTN" PROGRAM
4573
4574 DTEXIO: SETZM DTEFLG
4575         MOVEM A,DTECMD
4576         SETZM DTEF11
4577         CONO DTE,%DBL11
4578         SKIPN DTEFLG
4579          JRST .-1
4580         SETZM DTEFLG
4581         MOVE A,DTEF11
4582         POPJ P,
4583 ];KL
4584 \f
4585 NTYI:   PUSHJ P,TYI             ;INPUT DIGIT, SKIP IF WIN
4586         CAIL A,"0
4587         CAILE A,"9
4588          POPJ P,
4589         SUBI A,"0
4590 POPJ1:  AOS (P)
4591         POPJ P,
4592
4593 SIXIN:  PUSH P,C
4594 SIXI1:  MOVE C,[440600,,B]
4595         SETZ B,
4596 SIXIL:  X TYI
4597         CAIL A,140
4598          JRST [ TYPE XXX
4599                 JRST SIXI1]
4600         CAIG A,40
4601          JRST SIXIX
4602         CAIN A,";
4603          JRST SIXIL
4604         SUBI A,40
4605         TLNE C,770000
4606          IDPB A,C
4607         JRST SIXIL
4608
4609 SIXIX:  POP P,C
4610         POPJ P,
4611
4612 TYI:                            ;INPUT CHAR INTO A
4613 TS,     .IOT TYIC,A
4614 NTS,[
4615 KA,[
4616         CONSO TTY,40
4617          JRST .-1
4618         DATAI TTY,A
4619 ];KA
4620 KL,[
4621         MOVEI A,3400            ;"DDT MODE" INPUT
4622         PUSHJ P,DTEXIO
4623         JUMPE A,.-2
4624 ];KL
4625 ];NTS
4626         ANDI A,177
4627         CAIL A,"a               ;MIGHT NOT BE KSR-35
4628         CAILE A,"z
4629          CAIA
4630           SUBI A,40
4631         CAIN A,^Z
4632          JRST CRDDTE
4633         JRST TYO
4634
4635 ;RETURN TO DDT IF CHARACTER TYPED
4636 TYIPSE: PUSHJ P,TYIP
4637          POPJ P,
4638         PUSHJ P,TYI
4639         JRST DDT
4640
4641 ;SKIP IF INPUT AVAILABLE
4642 TYIP:   PUSH P,A
4643 TS,[    .LISTEN A,
4644         SKIPE A
4645 ];TS
4646 NTS,[
4647 KA,     CONSZ TTY,40
4648 KL,[    MOVEI A,3400
4649         PUSHJ P,DTEXIO
4650         SKIPE A
4651 ];KL
4652 ];NTS
4653          AOS -1(P)
4654         POP P,A
4655         POPJ P,
4656
4657 Y.OR.N: PUSH P,A                ;YES OR NO, SKIP IF YES
4658 YORN1:  X TYI
4659         X CRR
4660         CAIE A,"Y
4661         CAIN A,"N
4662          JRST YORN2
4663         TYPE (Y OR N)
4664         JRST YORN1              ;TELETYPE KEYBOARD LOSSAGE?
4665
4666 YORN2:  CAIN A,"Y
4667          AOS -1(P)
4668         JRST POPAJ
4669 \f
4670 SUBTTL MAG TAPE I/O
4671
4672 NTS,[   MTC==340                ;MAG TAPE CHANNEL FOR FUNCTIONS
4673         MTS==344                ;MAG TAPE CHANNEL FOR STOPPING AND STATUS
4674
4675 ;SHIFTS FOR FIELDS IN CONO MTC,
4676         UNITNO==15.
4677         PARITY==14.
4678         CDUMP==13.
4679         FUNC==9.
4680         DENSTY==6.
4681
4682         800BPI==2
4683
4684         MAGCOM=5_<UNITNO>+1_<PARITY>+800BPI_<DENSTY>+1_<CDUMP>
4685
4686 ;FUNCTIONS
4687         NOOP1=0_<FUNC>+MAGCOM   ;CLEAR INTERRUPT FLAGS
4688         NOOP2=10_<FUNC>+MAGCOM  ;INTERRUPT WHEN TRANSPORT IDLE
4689         REWIND=1_<FUNC>+MAGCOM  ;REWIND
4690         REED=2_<FUNC>+MAGCOM    ;READ
4691         SPACR=7_<FUNC>+MAGCOM   ;SPACE REVERSE
4692
4693 ;FLAGS
4694         JOBDON==100
4695         DATREQ==1
4696         EOFF==10000
4697         EOTF==4000
4698 ;NOTE - TM10B HAS DATA PIA (CONI MTC, 1.1-1.3) STUCK AT 7
4699 \f
4700 REW:    CLEARM EOFCNT
4701         CLEARM MAGBFP
4702         CLEARM SHORTL
4703         CONO MTC,NOOP1  ;CLEAR INTERRRUPT FLAGS
4704         CONO MTC,REWIND ;INITIATE REWIND
4705         CONSO MTS,JOBDON        ;WAIT FOR REWIND TO BEGIN
4706          JRST .-1
4707         CONO MTC,NOOP2  ;SET JOB DONE WHEN TRANSPORT IDLE
4708         CONSO MTS,JOBDON        ;WAIT FOR JOB DONE
4709          JRST .-1
4710         SETOM ITAPE
4711         POPJ P,         ;REWIND DONE
4712 ITAPE:  0
4713
4714 MREAD:  MOVEI T,0
4715         PUSH P,B
4716 MREAD7: SKIPGE B,MAGBFP
4717          JRST MREAD5
4718         SKIPN EOFLG
4719          JRST MREAD1
4720         SETZM EOFLG
4721         SETOM EOUF
4722         JRST POPBJ
4723
4724 MREAD1: MOVEI B,10.
4725         MOVEM B,MTRYS
4726 MERR2:  MOVE B,[-2000,,MAGBUF]
4727         MOVEM B,MAGBFP
4728         SETZM SLVIOWD
4729         CONO MTC,NOOP1          ;CLEAR FLAGS
4730         CONSO MTC,7             ;IS THIS A TM10B?
4731          JRST MREADA            ;NO
4732 KA,     MOVE B,[-2000,,MAGBUF-1]        ;YES SET UP CHANNEL PROGRAM
4733 KL,     MOVE B,[-2000_4,,MAGBUF-1]
4734         MOVEM B,SLVIOWD
4735         SETZM SLVICWA+1
4736         SETZM SLVIOWD+1
4737         DATAO MTS,[SLVICWA]
4738 KL,[    SWPUA                   ;UNLOAD THE CACHE
4739         PUSH P,A
4740         MOVE A,[CONSZ APR,200000]
4741         MOVE B,[JRST A]
4742         MOVE C,[POPJ P,]
4743         PUSHJ P,A
4744         POP P,A
4745 ]
4746 MREADA: CONO MTC,REED
4747 MREAD2: CONSO MTS,DATREQ+EOFF+JOBDON+EOTF       ;WAIT FOR NEXT DATA REQUEST
4748          JRST .-1
4749         MOVEI C,20.
4750         SOJG C,.
4751         CONI MTS,C
4752         TRNE C,EOTF
4753          JRST MREOT
4754         TRNN C,JOBDON
4755          JRST MREAD3
4756         TRNN C,EOFF
4757          JRST MREAD6
4758         AOS EOFCNT
4759         SETOM EOFLG
4760         CLEARM SHORTL
4761         JRST MREAD9
4762
4763 MREAD6: SETOM SHORTL
4764 MREAD9: CONSZ MTC,7             ;SKIP IF TM10A
4765          JRST MREADB
4766         HLLZS B
4767         MOVNS B
4768         ADDM B,MAGBFP
4769         JRST MREAD4
4770
4771 MREADB: HRRZ B,SLVICWA+1
4772         JUMPE B,.-1
4773         MOVNI B,1-MAGBUF(B)
4774         SKIPE EOFLG
4775          MOVSI B,0              ;EOF MARK => NO WORDS READ
4776         HRLM B,MAGBFP
4777         JRST MREAD4
4778
4779 MREAD3: TRNE C,DATREQ
4780          CONSZ MTC,7            ;SKIP IF TM10A
4781           JRST MREAD2           ;TM10B OR NO DATA REQUEST
4782         DATAI MTC,(B)
4783         SKIPE SHORTL
4784          JRST 4,.
4785         AOBJN B,MREAD2
4786 MREAD4: CONO MTS,1
4787         CONSO MTS,JOBDON
4788          JRST .-1
4789         CONSZ MTS,440000        ;X HUNG + ILL OP
4790          JRST 4,MERR
4791 MREAD8: CONSO MTS,20600
4792          JRST MREAD7
4793 MERR:   SOSG MTRYS
4794          JRST MERR1
4795         SETZM SLVIOWD
4796 KL,[    SWPUO 0
4797         CONSZ APR,200000
4798          JRST .-1
4799 ]
4800         CONO MTC,NOOP1
4801         CONO MTC,SPACR
4802         CONSZ MTC,7             ;SKIP IF TM10A
4803          JRST .+4
4804           CONSO MTS,DATREQ
4805            JRST .-1
4806           DATAO MTC,
4807         CONO MTS,1
4808         CONSO MTS,JOBDON
4809          JRST .-1
4810         JRST MERR2
4811
4812 MERR1:  AOS FERRS       ;IGNORE ERR
4813         JRST MREAD7
4814
4815 MREAD5: HLRE C,B
4816         CAMG B,A
4817          HLRE C,A
4818         HRLZS B
4819         HRR B,A
4820         MOVNS C
4821         HRLS C
4822         ADDI C,-1(A)
4823         BLT B,(C)
4824         HLRS C
4825         ADD A,C
4826         ADDM C,MAGBFP
4827         ADDI T,(C)
4828         JUMPGE A,POPBJ
4829         JRST MREAD7
4830
4831 MREOT:  CONO MTS,1              ;STOP TAPE IF STILL MOVING
4832         CONO MTC,NOOP1
4833         LPR EOT
4834         X LCRR
4835         JRST DDT
4836 ];NTS
4837 \f
4838 SUBTTL TYPE CONTROLLER AND DRIVE STATUS
4839 TS,[
4840 GSTS:   POPJ P,
4841 ];TS
4842
4843 DC,[
4844 GETSTS: MOVEI P,PDL
4845         PUSH P,[DDT]
4846 GSTS:   INSIRP PUSH P,[A B C D T]
4847         CONI DC0,D
4848         MOVEI C,DC0STS
4849         TYPE CONTROLLER STATUS:
4850         PUSHJ P,TYPSTS
4851         CONI DC1,D
4852         MOVEI C,DC1STS
4853         PUSHJ P,TYPSTS
4854         CONO DC0,DCCSET+DCDENB
4855         DATAO DC0,[DJMP GETUNT]
4856         CONSZ DC0,DSSACT
4857         JRST .-1
4858         TYPE CURRENT UNIT=
4859         LDB A,[DUNFLD GOTUNT]
4860         DPB A,[DUNFLD STOSTS]
4861         PUSHJ P,TDPT
4862         TYPE ,DRIVE STATUS:
4863         PUSHJ P,CRR
4864         DATAO DC0,[DJMP STOSTS]
4865         CONSZ DC0,DSSACT
4866         JRST .-1
4867         MOVE D,STATUS
4868         LSH D,-15.
4869         MOVEI C,DRVSTS
4870         PUSHJ P,TYPSTS
4871         TYPE CYLINDER=
4872         LDB A,[101100,,STATUS]
4873         PUSHJ P,TOPT
4874         PUSHJ P,CRR
4875         INSIRP POP P,[T D C B A]
4876         POPJ P,
4877
4878 TYPSTS: SETOM FIRST'
4879 TYPST1: SKIPN B,(C)
4880         JRST CRR
4881         HLRZ T,B                ;FLAGS TO TEST
4882         TDNN D,T
4883         AOJA C,TYPST1
4884         MOVEI A,",
4885         AOSE FIRST
4886         PUSHJ P,TYO
4887         MOVE A,LINPOS
4888         CAILE A,TCMXH
4889         PUSHJ P,CRR
4890         PUSHJ P,OUTSTR
4891         AOJA C,TYPST1
4892 \f;DC
4893 DEFINE STS A,B/
4894 A,,[ASCIZ \B\]
4895 TERMIN
4896
4897 DC0STS: STS 4000,ERROR-FLG
4898         STS 1000,ATTENTION
4899         STS 200,RUN
4900         STS 100,ACTIVE
4901         0
4902
4903 DC1STS: STS 4000,INTERNAL-PARITY-ERROR
4904         STS 2000,RECORD-LENGTH
4905         STS 1000,READ-COMPARE
4906         STS 400,OVERRUN
4907         STS 200,CHECKSUM/DECODER
4908         STS 100,BARK!!
4909         STS 40,FILE-UNSAFE/SEEK-INCOMPLETE/END-OF-DISC
4910         STS 20,OFF-LINE/MULTIPLE-SELECT
4911         STS 10,RDG-KEY/PROTECT/READONLY
4912         STS 4,DATAO-WHILE-BUSY
4913         STS 2,NON-EX-MEM
4914         STS 1,CORE-PARITY-ERROR
4915         0
4916
4917 DRVSTS: STS 4,UNIT-SELECTED
4918         STS 10,ON-LINE
4919         STS 20,READY
4920         STS 40,SEEK-INCOMPLETE
4921         STS 100,READ-ONLY
4922         STS 200,UNSAFE
4923         STS 400,WRITE-CURRENT-SENSED(?)
4924         0
4925
4926 GETUNT: DJSR .+1
4927 GOTUNT: 0
4928         DHLT
4929
4930 STOSTS: DSDRST+DUNENB STATUS(74)
4931         DHLT
4932 STATUS: 0
4933 ];DC
4934 \f
4935 RP,[
4936 GETSTS: MOVEI P,PDL
4937         PUSH P,[DDT]
4938 GSTS:   INSIRP PUSH P,[A B C D T]
4939         TYPE DISK STATUS:
4940         CONI DPC,D
4941         MOVEI C,CNLSTS
4942         TLNE D,-1
4943          PUSHJ P,TYPSTS
4944         MOVSS D
4945         MOVEI C,CNISTS
4946         PUSHJ P,TYPSTS
4947         DATAI DPC,D
4948         TLC D,1                 ;REVERSE SENSE OF WRITE HEADER LOCKOUT SWITCH
4949         MOVEI C,DTISTS
4950         PUSHJ P,TYPSTS
4951         TYPE CURRENT UNIT=
4952         LDB A,[DUNFLI D]
4953         PUSHJ P,TDPT
4954         TYPE , CYLINDER=
4955         LDB A,[DCYLI D]
4956         TRNE D,.BM DCYLXI
4957          ADDI A,400
4958         PUSHJ P,TOPT
4959         TYPE , LAST ADDRESSED CYL=
4960         MOVE A,RPIOCY
4961         X TOPT
4962         TYPE , SURF=
4963         MOVE A,RPIOHD
4964         X TOPT
4965         TYPE , SEC=
4966         MOVE A,RPIOSC
4967         X TOPT
4968         PUSHJ P,CRR
4969         INSIRP POP P,[T D C B A]
4970         POPJ P,
4971
4972 TYPSTS: SETOM FIRST'
4973 TYPST1: SKIPN B,(C)
4974          JRST CRR
4975         HLLZ T,B                ;FLAGS TO TEST
4976         TDNN D,T
4977          AOJA C,TYPST1
4978         MOVEI A,",
4979         AOSE FIRST
4980          PUSHJ P,TYO
4981         MOVE A,LINPOS
4982         CAILE A,TCMXH
4983          PUSHJ P,CRR
4984         PUSHJ P,OUTSTR
4985         AOJA C,TYPST1
4986
4987 \f;RP
4988 DEFINE STS A,B/
4989 A,,[ASCIZ \B\]
4990 TERMIN
4991
4992 ; CONI STATUS TABLE (RH)
4993
4994 CNISTS: STS 400000,SEARCH DONE
4995         STS 200000,END OF CYLINDER
4996         STS 100000,POWER FAILURE
4997         STS 040000,SEARCH ERROR
4998         STS 020000,OVERRUN
4999         STS 010000,NXM
5000         STS 002000,DRIVE NOT READY
5001         STS 001000,WRITE PROTECT
5002         STS 000400,DATAO WHEN BUSY
5003         STS 000200,SECTOR ADDRESS ERROR
5004         STS 000100,SURFACE ADDRESS ERROR
5005         STS 000020,BUSY
5006         STS 000010,DONE
5007         0
5008
5009 ; CONI STATUS TABLE (LH)
5010
5011 CNLSTS: STS 000010,CONTROL WORD PARITY ERROR
5012         STS 000004,SECTOR PARITY ERROR
5013         STS 000002,MEMORY WORD PARITY ERROR
5014         STS 000001,DISK WORD PARITY ERROR
5015         0
5016
5017 ; DATAI STATUS TABLE (LH)
5018
5019 DTISTS: STS 000100,SEEK INCOMPLETE
5020         STS 000040,ON CYLINDER
5021         STS 000020,DISK ON-LINE
5022         STS 000010,FILE UNSAFE
5023         STS 000004,NON EXISTENT DRIVE
5024         STS 000002,DRIVE IS READ-ONLY
5025         STS 000001,WRITE HEADER LOCKOUT OFF!!
5026         0
5027 ];RP
5028 \f
5029 RH,[
5030 GETSTS: MOVEI P,PDL
5031         PUSH P,[DDT]
5032 GSTS:
5033 IFN T300P,[
5034         SKIPE T3IOP
5035          JRST T3STS             ;LAST OPERATION WAS REALLY TO T-300
5036 ];T300P
5037         INSIRP PUSH P,[A B C D T I K]
5038         TYPE CONTROLLER STATUS:
5039         CONI DSK,D
5040         MOVEI C,CNLSTS
5041         TLNE D,-1
5042          PUSHJ P,TYPSTS
5043         MOVSS D
5044         MOVEI C,CNISTS
5045         PUSHJ P,TYPSTS
5046         TYPE CURRENT REGISTER:
5047         DATAI DSK,D
5048         PUSHJ P,TYPRGN
5049         MOVE A,D
5050         PUSHJ P,TOPT            ;TYPE REG NO, STATUS, AND CONTENTS IN OCTAL
5051         JUMPL D,GSTS0           ;DO FOLLOWING ONLY FOR DRIVE REGS
5052          MOVEI A,",
5053          PUSHJ P,TYO
5054          MOVEI C,DIBSTS
5055          PUSHJ P,TYPSTS
5056          CAIA                   ;DON'T GIVE BLANK LINE
5057 GSTS0:  PUSHJ P,CRR
5058         TYPE CURRENT DRIVE=
5059         LDB A,[$HCDRV D]
5060         PUSHJ P,TDPT
5061         PUSHJ P,CRR
5062         MOVEI I,NUNITS-1        ;CONVERT BACK TO VIRTUAL UNIT
5063         CAME A,QTRAN(I)         ;TO MAKE RHGET HAPPY
5064          SOJGE I,.-1
5065         JUMPL I,GSTS3           ;FOO!! ADDRESSING NON EXISTENT DRIVE
5066
5067         MOVSI K,-LGSTSR         ;DISPLAY DRIVE REGS SPEC'ED IN TABLE
5068 GSTS1:  MOVE D,GSTSRT(K)
5069         PUSHJ P,TYPRGN          ;TYPE REG NAME
5070         HRRZ C,D                ;C -> STATUS BIT TABLE
5071         HLLZ A,D                ;A := REG NUMBER
5072         PUSHJ P,RHGET           ;GET CONTENTS OF REG
5073          JRST GSTSER            ;??
5074         PUSHJ P,TOPT            ;GIVE CONTENTS IN OCTAL
5075         PUSHJ P,TSPAC
5076         MOVS D,A                ;AND SYMBOLICLY
5077         PUSHJ P,TYPSTS
5078         AOBJN K,GSTS1
5079 GSTS3:  INSIRP POP P,[K I T D C B A]
5080         POPJ P,
5081
5082 GSTSER: TYPE BARF:
5083         MOVE D,A
5084         MOVEI C,DIBSTS
5085         PUSHJ P,TYPSTS
5086         JRST GSTS3              ;DON'T TRY ANY MORE REGS
5087
5088 TYPSTS: SETOM FIRST'
5089 TYPST1: SKIPN B,(C)
5090          JRST CRR
5091         HLLZ T,B                ;FLAGS TO TEST
5092         TDNN D,T
5093          AOJA C,TYPST1
5094         MOVEI A,",
5095         AOSE FIRST
5096          PUSHJ P,TYO
5097         MOVE A,LINPOS
5098         CAILE A,TCMXH
5099          PUSHJ P,CRR
5100         PUSHJ P,OUTSTR
5101         AOJA C,TYPST1
5102
5103 TYPRGN: LDB A,[360600,,D]       ;TYPE NAME OF REGISTER ADDRESSED BY D
5104         ROT A,-1
5105         MOVE B,RHRGTB(A)
5106         JUMPL A,.+2
5107          MOVSS B
5108         PUSHJ P,OUTSTR
5109         MOVEI A,"=
5110         JRST TYO
5111
5112 ;TABLE OF DRIVE REGISTERS THAT NEED TO BE DISPLAYED
5113 ; LH = REG ADDR, RH = STATUS BITS TABLE ADDR
5114
5115 GSTSRT: %HRDCL,,[0]
5116         %HRSTS,,STSSTS
5117         %HRCYL,,[0]
5118         %HRCCY,,[0]
5119         %HRADR,,[0]
5120         %HROFS,,OFSSTS
5121         %HRER1,,ER1STS
5122         %HRER2,,ER2STS
5123         %HRER3,,ER3STS
5124 LGSTSR==.-GSTSRT
5125 \f;RH
5126 DEFINE STS A,B/
5127 A,,[ASCIZ \B\] ? TERMIN
5128
5129 ; CONI STATUS (LH)
5130
5131 CNLSTS: STS 400000,AR FULL
5132         STS 200000,CB FULL
5133         STS 040000,CC INH
5134         STS 020000,CHANNEL ACTIVE
5135         STS 010000,CHANNEL PULSE
5136         STS 004000,22-BIT CHANNEL
5137         STS 000400,CXR ILL FUNC
5138         STS 000200,CXR DRIVE ACCESS ERR
5139         STS 000004,MEMORY PARITY
5140         STS 000002,CONTROL WORD PARITY
5141         STS 000001,NXM
5142         0
5143
5144 ; CONI STATUS (RH)
5145
5146 CNISTS: STS 400000,DATA BUS PARITY
5147         STS 200000,DRIVE EXCEPTION
5148         STS 100000,CHANNEL ERROR
5149         STS 020000,CHANNEL OVERRUN
5150         STS 010000,DRIVE RESPONSE ERR
5151         STS 004000,CXR ILL CMD
5152         STS 002000,CXR POWER FAIL
5153         STS 000200,CONTROL BUS OVERRUN
5154         STS 000100,RAE INTR
5155         STS 000040,ATTN INTR
5156         STS 000020,BUSY
5157         STS 000010,DONE
5158         0
5159
5160 ; REGISTERS
5161
5162 ZZ==-1
5163 XX==0
5164 YY==0
5165 DEFINE REG N,T/
5166 IFLE N-ZZ, .ERR REG OUT OF ORDER
5167 REPEAT N-ZZ-1, REGH [ASCIZ\????\]
5168         REGH [ASCIZ\T\]
5169 TERMIN
5170
5171 DEFINE REGH [A]
5172 ZZ==ZZ+1
5173 IFE XX, YY==A
5174 IFN XX, YY,,A
5175 XX==1-XX
5176 TERMIN
5177
5178 RHRGTB: REG 0,DRV CTL
5179         REG 1,DRV STATUS
5180         REG 2,DRV ER1
5181         REG 3,DRV MAINT
5182         REG 4,ATTENTION
5183         REG 5,DRV TRACK-SECTOR
5184         REG 6,DRV TYPE
5185         REG 7,DRV LOOK-AHEAD
5186         REG 10,DRV SERIAL NO
5187         REG 11,DRV OFFSET
5188         REG 12,DRV DESIRED CYL
5189         REG 13,DRV CURRENT CYL
5190         REG 14,DRV ER2
5191         REG 15,DRV ER3
5192         REG 16,DRV ECC POS
5193         REG 17,DRV ECC PAT
5194         REG 40,CONTROL
5195         REG 44,INTR ADDR
5196         REG 50,DATA BUFFER
5197         REG 54,RAE STATUS
5198         REG 74,CHANNEL BUFFER
5199         REG 100,FOO
5200 LOC RHRGTB+40
5201 EXPUNGE REG,REGH,XX,YY,ZZ
5202
5203 ; BITS IN DIB REGISTER
5204
5205 DIBSTS: STS 004000,CTL-TO-DRIVE
5206         STS 002000,CTL BUS TIMEOUT
5207         STS 001000,CTL BUS PARITY
5208         STS 000400,DIB DATA LATE
5209         STS 000200,DIB ILL CMD
5210         0
5211
5212 ; DRIVE STATUS REGISTER
5213
5214 STSSTS: STS 1,FWD 5 IPS
5215         STS 2,FWD 20 IPS
5216         STS 4,INNER GUARD BAND
5217         STS 10,GO REVERSE
5218         STS 20,DIFF < 64
5219         STS 40,DIFF = 1
5220         STS 100,VOLUME VALID
5221         STS 200,DRIVE READY
5222         STS 400,CONN THIS CTRLR
5223         STS 2000,LAST SECTOR XFERD
5224         STS 4000,WRITE LOCK
5225         STS 10000,MEDIUM ONLINE
5226         STS 20000,POSITIONING IN PROGRESS
5227         STS 40000,ERR
5228         STS 100000,ATTENTION
5229         0
5230
5231 ; DRIVE ERROR REGISTER 1
5232
5233 ER1STS: STS 1,ILL FUNC
5234         STS 2,ILL REG
5235         STS 4,REG MOD REFUSE
5236         STS 10,BUS PARITY ERR
5237         STS 20,PACK FORMAT ERR
5238         STS 40,WRITE CLOCK FAIL
5239         STS 100,ECC HARD ERR
5240         STS 200,HEADER WRONG
5241         STS 400,HEADER CRC ERR
5242         STS 1000,ADDR OVERFLOW
5243         STS 2000,INVALID ADDR
5244         STS 4000,WRITE LOCK ERR
5245         STS 10000,DRV TIMING ERR
5246         STS 20000,OP NOT COMPLETE
5247         STS 40000,UNSAFE
5248         STS 100000,DATA CHECK
5249         0
5250
5251 ; DRIVE ERROR REGISTER 2
5252
5253 ER2STS: STS 1,WRITE CURRENT UNSAFE
5254         STS 2,CURRENT SINK FAILURE
5255         STS 4,WRITE SELECT UNSAFE
5256         STS 10,CURRENT SWITCH UNSAFE
5257         STS 20,MOTOR SEQUENCE ERR
5258         STS 40,TRANSITIONS DET FAIL
5259         STS 100,TRANSITIONS UNSAFE
5260         STS 200,"UNSAFE EXCEPT R/W"
5261         STS 400,WRITE READY UNSAFE
5262         STS 1000,MULTIPLE HEAD SELECT
5263         STS 2000,NO HEAD SELECT
5264         STS 4000,INDEX ERROR
5265         STS 10000,30 VOLT UNSAFE
5266         STS 20000,PHASE LK OSC UNSAFE
5267         STS 100000,AC UNSAFE
5268         0
5269
5270 ; DRIVE ERROR REGISTER 3
5271
5272 ER3STS: STS 1,PACK SPEED UNSAFE
5273         STS 2,VELOCITY UNSAFE
5274         STS 10,UNSAFE EXCEPT R/W
5275         STS 40,AC LOW
5276         STS 100,DC LOW
5277         STS 40000,SEEK INCOMPLETE
5278         STS 100000,OFF CYLINDER
5279         0
5280
5281 ; DRIVE OFFSET REGISTER
5282
5283 OFSSTS: STS 2000,HDR COMPARE INH
5284         STS 4000,ECC INHIBIT
5285         STS 10000,PDP-11 FORMAT
5286         0
5287 ];RH
5288 \f
5289 IFN T300P,[
5290 ;PRINT STATUS OF T300 (ERROR FROM LAST COMMAND)
5291 ;LATER THIS WILL BE INTEGRATED INTO GSTS
5292 T300ST: MOVEI P,PDL
5293         PUSH P,[DDT]
5294 T3STS:  INSIRP PUSH P,[A B C D T I K]
5295         TYPE T-300 AND 2561 STATUS:
5296         SKIPN D,DSCFLT
5297          JRST T3STS2
5298         TRNN D,%DFRST+%DFCQE+%DFNXM+%DFPAR
5299          JRST T3STS1
5300         MOVEI C,[       STS %DFRST,CONTROLLER POWER-CYCLED AND RESET
5301                         STS %DFCQE,COMMAND-QUEUE ERROR
5302                         STS %DFNXM,RQB NXM
5303                         STS %DFPAR,RQB PARITY ERROR
5304                         0 ]
5305         MOVSS D                 ;TYPSTS WANTS BITS IN LEFT HALF
5306         PUSHJ P,TYPSTS
5307         TYPE , PDP-11 ERROR ADDRESS=
5308         LDB A,[000200,,DSCFLT]
5309         LSH A,16.
5310         IOR A,DSCSTS
5311         PUSHJ P,TOPT
5312 T3STS9: PUSHJ P,CRR
5313         JRST GSTS3
5314
5315 ;FAULT CODE
5316 T3STS1: CAILE D,17
5317          JRST [ TYPE ILLEGAL FAULT CODE=
5318                 MOVE A,D
5319                 PUSHJ P,TOPT
5320                 JRST T3STS9 ]
5321         MOVE B,(D)[     [ASCIZ/FAULT CODE 0?/]
5322                         [ASCIZ/DRIVE NOT READY/]
5323                         [ASCIZ/ILLEGAL HEAD OR SECTOR/]
5324                         [ASCIZ/SEEK TIMEOUT/]
5325                         [ASCIZ/DISK STATUS BAD AFTER ON-CYLINDER (FAULT CODE 4)/]
5326                         [ASCIZ/TIME OUT WRITING SECTOR ID (FAULT CODE 5)/]
5327                         [ASCIZ/FIFO ERROR IN FORMAT WRITE (FAULT CODE 6)/]
5328                         [ASCIZ/WRITE TIMEOUT (FAULT CODE 7)/]
5329                         [ASCIZ/SEEK TIMEOUT (FAULT CODE 10)/]
5330                         [ASCIZ/HEADS NOT LOADED/]
5331                         [ASCIZ/READ TIMEOUT (FAULT CODE 12)/]
5332                         [ASCIZ/INDEX TIMEOUT (FAULT CODE 13)/]
5333                         [ASCIZ/SECTOR TIMEOUT (FAULT CODE 14)/]
5334                         [ASCIZ/FAULT CODE 15?/]
5335                         [ASCIZ/DMA TIMEOUT (FAULT CODE 16)/]
5336                         [ASCIZ/DMA TIMEOUT IN ECC (FAULT CODE 17)/] ]
5337         PUSHJ P,OUTSTR
5338         PUSHJ P,CRR
5339 ;COMMAND OK, CHECK ORDINARY ERROR STATUS
5340 T3STS2: MOVE D,DSCSTS
5341         MOVEI C,[       STS %DSRTR,COMMAND WAS RETRIED
5342                         STS %DSECH,UNCORRECTABLE DATA ERROR
5343                         STS %DSECC,CORRECTED DATA ERROR
5344                         STS %DSIDE,ID ERROR
5345                         STS %DSHCE,HEADER COMPARE ERROR
5346                         STS %DSPRT,WRITE-PROTECTED SECTOR
5347                         STS %DSALT,ALTERNATE-SECTOR FLAG
5348                         STS %DSOVR,OVERRUN
5349                         STS %DSSKE,SEEK ERROR
5350                         STS %DSOFL,DRIVE OFF-LINE OR FAULT
5351                         STS %DSFLT,DRIVE FAULT
5352                         STS %DSNXM,PDP11 MEMORY NXM
5353                         STS %DSPAR,PDP11 MEMORY PARITY ERROR
5354                         STS %DSSFL,SYSTEM FAULT
5355                         STS %DSWLK,DRIVE WRITE-LOCKED
5356                         0 ]
5357         MOVSS D                 ;TYPSTS WANTS D IN LEFT HALF
5358         PUSHJ P,TYPSTS
5359         PUSHJ P,CRR             ;NOW SHOW DISK COMMAND AND ADDRESS
5360         TYPE DISK COMMAND:
5361         MOVE A,DSCCMD
5362         PUSHJ P,TOPT
5363         PUSHJ P,TSPAC
5364         MOVEI B,[ASCIZ/(UNKNOWN?)/]
5365         CAIN A,%DMSNS
5366          MOVEI B,[ASCIZ/(SENSE)/]
5367         CAIN A,%DMTST
5368          MOVEI B,[ASCIZ/(DIAGNOSTICS)/]
5369         CAIN A,%DMREC
5370          MOVEI B,[ASCIZ/(RECALIBRATE)/]
5371         CAIN A,%DMSEK
5372          MOVEI B,[ASCIZ/(SEEK)/]
5373         CAIN A,%DMWRT
5374          MOVEI B,[ASCIZ/(WRITE)/]
5375         TRNE A,%DMRED
5376          JRST [ CAIG A,%DMRED+10
5377                  MOVE B,(A)[    [ASCIZ/(READ)/]
5378                                 [ASCIZ/(READ EARLY-DATA-STROBE)/]
5379                                 [ASCIZ/(READ LATE-DATA-STROBE)/]
5380                                 [ASCIZ/(READ POSITIVE-CYLINDER-OFFSET)/]
5381                                 [ASCIZ/(READ NEGATIVE-CYLINDER-OFFSET)/]
5382                                 [ASCIZ/(READ EARLY-DATA-STROBE POSITIVE-CYLINDER-OFFSET)/]
5383                                 [ASCIZ/(READ EARLY-DATA-STROBE NEGATIVE-CYLINDER-OFFSET)/]
5384                                 [ASCIZ/(READ LATE-DATA-STROBE POSITIVE-CYLINDER-OFFSET)/]
5385                                 [ASCIZ/(READ LATE-DATA-STROBE NEGATIVE-CYLINDER-OFFSET)/]
5386                             ]-%DMRED
5387                 JRST .+1 ]
5388         PUSHJ P,OUTSTR
5389         TYPE , DRIVE=
5390         MOVE A,DSCDRV
5391         PUSHJ P,TOPT
5392         TYPE , CYL=
5393         MOVE A,DSCCYL
5394         PUSHJ P,TOPT
5395         TYPE , HEAD=
5396         MOVE A,DSCHED
5397         PUSHJ P,TOPT
5398         TYPE , SEC=
5399         MOVE A,DSCSEC
5400         PUSHJ P,TOPT
5401         JRST T3STS9
5402 ];T300P
5403 \f
5404 SUBTTL READ & TYPE OUT HEADERS
5405
5406 DC,[    ;FOR NOW, DC10 ONLY
5407 RDHDHD==20              ;2WORDS PER SEC, MANY SECS
5408
5409 RDHEAD: JSR INIT        ;READ ALL HEADERS ON A TRACK
5410         PUSHJ P,CRR
5411         UNTMES UNIT=
5412         PUSHJ P,GETNUM
5413          JRST RDHEAD
5414         CAIL A,NUNITS
5415          JRST RDHEAD
5416         MOVEM A,TOU
5417         MOVE I,A
5418         PUSHJ P,RESET
5419 RDHD1:  TYPE CYL=
5420         PUSHJ P,GETNUM
5421          JRST DDT
5422         CAIL A,NCYLS+XCYLS
5423          JRST RDHD1
5424         SKIPGE QTRAN(I)
5425          ADDI A,NCYLS+XCYLS
5426         DPB A,[DCYL READHD]
5427         TYPE SURF=
5428         PUSHJ P,GETNUM
5429          SETZ A,
5430         CAIL A,NHEDS
5431          JRST RDHD1
5432         DPB A,[DSURF READHD]
5433         DATAO DC0,[DJMP READHD]
5434         CONSZ DC0,DSSACT
5435          JRST .-1
5436         CONSZ DC0,DSSERR
5437          JRST [ TYPE ERROR---
5438                 JRST GETSTS]
5439         SETOM SECT0'
5440         SETOM FIRST
5441         SETZ T,
5442 RDHD2:  MOVE D,HEADBF(T)
5443         TLZ D,777000
5444         CAMN D,SECT0
5445          JRST RDHD1                     ;GONE AROUND ONCE
5446         AOSN FIRST
5447          MOVEM D,SECT0
5448         TYPE PKID=
5449         LDB A,[DPKID HEADBF(T)]
5450         PUSHJ P,TOPT
5451         PUSHJ P,TCOMMA
5452         MOVE D,HEADBF(T)
5453         PUSHJ P,TYPLOC
5454         PUSHJ P,CRR
5455         MOVE A,HEADBF+1(T)
5456         TLNE A,1000                     ;INDIRECT BIT OF HEADER
5457          JRST [ MOVEI A,"@
5458                 PUSHJ P,TYO
5459                 MOVE D,HEADBF+1(T)
5460                 PUSHJ P,TYPLOC
5461                 JRST RDHD6]
5462         TYPE LENGTH=
5463         MOVN A,HEADBF+1(T)
5464         LDB A,[1600,,A]                 ;LENGTH FIELD
5465         PUSHJ P,TOPT
5466         LDB A,[270200,,HEADBF+1(T)]     ;ANY NEXT-ADDRESS CODE?
5467         JUMPE A,RDHD3
5468         MOVE B,NXTADR(A)
5469         PUSHJ P,OUTSTR
5470 RDHD3:  MOVE A,HEADBF+1(T)
5471         TLNE A,200
5472          JRST [ MOVEI B,[ASCIZ /,WRITE PROTECT/]
5473                 PUSHJ P,OUTSTR
5474                 JRST .+1]
5475 RDHD6:  SETO C,         ;PARITY
5476         HRLI T,-2
5477 RDHD4:  MOVEI D,14.
5478         MOVE A,HEADBF(T)
5479         XORM A,C
5480         LSH A,-2
5481         SOJG D,.-2
5482         AOBJN T,RDHD4
5483         TRNN C,3                ;BOTH ODD?
5484          JRST RDHD5
5485         MOVEI B,[ASCIZ /,BAD PARITY!!/]
5486         PUSHJ P,OUTSTR
5487 RDHD5:  PUSHJ P,CRR
5488         CAIL T,RDHDHD*NSECS
5489          JRST RDHD1
5490         JRST RDHD2
5491
5492 READHD: DSPC+DSWIDX+DSWNUL+DSCRHD       ;WAIT FOR INDEX, THENREAD HEADERS
5493         QCOPY HEADBF,RDHDHD*NSECS
5494         DHLT
5495
5496 HEADBF: BLOCK RDHDHD*NSECS
5497
5498 TCOMMA: MOVEI A,",
5499         JRST TYO
5500
5501 NXTADR: 0
5502         [ASCIZ /,END-OF-TRACK/]
5503         [ASCIZ /,END-OF-CYLINDER/]
5504         [ASCIZ /,END-OF-DISC/]
5505
5506 TYPLOC: TYPE CYL=
5507         LDB A,[DCYL D]
5508         PUSHJ P,TOPT
5509         TYPE ,SURF=
5510         LDB A,[DSURF D]
5511         PUSHJ P,TOPT
5512         TYPE ,SECT=
5513         LDB A,[DSECT D]
5514         JRST TOPT
5515
5516 GETNUM: SETZ C,
5517         SETOM FIRST
5518 GETNM1: PUSHJ P,TYI
5519         CAIL A,"0
5520         CAILE A,"9
5521          JRST [ MOVE A,C
5522                 SKIPL FIRST
5523                  AOS (P)
5524                 JRST CRR]
5525         AOS FIRST
5526         IMULI C,10
5527         ADDI C,-"0(A)
5528         JRST GETNM1
5529 ];DC
5530 \f
5531 SUBTTL DRIVE RESET
5532
5533 NTS,[
5534 DC,[
5535 RECAL:  CONO DC0,DCCSET+DCDENB
5536         MOVE T,QTRAN(I)
5537         SKIPL DRIVE(T)          ;SKIP IF DRIVE NOT KNOWN TO BE DEAD ALREADY
5538          JRST [ SETZM QACT(I)
5539                 POPJ P,]
5540         DPB T,[DUNFLD DRST]
5541         DPB T,[DUNFLD STOSTS]
5542         DATAO DC0,[DJMP STOSTS]
5543         CONSZ DC0,DSSACT
5544          JRST .-1
5545         MOVE T,STATUS
5546         TDNN T,[DDSONL]         ;ON LINE
5547          JRST OFFL1
5548         DATAO DC0,DRST
5549         CONSO DC0,DSSATT
5550          JRST .-1
5551         CONSO DC1,20            ;OFF LINE OR MULTIPLE SELECT
5552          POPJ P,
5553 OFFL1:  SETZM QACT(I)
5554         SKIPE GOGOX
5555          POPJ P,                ;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
5556         TYPE Drive off line #
5557         PUSH P,A
5558         HRRZ A,QTRAN(I)
5559         SETZM DRIVE(A)
5560         PUSHJ P,DPT
5561         POP P,A
5562         PUSHJ P,CRR
5563         POPJ P,
5564 ];DC
5565
5566 RP,[
5567 RESET:  PUSH P,A
5568         CONSZ   DPC,BUSY
5569          JRST   .-1
5570         DATAO   DPC,[DEASEC 776]
5571         DPB     I,[DUNFLD DRST]
5572         DATAO   DPC,DRST
5573 RESET0: DATAI   DPC,T
5574         TLNE T,20
5575          JRST RESET1
5576         SKIPE GOGOX
5577          JRST RESET9    ;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
5578         TYPE  OFF LINE #
5579         MOVE A,I
5580         PUSHJ P,DPT
5581         PUSHJ P,CRR
5582         JRST RESET9
5583
5584 RESET1: TLNN T,4
5585          JRST RESET2
5586         SKIPE GOGOX
5587          JRST RESET9    ;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
5588         TYPE  NO SUCH DRIVE #
5589         MOVE A,I
5590         PUSHJ P,DPT
5591         PUSHJ P,LCRR
5592         JRST RESET9
5593
5594 RESET2: TRNN    T,776
5595          JRST RESET0
5596         DATAO   DPC,[DEASEC 776]
5597         JRST POPAJ
5598
5599 RESET9: SETZM QACT(I)           ;THIS DRIVE LOST
5600         JRST POPAJ
5601
5602 DRST:   DRCALC
5603 ];RP
5604 \f
5605 DC,[
5606 RESET:  PUSHJ P,RECAL
5607         MOVE T,QTRAN(I)         ;GET PACK ID FROM HARDWARE
5608         DPB T,[DUNFLD GPKID]
5609         MOVEI T,TUTCYL
5610         SKIPGE QTRAN(I)
5611          ADDI T,NCYLS+XCYLS
5612         DPB T,[DCYL GPKID]
5613         CONO DC0,DCCSET+DCDENB
5614         DATAO DC0,[DJMP GPKID]
5615         CONSZ DC0,DSSACT
5616          JRST .-1
5617         LDB T,[DPKID RPKID]
5618         MOVEM T,PKNUM(I)
5619         POPJ P,
5620
5621 DRST:   DSPC+DSRCAL+DSWINF+DUNENB
5622 GPKID:  DSPC+DSCRHD+DSWNUL+DUNENB+TUTCYL_11.+TUTSRF_6+TUTSEC
5623         DCOPY RPKID(37774)
5624         DHLT
5625 ];DC
5626 ];NTS
5627
5628 TS,[
5629 RESET:  PUSH P,A
5630         HRRZ A,QTRAN(I)
5631         SKIPL DRIVE(A)
5632          JRST OFFL2
5633         CAML I,NQS
5634          JRST OFFL2
5635         HRRZ A,SQACT            ;SYSTEM QACT TABLE
5636         ADD A,I
5637         MOVSS A
5638         HRRI A,A
5639         .GETLOC A,              ;COPY SYSTEMS QACT
5640         SKIPE A                 ;0 MEANS ON-LINE TO ITS
5641          JRST OFFLIN
5642         POP P,A
5643         POPJ P,
5644
5645
5646 OFFLIN: TYPE Drive off line #
5647         HRRZ A,QTRAN(I)
5648         SETZM DRIVE(A)
5649         PUSHJ P,DPT
5650         PUSHJ P,CRR
5651 OFFL2:  SETZM QACT(I)
5652         POP P,A
5653         POPJ P,
5654 ];TS
5655 \f
5656 NTS,[
5657 RH,[
5658 RESET:  MOVE T,QTRAN(I)                 ;GET PHYS DRIVE
5659 IFN T300P,[
5660         CAIL I,T300P
5661          JRST T3RST
5662 ];T300P
5663         SKIPL DRIVE(T)
5664          JRST [ SETZM QACT(I)           ;DRIVE ALREADY KNOWN TO BE DOWN
5665                 POPJ P, ]
5666         PUSH P,A
5667         MOVE A,[%HRDCL,,%HMCLR]         ;CLEAR THE DRIVE
5668         PUSHJ P,RHSET
5669          JRST RESETL                    ;HMM, NO DRIVE
5670         MOVE A,[%HRDCL,,%HMRDP]         ;I SAID, "CLEAR THE DRIVE"!
5671         PUSHJ P,RHSET
5672          JRST RESETL
5673         MOVE A,[%HROFS,,0]              ;CLEAR THE FRIGGING DRIVE!!!
5674         PUSHJ P,RHSET
5675          JRST RESETL
5676         MOVSI A,%HRTYP                  ;GET DRIVE TYPE
5677         PUSHJ P,RHGET
5678          JRST RESETL                    ;??
5679         TRNE A,140000
5680          JRST RESETL                    ;TAPE?
5681         TRNN A,020000
5682          JRST RESETL                    ;FIXED HEADS?
5683         MOVE A,[%HRDCL,,%HMACK]         ;PACK ACKNOWLEDGE
5684         PUSHJ P,RHSET
5685          JRST RESETL
5686         MOVSI A,%HRSTS
5687         PUSHJ P,RHGET
5688          JRST RESETL
5689         TRNN A,%HSMOL
5690          JRST RESET4                    ;PACK NOT MOUNTED
5691         MOVE A,[%HRDCL,,%HMREC]         ;RECALIBRATE
5692         PUSHJ P,RHSET
5693          JRST RESETL
5694         MOVEI B,80000.                  ;A LITTLE OVER 1/2 SEC
5695 RESET0: MOVSI A,%HRSTS                  ;GET STATUS
5696         PUSHJ P,RHGET
5697          JRST RESETL                    ;DRIVE VANISHED?
5698         TRNE A,%HSERR
5699          JRST RESETL                    ;GOT ERROR RECALIBRATING?
5700         TRC A,%HSVV+%HSMOL+%HSRDY       ;CHECK FOR GOOD BITS
5701         TRCE A,%HSVV+%HSMOL+%HSRDY
5702          SOJG B,RESET0                  ;BITS NOT ALL ON, WAIT MORE
5703         JUMPG B,RESET5                  ;WON.
5704                                         ;TIMED OUT, FALL INTO RESETL
5705
5706 RESETL: SETZM QACT(I)                   ;LOST
5707         SKIPE GOGOX
5708          JRST POPAJ     ;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
5709         CONSZ DSK,%HIDRE
5710          JRST RESET1
5711         CONSZ DSK,%HIILC
5712          JRST RESET2
5713         TYPE MISC ERROR DRIVE #
5714         MOVEI A,GSTS                    ;CALL GSTS BEFORE RETURNING
5715         EXCH A,(P)
5716         PUSH P,A
5717         JRST RESET3
5718
5719 RESET2: TYPE ILC OR RAE DRIVE #
5720         JRST RESET3
5721
5722 RESET1: TYPE DRIVE NOT PRESENT #
5723 RESET3: HRRZ A,QTRAN(I)
5724         X DPT
5725         X CRR
5726         JRST POPAJ
5727
5728 RESET4: SETZM QACT(I)
5729         SKIPE GOGOX
5730          JRST POPAJ     ;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
5731         TYPE DRIVE OFF LINE #
5732         JRST RESET3
5733
5734 RESET5: SKIPE MARKF
5735          JRST POPAJ                     ;PACK NOT FORMATTED YET
5736         MOVSI A,%HRCYL
5737         HRRI A,TUTCYL
5738         PUSHJ P,RHSET
5739          JRST RESETL
5740         MOVSI A,%HRADR
5741         PUSHJ P,RHSET
5742          JRST RESETL
5743         MOVE A,[-2_4,,SLVIOWD-1]
5744         MOVEM A,SLVICWA
5745         SETZM SLVICWA+1
5746 KL,[    SWPUO 0
5747         CONSZ APR,200000
5748          JRST .-1
5749 ]
5750         MOVE A,[%HRCTL,,SLVICWA_6+%HMRHD]
5751         PUSHJ P,RHSET
5752          JRST RESETL
5753         CONSO DSK,%HIDONE
5754          JRST .-1
5755         CONSZ DSK,%HIERR
5756          JRST RESETL
5757         HRRZ A,SLVIOWD+1                ;GET I.T.S. PACK NUMBER
5758         MOVEM A,PKNUM(I)
5759         JRST POPAJ
5760 ];RH
5761 \f
5762 IFN T300P,[
5763 T3RST:  PUSH P,D
5764         MOVEI D,%DMSNS          ;FIRST, SENSE STATUS (RECALIBRATE HANGS IF
5765         PUSHJ P,T3CMD           ; DRIVE OFF LINE, AND TIMEOUT LEAVES 11 WEDGED)
5766         JUMPL T,T3RSTL          ;TIMEOUT, 11 MUST BE DOWN
5767         TDNE T,[%DFRST,,%DSOFL+%DSSFL]
5768          JRST T3RSTL            ;DRIVE OFF-LINE, LEAVE IT ALONE
5769         MOVEI D,%DMREC          ;SEND A RECALIBRATE
5770         PUSHJ P,T3CMD
5771         JUMPN T,T3RSTL          ;JUMP IF ERROR
5772         SETOM PKNUM(I)          ;PACK NUMBER NOT GOTTEN FROM HARDWARE!
5773         POP P,D
5774         POPJ P,
5775
5776 T3RSTL: SETZM QACT(I)           ;OFF LINE
5777         POP P,D
5778         SKIPN GOGOX
5779          JRST T3STS
5780         POPJ P,
5781
5782 ;DO COMMAND IN D ON DRIVE NUMBER IN I, RETURN STATUS IN T (0 IF OK)
5783 ;LH(T) GETS DSCFLT, RH(T) GETS DSCSTS
5784 ;YOU MUST SET UP DSCCYL, ETC. BEFORE CALLING
5785 T3CMD:  MOVEI T,2561
5786         MOVEM T,DSCCHK
5787         MOVEM D,DSCCMD
5788         MOVEI T,-T300P(I)
5789         MOVEM T,DSCDRV
5790         SETZM DSCDON
5791 KL,[    SWPUO 0                 ;UNLOAD PAGE 0 FROM THE CACHE
5792         CONSZ APR,200000
5793          JRST .-1
5794 ];KL
5795         MOVEI T,1
5796         MOVEM T,DSCREQ
5797 KL,[    SWPUO 0                 ;UNLOAD PAGE 0 FROM THE CACHE
5798         CONSZ APR,200000        ;AGAIN SO 11 WILL SEE DSCREQ ON IN INTERRUPT
5799          JRST .-1
5800 ];KL
5801         CONO DLC,100040         ;INTERRUPT 11
5802         MOVEI T,60000.          ;I THINK THIS TIMEOUT IS ABOUT 3 SECONDS
5803                                 ;UNFORTUNATELY, THIS TIMEOUT DOESN'T WORK ANYWAY
5804                                 ;REALLY, BECAUSE IF DRIVE 0 IS OFFLINE THE
5805                                 ;CONTROLLER HANGS AND EXECUTES COMMANDS WRONG
5806                                 ;AND OTHERWISE LOSES ITS ASS.
5807 T3CMD1:
5808 KL,[    SWPUO 0                 ;UNLOAD PAGE 0 FROM THE CACHE
5809         CONSZ APR,200000        ;AGAIN SO DSCDON GETS PICKED UP FROM MAIN MEMORY
5810          JRST .-1
5811 ];KL
5812         SKIPN DSCDON
5813          SOJG T,T3CMD1
5814         JUMPLE T,[ MOVSI T,(SETZ)       ;SIGNAL TIMEOUT (DRIVE OFFLINE?)
5815                    POPJ P, ]    ;DSCFLT & DSCSTS WILL SAY NON-ERROR
5816         SETZM DSCDON
5817         CONO DLC,10             ;11 IS TRYING TO INTERRUPT -10, TURN IT OFF
5818         HRLZ T,DSCFLT
5819         HRR T,DSCSTS
5820         TRZE T,%DSRTR+%DSECC    ;THESE ARE NOT ERRORS
5821          AOS CERRS
5822         POPJ P,
5823 ];T300P
5824 ];NTS
5825 \f
5826 SUBTTL READ & WRITE TUT
5827
5828 ;DISK NUMBER IN I, CORE ADDR IN A, ERROR RETURN HAS T NEGATIVE
5829
5830 WRTUT:
5831 TS,     JRST SUCCESS
5832 NTS,[   MOVE J,MFDBK
5833         SUB J,NTBL(I)
5834 WRTUT0: PUSHJ P,WRITE
5835         JUMPL T,CPOPJ
5836         ADDI A,2000
5837         ADDI J,1
5838         CAMGE J,MFDBK
5839          JRST WRTUT0
5840         POPJ P,
5841 ];NTS
5842
5843 RDTUT:
5844 NTS,[   MOVE J,MFDBK
5845         SUB J,NTBL(I)
5846 RDTUT0: PUSHJ P,READ
5847         JUMPL T,CPOPJ
5848         ADDI A,2000
5849         ADDI J,1
5850         CAMGE J,MFDBK
5851          JRST RDTUT0
5852         POPJ P,
5853 ];NTS
5854 TS,[    TUTPAG==600000                  ;READ TUT BY MAPPING IN ABS PAGE
5855         MOVE T,NTBL(I)                  ;SIZE OF TUT ON THIS DRIVE
5856         MOVE J,[SQUOZE 0,QTUTO]         ;AND WHERE ARE THEY LOCATED?
5857         .EVAL J,
5858          .VALUE
5859         PUSH P,A
5860         PUSH P,I
5861         ADD J,I                         ;-> -> FIRST BLOCK THIS TUT
5862         MOVSS J
5863         HRRI J,J
5864         .GETLOC J,
5865         HRRZS J
5866         LSH J,-10.                      ;FIRST BLOCK# OF TUT
5867         MOVN I,T
5868         HRL J,I                         ;AOBJN PTR FOR BLOCKS OF THIS TUT
5869 RDTUT1: .CALL [ SETZ
5870                 'CORBLK
5871                 MOVEI 210000            ;READ ONLY
5872                 MOVEI -1                ;INTO SELF
5873                 MOVEI TUTPAG/2000
5874                 MOVEI 400000            ;FROM SYSTEM
5875                 SETZI (J) ]
5876          .VALUE
5877         MOVSI I,TUTPAG
5878         JRST RDTUT3
5879
5880 RDTUT3: HRRI I,(A)
5881         BLT I,1777(A)                   ;COPY IN A BLOCK OF TUT
5882         ADDI A,2000
5883         AOBJN J,RDTUT1
5884         POP P,I
5885         POP P,A
5886         SKIPGE QPKNUM(A)
5887          .VALUE                         ;OLD FORMAT?
5888         SKIPN QLASTB(A)
5889          .VALUE                         ;OLDER FORMAT?
5890         JRST SUCCESS
5891 ];TS
5892 \f
5893 SUBTTL DISK I/O
5894
5895 WRITT:  MOVE I,TOU
5896 WRITE:  HRRZM J,LBLK'
5897 TS,[    HRRZ TT,I
5898         CAML TT,NQS
5899          .VALUE
5900         HRRZ TT,J
5901         CAIGE TT,TBLKS
5902         SKIPGE TT
5903          .VALUE
5904         JRST SUCCESS
5905 ];TS
5906 DC,[    SKIPA T,[DWR]
5907 READ:    MOVEI T,DRD    ;A/ CORE LOCN, I/ DRIVE  J/TRACK #
5908         HRRM T,DGO
5909         HRRZM J,BLK
5910         MOVEM I,UNIT
5911         HRRZ TT,I
5912         CAIL TT,NUNITS
5913          JRST 4,.
5914         HRRZ TT,J
5915         CAIGE TT,TBLKS
5916         SKIPGE TT
5917          JRST 4,.
5918         MOVE TT,QTRAN(I)                ;GET PHYSICAL DRIVE #
5919         DPB TT,[DUNFLD (T)]
5920         DPB A,[DCCA 1(T)]
5921         DPB A,[DCCA 4(T)]
5922         HRRZ TT,J
5923         CAIL TT,NBLKS+XBLKS
5924          JRST 4,.
5925         IDIVI TT,NSECS
5926         DPB T,[DSECT @DGO]
5927         IDIVI TT,NHEDS
5928         DPB T,[DSURF @DGO]
5929         MOVE T,TT
5930         SKIPGE QTRAN(I)
5931          ADDI T,NCYLS+XCYLS             ;MAP INTO 2ND HALF OF CALCOMP
5932         DPB T,[DCYL @DGO]
5933         MOVE T,PKNUM(I)
5934         CAIL TT,NCYLS
5935          MOVEI T,0
5936         DPB T,[DPKID @DGO]
5937         HRRZ TT,DGO
5938         MOVE T,(TT)
5939         TLZ T,340000    ;CHANGE TO READ COMPARE
5940         MOVEM T,3(TT)
5941 RW1:    MOVEI T,30.
5942         SKIPE HCRASH
5943          MOVEI T,0              ;SPEED IS OF THE ESSENCE - TRY ONLY ONCE
5944 RW2:    CONO DC0,DCCSET\DCDENB
5945         DATAO DC0,DGO
5946         MOVSI TT,3              ;WAIT AT MOST 3 SECONDS
5947         CONSZ DC0,DSSACT
5948          SOJGE TT,.-1
5949         JUMPL TT,[ PUSH P,T
5950                    X RECAL
5951                    POP P,T
5952                    JRST .+2 ]
5953         CONSZ DC0,DSSERR
5954          SOJGE T,RW2
5955         SKIPGE T
5956          AOS FERRS
5957         POPJ P,
5958
5959 DGO:    DJMP .
5960
5961 DRD:    DREAD+DUNENB
5962         DCOPY .(-2000_2&37774)
5963         DCOPY RXWDS(-4_2&37774)
5964         DRC
5965         DCCOMP .(-2000_2&37774)
5966         DCCOMP RXWDS (-4_2&37774)
5967         DHLT
5968
5969 DWR:    DWRITE+DUNENB
5970         DCOPY .(-2000_2&37774)
5971         DCOPY WXWDS(-4_2&37774)
5972         DRC
5973         DCCOMP .(-2000_2&37774)
5974         DCCOMP WXWDS(-4_2&37774)
5975         DHLT
5976 ];DC
5977 \f
5978 TS,[
5979 READ:   HRRZ TT,I
5980         CAIL TT,NUNITS
5981          .VALUE
5982         HRRZ TT,J
5983         CAMN TT,MFDBK
5984          JRST [ .OPEN QIN,[.BII,,'DSK
5985                            SIXBIT /M.F.D./
5986                            SIXBIT /(FILE)/]
5987                  .VALUE
5988                 JRST RDIN]
5989         CAML TT,NUDS
5990          .VALUE                 ;SOME RANDOM DISK BLOCK
5991         .SUSET [.SSNAM,,USRNAM]
5992         .OPEN QIN,[.BII,,'DSK
5993                    SIXBIT /.FILE./
5994                    SIXBIT /(DIR)/]
5995          .VALUE
5996 RDIN:   HRLI A,-2000
5997         .IOT QIN,A
5998         .CLOSE QIN,
5999 SUCCES: MOVEI T,30.
6000         POPJ P,
6001 ];TS
6002 \fRP,[   ;RP10 I/O - FALL IN FROM WRITE
6003         SKIPA T,DWR
6004 READ:    MOVE T,DRD
6005         MOVEM T,RPIOOP
6006         HRRZ TT,J
6007         CAIL TT,MBLKS+XBLKS
6008          JRST 4,.
6009         IMULI TT,SECBLK
6010         IDIVI TT,NSECS
6011         MOVEM T,RPIOSC
6012         IDIVI TT,NHEDS
6013         MOVEM T,RPIOHD
6014         MOVEM TT,RPIOCY
6015         MOVEM A,RPAOBJ
6016         MOVNI T,2000
6017         HRLM T,RPAOBJ
6018         JRST RPIO               ;DO IT
6019
6020 DRD:    DREADC+SLVICWA+5000     ;DISABLE PARITY ERROR STOPS
6021 DWR:    DWRITC+SLVICWA
6022
6023 ;VARIABLES SET UP TO CONTROL TRANSFER
6024 ;WHEN AN ERROR OCCURS, IT GOES INTO SECTOR AT A TIME MODE, AND
6025 ;THESE VARIABLES ARE STEPPED ALONG TO REFLECT THAT.
6026 RPAOBJ: 0       ;AOBJN POINTER TO WORDS TO BE TRANSFERRED
6027 RPIOCY: 0       ;CYLINDER TO START AT
6028 RPIOHD: 0       ;HEAD TO START AT
6029 RPIOSC: 0       ;SECTOR TO START AT
6030 RPIOOP: 0       ;COMMAND WORD. SLVICWA ALREADY ADDED IN
6031 ;UNIT IS IN I
6032
6033 ;HIGH-LEVEL I/O ROUTINE.  TRIES TO DO IT ALL AT ONCE,
6034 ;IF THAT LOSES TWICE TRIES IT A SECTOR AT A TIME.
6035 ;IF HCRASH IS SET, TRY ONLY ONCE.
6036 ;SMASHES T, TT.  RETURNS T NEGATIVE IF ERROR.
6037 RPIO:   PUSH P,A
6038         SETZM SLVIOWD+1
6039         MOVE T,RPAOBJ
6040         SOS T
6041         MOVEM T,SLVIOWD
6042         PUSHJ P,RPXIO           ;TRY IT
6043          JRST RPIO1
6044         MOVEI T,102             ;WON
6045         JRST RPIO9
6046
6047 RPIO1:  SETOM T
6048         SKIPE HCRASH
6049          JRST RPIO9             ;GIVE UP IF HCRASH
6050         PUSHJ P,RPRCAL          ;RECALIBRATE, THEN
6051         PUSHJ P,RPXIO           ;TRY IT AGAIN
6052          JRST RPIO2
6053         MOVEI T,101             ;WON
6054 RPIO9:  SKIPGE T
6055          AOS FERRS
6056         POP P,A
6057         POPJ P,
6058
6059 ;SECTOR AT A TIME MODE
6060 RPIO2:  MOVEI T,100
6061         SKIPL TT,RPAOBJ
6062          JRST RPIO9             ;TRANSFER EXHAUSTED, WON
6063         SOS TT
6064         HRLI TT,-200
6065         MOVEM TT,SLVIOWD
6066         MOVEI T,10.             ;TRY THIS SECTOR 10 TIMES
6067         PUSHJ P,RPXIO
6068          SOJGE T,.-1
6069         JUMPL T,RPIO9           ;GIVE UP
6070         MOVE T,[200,,200]       ;ADVANCE TO NEXT SECTOR
6071         ADDM T,RPAOBJ
6072         AOS T,RPIOSC
6073         CAIGE T,NSECS
6074          JRST RPIO2
6075         SETZM RPIOSC
6076         AOS T,RPIOHD
6077         CAIGE T,NHEDS
6078          JRST RPIO2
6079         SKIPL RPAOBJ
6080          JRST RPIO2
6081         JRST 4,.                ;CYLINDER OVERFLOW?
6082
6083 ;LOW-LEVEL IO, JUST DO THE OPERATION SPECIFIED IN THE VARIABLES.
6084 ;CLOBBER A,TT.
6085 ;SKIP IF SUCCESS.
6086 RPXIO:  MOVEI TT,SLVIOWD        ;SET UP DF10 COMMAND
6087         HRRZM TT,SLVICWA
6088         SETZM SLVICWA+1
6089         PUSH P,T
6090         PUSHJ P,SEEK            ;MAKE SURE AT DESIRED CYLINDER
6091          JRST POPTJ             ;SEEK FAILED
6092         POP P,T
6093         MOVE A,RPIOOP           ;SET UP RP10 DATAO
6094         DPB I,[DUNFLD A]
6095         MOVE TT,RPIOCY
6096         DPB TT,[DCYL A]
6097         LSH TT,-8               ;FOR RP03
6098         DPB TT,[DCYLXB A]
6099         MOVE TT,RPIOHD
6100         DPB TT,[DSURF A]
6101         MOVE TT,RPIOSC
6102         DPB TT,[DSECT A]
6103         CONO DPC,DCLEAR
6104         SKIPN HCRASH            ;IF HCRASH, MAY BE MONITORING SOMETHING IN LIGHTS?
6105          DATAO LIGHTS,A
6106         DATAO DPC,A             ;ISSUE COMMAND
6107         CONSO DPC,DONE          ;AWAIT DONE
6108          JRST .-1
6109         CONSZ DPC,ALLER         ;SKIP-RETURN UNLESS ERROR
6110          POPJ P,
6111         HLRO TT,RPAOBJ          ;SEEMS SUCCESSFUL, CHECK THE CHANNEL CONTROL WORD STORED
6112         HRRZ A,RPAOBJ
6113         SUB A,TT                ;SUPPOSED END OF TRANSFER
6114         HRRZ TT,SLVICWA+1
6115         CAIE A,1(TT)
6116 DF10FK:  POPJ P,                ;CHANNEL TRYING TO FUCK YOU OVER
6117         JRST POPJ1
6118
6119 ;RECALIBRATE UNIT IN I, SMASHES T,TT
6120 RPRCAL: CONO DPC,DCLEAR
6121         MOVE T,[DEASEC 776]
6122         DPB I,[DUNFLD T]        ;LEAVE PROPER UNIT SELECTED FOR GETSTS
6123         DATAO DPC,T             ;CLEAR ATTNS
6124         DPB I,[DUNFLD DRST]
6125         DATAO DPC,DRST
6126 RPRCL1: DATAI DPC,TT
6127         TLNN TT,(ONLINE)
6128          POPJ P,                ;OFF LINE
6129         TLNE TT,(NSCHDR)
6130          POPJ P,                ;NO SUCH DRIVE
6131         TRNN TT,776
6132          JRST RPRCL1            ;AWAIT ATTENTION
6133         DATAO DPC,T             ;GOT ATTENTION, CLEAR IT
6134 RPRCL2: TLNE TT,(ONCYL+SKINC)
6135          POPJ P,                ;DONE
6136         DATAI DPC,TT
6137         JRST RPRCL2             ;ON CYLINDER SOMETIMES TAKES A WHILE TO SET
6138
6139 ;SEEK TO CYLINDER IN RPIOCY ON UNIT I, SMASHES T,TT, SKIPS ON SUCCESS.
6140 SEEK:   MOVEI TT,10.
6141         MOVEM TT,SEEKC
6142 SEEK1:  CONSZ DPC,BUSY
6143          JRST .-1
6144         DATAO DPC,[DEASEC 776]
6145         MOVSI TT,(DSEEKC)
6146         DPB I,[DUNFLD TT]
6147         MOVE T,RPIOCY
6148         DPB T,[DCYL TT]
6149         LSH T,-8                ;FOR RP03
6150         DPB T,[DCYLXB TT]
6151         SKIPN HCRASH
6152          DATAO LIGHTS,TT
6153         CONO DPC,DCLEAR
6154         DATAO DPC,TT
6155         MOVE T,[DEASEC 776]
6156         DPB I,[DUNFLD T]        ;LEAVE PROPER UNIT SELECTED FOR GETSTS
6157         PUSHJ P,RPRCL1          ;AWAIT COMPLETION
6158         TLNE TT,(ONCYL)         ;SUCCEED IF ON CYLINDER
6159          JRST POPJ1
6160         SOSGE T,SEEKC           ;COUNT FAILURES
6161          POPJ P,                ;GIVE UP
6162         PUSHJ P,RPRCAL          ;RECALIBRATE
6163         JRST SEEK1              ;AND TRY AGAIN
6164 ];RP
6165 \fRH,[   ;RH10 I/O - FALL IN FROM WRITE
6166
6167 ;ENTER WITH: A ADDRESS, J BLOCK NUMBER, I VIRTUAL UNIT
6168 .SEE RHCMD ;VARIABLES CONTROLLING WHAT GOES ON HERE
6169 ;INSIDE RW2 TT GENERALLY HAS THE DISK COMMAND AND T HAS THE RETRY COUNT
6170 ;ONLY T AND TT CLOBBERED
6171 ;ON RETURN T MINUS IF ERROR
6172
6173         SKIPA TT,[%HMWRT]
6174 READ:    MOVEI TT,%HMRED
6175 IFN T300P,[
6176         CAIL I,T300P
6177          JRST T3IO
6178         SETZM T3IOP
6179 ];T300P
6180         MOVEM TT,RHCMD
6181         HRRZ TT,J
6182         CAIL TT,TBLKS
6183          JRST 4,.
6184         IDIVI TT,NBLKSC         ;TT:=CYLINDER, T:=BLOCKS INTO CYLINDER
6185         HRLZM TT,RHPGA          ;SAVE CYLINDER
6186         MOVE TT,T               ;GET BLOCKS INTO CYLINDER
6187         IMULI TT,SECBLK         ;SECTORS INTO CYLINDER
6188         IDIVI TT,NSECS          ;TT:=HEAD, T:=SECTOR
6189         LSH TT,8                ;FORM ADDRESS WORD
6190         IOR TT,T
6191         HRRM TT,RHPGA           ;COMPLETE THE ADDRESS
6192         MOVEI T,-1(A)           ;SET UP IOWD TO TRANSFER ONE BLOCK
6193         HRLI T,-2000
6194         MOVEM T,RHIOW
6195 ;ENTER HERE WITH RHCMD, RHIOW, AND RHPGA SET UP.  I HAS UNIT#.
6196 RW1:    MOVEI T,5               ;INIT LOSAGE COUNT
6197         PUSHJ P,RW2             ;TRY
6198          JRST RW7               ;FAILED
6199 ;HERE TO RETURN.  T SAYS WHETHER WINNING OR LOSING.
6200 RW5:    MOVE A,[%HRDCL,,%HMCEN] ;RETURN TO CENTER-LINE IF NECESSARY
6201         AOSN OFFSTF
6202          PUSHJ P,RHSET
6203           JFCL
6204         SKIPGE T
6205          AOS FERRS
6206         MOVE A,RHIOW            ;RESTORE A
6207         MOVEI A,1(A)
6208         POPJ P,
6209
6210 ;HERE IF LOSING.
6211 RW7:    SKIPE HCRASH
6212          JRST RWL0              ;SPEED IS OF THE ESSENCE, TRY ONLY ONCE
6213         PUSHJ P,RW2             ;HMM, TRY AGAIN
6214          JRST RWLOSS            ;STILL LOSING, COGITATE
6215         JRST RW5                ;WINNING NOW
6216
6217 RWLOSS: MOVSI A,%HROFS          ;ATTACK OFFSET REGISTER
6218         HRR A,OFFSTB(T)         ;SET APPROPRIATE OFFSET VALUE
6219         SETOM OFFSTF'           ;REMEMBER TO RETURN TO CENTERLINE LATER
6220         PUSHJ P,RHSET
6221          JRST RWL0              ;WHAT??
6222         MOVE A,[%HRDCL,,%HMOFS]
6223         PUSHJ P,RHSET
6224          JRST RWL0
6225         MOVEI A,20000.          ;WAIT 10 MS OR SO FOR GOOD LUCK
6226         SOJG A,.
6227         PUSHJ P,RW2             ;TRY IT NOW
6228          SOJGE T,RWLOSS         ;LOSE, TRY WITH DIFFERENT OFFSET
6229         JUMPGE T,RW5            ;WON, SO TAKE WIN RETURN
6230 RWL0:   SETO T,                 ;COMPLETE LOSS, RETURN NOW
6231         JRST RW5
6232
6233 OFFSTB: 260
6234         60
6235         240
6236         40
6237         220
6238         20
6239 \f;RH10 I/O ROUTINE PROPER
6240 ;FIRST STEP IS TO SET UP CHANNEL COMMAND LIST
6241 RW2:    MOVE TT,RHIOW           ;SET UP ADDRESSES
6242         MOVEM TT,RHTIOW
6243         MOVE TT,RHPGA
6244         MOVEM TT,RHTPGA
6245 ;RE-ENTER HERE AFTER ECC ERROR
6246 RW2OVR: PUSH P,B
6247         PUSH P,C
6248         MOVE A,[-6,,SLVIOWD]    ;POINTS TO WHERE CCWS WILL BE STORED
6249         HLRO C,RHTIOW           ;MINUS NUMBER OF WORDS TO TRANSFER
6250         MOVNS C                 ;POSITIVE
6251         HRRZ B,RHTIOW           ;ADDRESS MINUS ONE
6252 RW2CC1: MOVN TT,C               ;WORDS TO TRANSFER IN THIS CCW
6253         CAIL C,40000-200        ;WC IS ONLY A 14-BIT FIELD
6254          MOVNI TT,40000-200
6255         MOVEM B,(A)             ;STORE CA
6256         DPB TT,[$DFWC (A)]      ;STORE WC
6257         ADD C,TT                ;LESS WORDS TO DO
6258         SUB B,TT                ;ADVANCE ADDRESS
6259         AOBJP A,[JRST 4,.]      ;ADVANCE CCW PTR, HALT IF TOO BIG!
6260         JUMPG C,RW2CC1          ;NEED MORE WORDS
6261         SETZM (A)               ;END CCW LIST
6262         HRRZI A,SLVIOWD         ;POINT CHANNEL AT IT
6263         MOVEM A,SLVICWA
6264         SETZM SLVICWA+1         ;INIT FOR CONTROL WORD WRITING
6265         POP P,C
6266         POP P,B
6267         MOVEI A,SLVICWA         ;BUILD DATAO CMD
6268         MOVE TT,RHCMD
6269         DPB A,[$HCICWA TT]
6270         TLO TT,%HRCTL           ;FILL OUT COMMAND WORD
6271                 ;NOW BEFORE GIVING COMMAND CHECK STATUS
6272         CONSZ DSK,%HIBSY        ;WAIT FOR DSK CONTROL
6273          JRST .-1
6274         CONO DSK,%HOCLR         ;CLEAR ANY LEFT-OVER ERROR INDICATORS
6275 RW2A:   MOVSI A,%HRSTS          ;CHECK DRIVE STATUS
6276         PUSHJ P,RHGET
6277          JRST RW3               ;DRIVE VANISHED??
6278         TRNE A,%HSPIP           ;WAIT FOR POSITIONING
6279          JRST RW2A              ;(MIGHT BE OFFSETTING HEADS?)
6280         TRNE A,%HSERR           ;ANY ERRORS IN DRIVE?
6281          JRST RW6               ;YES, TRY TO RECOVER
6282         TRC A,%HSVV+%HSMOL+%HSRDY ;CHECK FOR ALL READY BITS ON
6283         TRCE A,%HSVV+%HSMOL+%HSRDY
6284          JRST RW3               ;NOT READY??
6285         HLRZ A,RHTPGA           ;SET CYLINDER
6286         TLO A,%HRCYL
6287         PUSHJ P,RHSET
6288          JRST RW3
6289         HRRZ A,RHTPGA           ;SET TRACK-SECTOR
6290         TLO A,%HRADR
6291         PUSHJ P,RHSET
6292          JRST RW3
6293 KL,[    MOVE A,RHTIOW           ;SWEEP THE CACHE
6294         AOS A                   ;RH ADDRESS OF BUFFER, LH - # WDS
6295         LSH A,-9.
6296         TRZ A,777000
6297         TLO A,777000            ;A NOW HAS AOBJN PTR TO PAGES
6298 RWSWP3: TRNE TT,10              ;SWEEP ONE PAGE
6299          SWPIO (A)              ;IF READING, INVALIDATE
6300         TRNN TT,10
6301          SWPUO (A)              ;IF WRITING, UNLOAD
6302         CONSZ APR,200000        ;WAIT UNTIL SWEEPER WAKES
6303          JRST .-1
6304         AOBJN A,RWSWP3
6305         SWPUO 0                 ;STORE CHANNEL PROGRAM IN CORE
6306         CONSZ APR,200000
6307          JRST .-1
6308 ];KL
6309 ;DROPS THROUGH
6310 \f;DROPS IN
6311 RWGO:   MOVE A,TT               ;ISSUE I/O COMMAND
6312         PUSHJ P,RHSET
6313          JRST RW3
6314         CONSO DSK,%HIDONE       ;WAIT FOR COMPLETION
6315          JRST .-1
6316         MOVSI A,%HRSTS          ;CHECK DISK STATUS, ERRORS DON'T ALWAYS SHOW UP IN CONI
6317         PUSHJ P,RHGET
6318          JRST RW3
6319         TRNN A,%HSERR
6320          CONSZ DSK,%HIERR
6321           CAIA
6322            JRST POPJ1           ;NO ERROR, SKIP RETURN FROM RW2
6323 ;FOLLOWING TWO LINES CAUSE ECC NOT TO WORK
6324 ;       CONSO DSK,%HIEXC
6325 ;        POPJ P,                ;NOT DRIVE EXCEPTION, PROBABLY CORRIGIBLE BY RETRY
6326         TRNN A,%HSERR           ;ANYTHING IN ERR REGS?
6327          JRST RW3               ;FOO, WHAT IS GOING ON??
6328         MOVSI A,%HRER2          ;MAKE SURE NO UNSAFES
6329         PUSHJ P,RHGET
6330          JRST RW3
6331         JUMPN A,RW3
6332         MOVSI A,%HRER3
6333         PUSHJ P,RHGET
6334          JRST RW3
6335         JUMPN A,RW3
6336         MOVSI A,%HRER1          ;GET ERROR1 REG
6337         PUSHJ P,RHGET
6338          JRST RW3
6339         TRNE A,077067           ;GROSS ERROR?
6340          JRST RW3               ;YES, ABORT
6341         TRZE A,100000           ;SEE IF CORRECTABLE DATA ERROR
6342          JUMPE A,RWECC          ;YES, GO FIX IT
6343         POPJ P,                 ;ERROR, BUT RETRY MAY WIN
6344
6345 RW6:    MOVE A,[%HRDCL,,%HMCLR] ;ERROR IN DRIVE, TRY CLEARING
6346         PUSHJ P,RHSET
6347          JRST RW3
6348         MOVSI A,%HRSTS
6349         PUSHJ P,RHGET
6350          JRST RW3
6351         TRNN A,%HSERR
6352          JRST RW2A              ;WON
6353                                 ;LOST, FALL INTO RW3
6354
6355 RW3:    POP P,(P)               ;UNCORRECTABLE ERROR, RW FAILS
6356         JRST RWL0
6357 \f
6358 ;ERROR CORRECTION CODE -- TAKEN FROM MAINDEC-10-DDRPF
6359 ; THAT CODE HAD NO HOPE WHATSOEVER OF WORKING.  RETAKEN FROM ITS.
6360 ; THAT CODE DIDN'T WORK EITHER.  TAKEN FROM NEWER ITS.
6361
6362 RWECC:  TRNN TT,10              ;SKIP IF READ
6363          POPJ P,                ;RETRY IF WRITE
6364         INSIRP PUSH P,[B W U J K H]
6365                 DW1==W          ;FIRST WORD IN ERROR
6366                 DW2==U          ;SECOND WORD IN ERROR
6367                 EP1==J          ;FIRST WORD OF ERROR PATTERN
6368                 EP2==K          ;SECOND WORD OF ERROR PATTERN
6369                 ADR==H          ;ADDRESS OF LOSING WORDS
6370                 ;B              ;SO CAN DIVIDE A
6371         SKIPN A,SLVICWA+1       ;GET ADDRESS OF LAST WORD TRANSFERRED
6372          JRST 4,.-1             ;CHANNEL SHOULD HAVE STORED CONTROL WORD
6373         SOS ADR,A               ;LAST WORD TRANSFERRED (SUPPOSEDLY)
6374         ANDI ADR,-200           ;IN ANY CASE, THIS MAKES ADR -> START OF SECTOR
6375         HRRZ A,RHTIOW           ;ADR-1 OF START OF TRANSFER
6376         SUBM ADR,A
6377         SOS B,A                 ;NUMBER OF WORDS SUCCESSFULLY TRANSFERRED
6378         MOVEM B,RHSUCC          ;SAVE
6379         HLRO K,RHTIOW
6380         MOVNS K
6381         CAIL B,0                ;CHECK FOR CHANNEL LYING
6382          CAILE B,-200(K)
6383           JRST RWECC3           ;FRAUD, TRANSFERRED NEGATIVE OR TOO MANY WORDS
6384         MOVSI A,%HRPOS          ;GET ERROR POSITION
6385         PUSHJ P,RHGET
6386          JRST RWECC3
6387         SOJL A,RWECC3           ;WHICH IS OFF BY 1.  IF ZERO, LOSE.
6388         IDIVI A,36.             ;CONVERT TO WORD AND BIT
6389         ADD ADR,A
6390         MOVS DW1,(ADR)          ;FETCH THE TWO LOSING WORDS
6391         MOVS DW2,1(ADR)
6392         MOVSI A,%HRPAT          ;GET ERROR PATTERN
6393         PUSHJ P,RHGET
6394          JRST RWECC3
6395         MOVE EP1,A
6396         SETZ EP2,
6397         ROTC EP1,(B)            ;ALIGN IT
6398         XOR DW1,EP1             ;FIX THE ERRONEOUS BITS
6399         XOR DW2,EP2
6400 RWECCB:         ;SET BREAK HERE IF DON'T TRUST...
6401         MOVSM DW1,(ADR)         ;PUT CORRECTED DATA BACK
6402         MOVSM DW2,1(ADR)
6403         INSIRP POP P,[H K J U W]
6404
6405         AOS CERRS               ;COUNT NUMBER OF TIMES ECC DONE
6406         MOVEI A,%HMCLR          ;CLEAR THE ECC-ERROR CONDITION
6407         PUSHJ P,RHSET
6408          JFCL
6409         MOVEI A,200             ;ALLOW FOR THE SECTOR WE CORRECTED
6410         ADDB A,RHSUCC           ;GET BACK NUMBER OF WORDS TRANSFERRED
6411         IDIVI A,200             ;NUMBER OF SECTORS TRANSFERRED INCLUDING CORRECTED ONE
6412         LDB B,[$HASEC RHTPGA]   ;UPDATE DISK ADDRESS
6413         ADD A,B
6414         IDIVI A,NSECS
6415         DPB B,[$HASEC RHTPGA]
6416         LDB B,[$HATRK RHTPGA]
6417         ADD A,B
6418         DPB A,[$HATRK RHTPGA]   ;NO NEED TO IDIVI A,NHEDS SINCE ALL XFERS WITHIN CYLINDER
6419         MOVE A,RHSUCC           ;NOW ADVANCE CCW
6420         HRL A,A
6421         ADDB A,RHTIOW
6422         POP P,B
6423         TLNE A,-1
6424          JRST RW2OVR            ;NOT EXHAUSTED, CONTINUE DISK XFER
6425         JRST POPJ1              ;ECC IN LAST SECTOR OF XFER, XFER COMPLETED SUCCESSFULLY
6426
6427 RWECC3: INSIRP POP P,[H K J U W B]
6428         JRST RW3
6429 \f
6430 ;ROUTINES TO ACCESS RH10 CONTROLLER AND DRIVE REGISTERS
6431 ;CALL WITH
6432 ;       I  UNIT NUMBER
6433 ;       A  REGISTER NUMBER IN LH
6434 ; NON-SKIP RETURN IF RAE ERROR
6435 ; SKIP RETURN IF WIN
6436 ;CLOBBERS ONLY A
6437
6438 ;SET REGISTER.  TAKES DATA TO GO IN REGISTER IN RH OF A
6439 ;CLOBBERS A (PROBABLY)
6440
6441 RHSET:  TLOA A,%HRLOD           ;TELL HARDWARE IS SET INSTEAD OF GET
6442                                 ;AND FALL INTO RHGET
6443
6444 ;GET REGISTER.  RETURNS 16 BITS RIGHT-JUSTIFIED IN A
6445
6446 RHGET:   TLZ A,%HRLOD
6447         TLO A,(I)               ;INSERT PHYS DRV NO
6448         DATAO DSK,A             ;TELL RH10 TO FETCH REGISTER
6449         MOVEM A,RHLAST'         ;SAVE FOR REBUGGING
6450         MOVEI A,4               ;ENSURE 3 USEC DELAY BEFORE DATAI
6451         SOJG A,.                ;TO ALLOW MASSBUS TRANSACTION TO COMPLETE
6452         DATAI DSK,A             ;GET REG CONTENTS AND FLAGS
6453         TLNE A,%HDERR           ;ERROR?
6454          JRST RHRAE             ;YES, GO REPORT
6455         ANDI A,177777           ;MASK TO 16 BITS
6456         AOS (P)                 ;AND TAKE SUCCESS RETURN
6457         POPJ P,
6458
6459 RHRAE:  MOVSI A,%HRRAE+%HRLOD(I)
6460         DATAO DSK,A             ;CLEAR RAE REGISTER IN CONTROLLER
6461         POPJ P,                 ;AND TAKE NON-SKIP RETURN
6462
6463 ;DISK ROUTINE VARIABLES
6464
6465 RHCMD:  0       ;%HMRED OR %HMWRT
6466 RHIOW:  0       ;IOWD -NWDS,,ADR-1 FOR TRANSFER
6467 RHTIOW: 0       ;TEMPORARY IOWD FOR CONTINUING FROM ECC
6468 RHPGA:  0       ;DISK ADDRESS CYL,,HED_8+SEC
6469 RHTPGA: 0       ;TEMPORARY DISK ADDRESS FOR CONTINUING FROM ECC
6470 RHSUCC: 0       ;NUMBER OF WORDS SUCCESSFULLY TRANSFERRED BEFORE ECC
6471 ];RH
6472 \f
6473 IFN T300P,[     ;T-300 I/O - FALL IN FROM WRITE
6474
6475 ;ENTER WITH: A ADDRESS, J BLOCK NUMBER, I VIRTUAL UNIT
6476 ; TT %HMWRT OR %HMRED
6477 ;ONLY T AND TT CLOBBERED
6478 ;ON RETURN T MINUS IF ERROR
6479
6480 T3IO:   INSIRP PUSH P,[A B C D]
6481         SETOM T3IOP'
6482         CAIE TT,%HMRED          ;GET READ OR WRITE COMMAND
6483          SKIPA D,[%DMWRT]
6484           MOVEI D,%DMRED
6485 T3IO1:  HRRZ A,J                ;GUBBISH IN LH
6486         IDIVI A,NBLKC1          ;A CYLINDER, B BLOCK WITHIN CYLINDER
6487         MOVEM A,DSCCYL
6488         IMULI B,SECBL1          ;B SECTOR WITHIN CYLINDER
6489         IDIVI B,NSECS1          ;B HEAD, C SECTOR
6490         MOVEM B,DSCHED
6491         MOVEM C,DSCSEC
6492         MOVE B,-3(P)            ;ORIGINAL ADDRESS
6493         HRLI B,730000           ;12-BIT BYTES, START WITH FIRST BYTE IN WORD
6494         MOVE C,[-4,,DSCPNT]     ;SET UP BYTE POINTERS
6495         MOVEM B,(C)
6496         ADDI B,400
6497         AOBJN C,.-2
6498 KL,[    SWPUA                   ;DUMP EVERYTHING OUT OF CACHE
6499         CONSZ APR,200000
6500          JRST .-1
6501 ];KL
6502         PUSHJ P,T3CMD           ;PERFORM THE OPERATION
6503         JUMPE T,T3IO2           ;RETURN IF SUCCESS
6504         MOVE A,T                ;SEE IF ERROR MAY BE RECOVERABLE
6505         TRZ A,%DSECH+%DSIDE+%DSHCE
6506         JUMPN A,T3IO3           ;IF IRRECOVERABLE
6507         TRNE D,%DMRED           ;OR IF NOT A READ COMMAND
6508          CAIN D,%DMRED+10       ;OR IF TRIED ALL RECOVERY FEATURES
6509 T3IO3:    TLOA T,(SETZ)         ;ENSURE T NEGATIVE TO INDICATE ERROR
6510            AOJA D,T3IO1         ;OTHERWISE RETRY USING NEXT ERROR RECOVERY FEATURE
6511 T3IO2:  INSIRP POP P,[D C B A]
6512         POPJ P,
6513 ];T300P
6514 \f
6515 SUBTTL MISCELLANEOUS VARIABLES
6516
6517 KL,SALVPF: JRST 4,.             ;COME HERE IF PAGE FAIL IN SALVAGER
6518
6519 CONSTANTS
6520 VARIABLES
6521
6522 POPTJ:  POP P,T
6523 CPOPJ:  POPJ P,
6524
6525 THBLK:  -LTHBLK,,0
6526 THTPN:  0       ;TAPE #,,REEL # IN THIS DUMP
6527 THDATE: 0       ;TAPE CREATION DATE
6528 THTYPE: 0       ;0=>RANDOM  >0 => FULL   <0 => INCR
6529 LTHBLK==.-THBLK
6530
6531 MHBLK:  -LMHBLK,,0      ;FILE HEADER BLOCK
6532 MHSNM:  0       ;SYS NAME
6533 MHFN1:  0       ;FN1
6534 MHFN2:  0       ;FN2
6535 MHPKN:  0       ;PACK #
6536 MHDATE: 0       ;CREATION DATE
6537 LMHBLK==.-MHBLK
6538 LNKFLG: 0       ;NONZERO => RELOADING LINK
6539 LNKNM1: 0       ;LINK FN1
6540 LNKNM2: 0       ;LINK FN2
6541 LNKSNM: 0       ;LINK SNAME
6542 MAGHD:  0
6543 EOTFLG: 0
6544 EOFCNT: 0
6545 EOUF:   0
6546 SHORTL: 0
6547 MTRYS:  0
6548 MAGBFP: 0
6549 EOFLG:  0
6550 \f
6551 FROM:   0
6552 TOU:    0
6553
6554 SBTAB:  -1      ;FOR PATCHING
6555         -1
6556         -1
6557         -1
6558 MFDBK:  MFDBLK  ;SPECIAL RESERVED BLKS
6559         ;TUT USED TO BE HERE, BUT NO LONGER
6560 LSBTAB==.-SBTAB
6561
6562 ;THIS IS AN ARRAY INDEXED BY UNIT GIVING THE NUMBER
6563 ;OF BLOCKS IN THE TUT ON THAT UNIT.
6564 ;THESE BLOCKS ARE ALWAYS RIGHT BEFORE THE MFD.
6565 NTBL:
6566 IFE T300P, REPEAT NUNITS, NTUTBL
6567 IFN T300P,[
6568         REPEAT T300P, NTUTBL
6569         REPEAT NUNITS-T300P, NTUTB1
6570 ];T300P
6571
6572 RXWDS:  BLOCK 4 ;THE EXTRA WORDS
6573
6574         0       ;FOR BLT
6575 WXWDS:  BLOCK 4
6576
6577 NOLPT:  0       ;-1 FOR NO LPT
6578 LPBUST: -1      ;-1 LPT IS BUSTED DON'T KEEP ASKING
6579 PUNCH:  0       ;SET TO -1 WITH DDT IF COPY TTY OUTPUT TO PUNCH
6580 HCRASH: 0       ;SET TO -1 WITH DDT IF EMERGENCY DUP AFTER HEAD CRASH
6581                 ;SACRAFICE EVERYTHING FOR SPEED SINCE PACK IS BEING SCRAPED BY HEADS
6582 NUDS:   NTS,[NUDSL]+0 ;NUMBER OF USER DIRECTORY BLOCKS
6583 ADRSET: 0       ;ADDRESS SET
6584 FMBLK:  0       ;FROM BLOCK
6585 TOBLK:  0       ;TO BLOCK
6586 LFRMSW: 0
6587 SEEKC:  0
6588 SHARED: 0       ;NUMBER OF SHARED BLOCKS
6589 GOGOX:  0       ;-1 FOR AUTOMATIC MODE
6590 NOQUES: 0       ;-1 TO ASK NO QUESTIONS (ONLY EFFECTIVE IN GOGOX MODE)
6591 MDSK:   0       ;DISK TO GET MFD FROM
6592 UDSK:   0       ;DSK TO GET UFD'S FROM
6593 CKFLSW: 0       ;CHECK FILES FOR CLOBBERED BLOCKS
6594 MFDWRT: 0       ;MFD CHANGED
6595 TUTDFR: 0       ;FLAG TO SHOW TUT CHANGED
6596 TTDFPS: 0       ;COUNT FROBS PER LINE WHEN PRINTING TUT
6597 LFILES: 0       ;NUMBER OF FILES IN DIRECTORY
6598 USRNAM: 0       ;M.F.D. USR NAME
6599 UFDLOS: 0       ;SOME GARBAGE IN UFD
6600 UFDSEE: 0       ; -1 IF A STRANGE UFD, PRINT WHOLE THING
6601 FILEPK: 0       ; PACK FILE IS ON
6602 LAST:   0       ; LAST FILE IN UFD
6603 DBLK:   0       ;STORAGE FOR DIRECTORY NUMBER
6604 FILEER: 0       ;ERROR IN FILE
6605 BADFIL: 0       ; BLOCKS IN FILE WITH RETRIEVAL ERRORS
6606 XWDSEE: 0       ; -1 IF HAVENT TYPED EXTRA WORDS YET
6607 LASTQ:  0       ;STORAGE FOR Q
6608 NOTUT:  0       ;TUT NOT ACTIVE FOR THIS FILE
6609 LSTBLK: 0       ;LAST BLOCK STORAGE
6610 BLK:    0       ; LAST BLOCK READ OR WRITTEN FROM
6611 CKFIX:  0       ; -1 IF AUTO FIX RETRIEVAL POINTERS
6612 UNIT:   0       ; UNIT   "
6613 FUNIT:  0       ; UNIT FILE IS ON, -1 IF PACK NOT MOUNTED
6614 FERRS:  0       ;TRANSFER ERRORS
6615 CERRS:  0       ;ERRORS CORRECTED BY ECC LOGIC
6616 DUPRER: 0       ;DUP READ ERROR COUNT
6617 DUPWER: 0       ;DUP WRITE ERROR COUNT
6618 UFDTA:  0
6619 GARBF:  0       ;GARBAGE IN FREE AREA
6620 EXGARB: 0       ;EXTRA GARBAGE IN UFD
6621 MARKF:  0       ;MARKING PACK
6622
6623 PDL:    BLOCK 200
6624 QBTBLI: 440600,,
6625 QBTBL:  360600,,
6626         300600,,
6627         220600,,
6628         140600,,
6629         60600,,
6630         600,,
6631 \f
6632 QTRAN:
6633 DC,[    0               ;RH IS PHYSICAL DRIVE
6634         1               ;4.9 BIT MEANS SECOND HALF
6635         2               ;(NO LONGER DOES ANYTHING, NOW THAT MEMOWRECKS HAVE BEEN
6636         3               ; FLUSHED, BUT KEEP AROUND IN CASE EVER NEEDED AGAIN.)
6637         4
6638         5
6639         6
6640         7
6641 ];DC
6642 .ELSE REPEAT NDRIVE, .RPCNT     ;OTHERWISE NOTHING SPECIAL
6643
6644 IFN .-QTRAN-NUNITS,.ERR BARF AT QTRAN!!
6645
6646 QTTBLI: REPEAT 36./TUTBYT+1,    440000+TUTBYT_6-TUTBYT_12.*.RPCNT,,
6647 QTTBL=QTTBLI+1
6648
6649 TS, NQS:        0       ;SYSTEMS NUMBER OF DRIVES
6650 TS, SQACT:      0       ;LOCATION OF QACT IN SYSTEM
6651 TS, SALVRT:     0       ;DUMMY
6652
6653         NBLKS-1         ;SNBLKS-1
6654 SNBLKS: NBLKS           ;SYSTEM NBLKS (INIT'ED IN TS)
6655 DRIVE:  REPEAT NDRIVE,-1        ;-1 IF DRIVE ON LINE
6656 QACT:   REPEAT NUNITS,-1        ;-1 IF UNIT ACTIVE
6657 QPKN:   REPEAT NUNITS,-1        ;PACK NUMBER ACCORDING TO TUT
6658 PKNUM:  BLOCK NUNITS            ;PACK NUMBER ACCORDING TO HARDWARE
6659
6660 RPKID:  0
6661
6662 IRP A,,[OTUT,NTUT]
6663 Q!A!O:  REPEAT NUNITS,CONC A,\.RPCNT,
6664 TERMIN
6665
6666 PAT:
6667 PATCH:  BLOCK 100
6668
6669 LOC <.+1777>&776000
6670 CYLBUF:
6671 OUSRD:  BLOCK 2000
6672 NUSRD:  BLOCK 2000
6673 FDBUF:  BLOCK 2000
6674 MFD:    BLOCK 2000
6675 MAGBUF: BLOCK 2000
6676 IRPS A,,OTUT NTUT
6677 REPEAT NUNITS,CONC A,\.RPCNT,:  BLOCK 2000*MXTUTB
6678 TERMIN
6679 D0==OTUT0
6680 D1==OTUT1
6681 TUT=NTUT0
6682 RH, CYLSIZ==200*NHEDS*NSECS
6683 RP, CYLSIZ==NBLKSC*2000
6684 DC, CYLSIZ==NBLKSC*2004
6685 NTS, IFL .-CYLBUF-CYLSIZ,LOC CYLBUF+CYLSIZ
6686 THEEND:
6687 CONSTANTS
6688 VARIABLES
6689 IFN .-THEEND, .ERR CRUFT AFTER THEEND
6690
6691 INFORM HIGHEST USED = ,\THEEND
6692
6693 IFG THEEND-400000, .ERR TOO MOBY (MUST FIT IN 128K TO AVOID HOLE IF SOME MEM DOWN)
6694 ;This error check doesn't really matter for MC much, since memory has
6695 ;to be switched out in 128K increments, which means that the system
6696 ;can't work with any holes in the low 256K.
6697
6698 IF2, NTS, KL, PAG=<BLKO PAG,>-<BLKO>
6699
6700 TS, END DDT             ;ALWAYS STARTED BY <COMMAND>\eG
6701 NTS,END <MEMSIZ-4000>   ;DON'T CLOBBER I.T.S. START ADDR WHEN LOADED TOGETHER